251
Практика графического программирования
Задача
Информатика, кибернетика и программирование
Написать программу, составляющую из фрагментов целую фотографию. Рисование дорожного знака с элементами анимации. Создание часов с круглым циферблатом и движущимися стрелками. Вывод в графическом окне заданный ребус и проверка его расшифровки.
Русский
2012-11-14
309 KB
27 чел.
ариант №4
УЧРЕЖДЕНИЕ ОБРАЗОВАНИЯ
«БЕЛОРУССКИЙ ГОСУДАРСТВЕННЫЙ ПЕДАГОГИЧЕСКИЙ УНИВЕРСИТЕТ ИМЕНИ МАКСИМА ТАНКА»
кафедра прикладной математики и информатики
Задачи
Выполнил:
студент 205 группы математического факультета Пилипенко Р.О.
Руководитель:
преподаватель кафедры прикладной математики и информатики
Юхно О.О.
Минск, 2011
ЗАДАЧА 1. 3
ЛИСТИНГ К ЗАДАЧЕ 1. 3
РИСУНОК К ЗАДАЧЕ 4
ЗАДАЧА 2. 4
ЛИСТИНГ К ЗАДАЧЕ 2. 4
РИСУНОК К ЗАДАЧЕ 5
ЗАДАЧА 3. 5
ЛИСТИНГ К ЗАДАЧЕ 3. 5
РИСУНОК К ЗАДАЧЕ 6
ЗАДАЧА 4. 6
ЛИСТИНГ К ЗАДАЧЕ 4. 6
РИСУНОК К ЗАДАЧЕ 9
ЗАДАЧА 5. 9
ЛИСТИНГ К ЗАДАЧЕ 5. 9
РИСУНОК К ЗАДАЧЕ 10
ЗАДАЧА 6. 10
ЛИСТИНГ К ЗАДАЧЕ 6. 10
РИСУНОК К ЗАДАЧЕ 11
ЗАДАЧА 7. 11
ЛИСТИНГ К ЗАДАЧЕ 7. 12
РИСУНОК К ЗАДАЧЕ 13
ЗАДАЧА 8. 14
ЛИСТИНГ К ЗАДАЧЕ 8. 14
РИСУНОК К ЗАДАЧЕ 17
ЗАДАЧА 9 17
ЛИСТИНГ К ЗАДАЧЕ 9. 17
РИСУНОК К ЗАДАЧЕ 21
В архиве находятся несколько файлов. В них - фрагменты одной фотографии. Требуется написать программу, составляющую из фрагментов целую фотографию.
program z1;
uses GraphABC;
var pic1, pic2, pic3, pic4, pic5, pic6, pic7, pic8 : integer;
begin
SetWindowSize(350,525);
pic1 := LoadPicture ('9_4.jpg'); //загружаем первую часть фотографии
DrawPicture (pic1, 70, 105);
Sleep (300);
pic2 := LoadPicture ('9_6.jpg'); // загружаем вторую часть фотографии
DrawPicture (pic2, 70, 210);
Sleep (300);
pic3 := LoadPicture ('9_1.jpg'); // загружаем третюю часть фотографии
DrawPicture (pic3, 70, 315);
Sleep (300);
pic4 := LoadPicture ('9_2.jpg'); // загружаем четвёртую часть фотографии
DrawPicture (pic4, 70, 420);
Sleep (300);
pic5 := LoadPicture ('9_7.jpg'); // загружаем пятую часть фотографии
DrawPicture (pic5, 210, 105);
Sleep (300);
pic6 := LoadPicture ('9_8.jpg'); // загружаем шестую часть фотографии
DrawPicture (pic6, 210, 210);
Sleep (300);
pic7 := LoadPicture ('9_3.jpg'); // загружаем седьмую часть фотографии
DrawPicture (pic7, 210, 315);
Sleep (300);
pic8 := LoadPicture ('9_5.jpg'); // загружаем всосьмую часть фотографии
DrawPicture (pic8, 210, 420);
Sleep (300);
FloodFill(1,2,clred); //закрашиваем фон
SetWindowTitle('Преподаватель Юхно О.О') //надпись
end.
Требуется написать программу для рисования дорожного знака.
program znak;
uses GraphABC;
Begin
SetWindowSize(400,400); // размер поля
SetPenColor(clRed);
SetBrushColor(clBlue);
SetPenWidth(30);
Circle(200,200,100); // круг
Line(200,200,140,140); // линия от центра до окруности
Line(200,200,260,140); // линия от центра до окруности
Line(200,200,140,260); // линия от центра до окруности
Line(200,200,260,260); // линия от центра до окруности
SetBrushColor (clWhite);
TextOut(140,320,'Остановка запрещена'); // текст
end.
Требуется написать программу для рисования дорожного знака с элементами анимации.
program zd_3;
uses GraphABC;
var i: byte;
begin
SetWindowSize(400,400); // размер поля
SetBrushColor(clGreen); // зеленый прямоугольник
CenterWindow;
FloodFill(0,0,clLtGray); // закрашиваем поле серым цветом
RoundRect(125,300,275,100,20,20);
SetPenColor(clWhite);
SetPenWidth(5);
Line(135,300,160,200); //рисуем линии
Line(160,200,180,200);
Line(180,200,185,300);
Line(215,300,220,200);
Line(220,200,240,200); // рисуем линии
Line(240,200,265,300);
Line(125,190,275,190);
Line(125,170,275,170);
FloodFill (175,290,clWhite); //закрашиваем белым цветом
FloodFill (255,290,clWhite);
FloodFill (130,180,clWhite);
SetPenWidth(3); // толщина
Line(160,160,170,100);
Line(180,160,177,100);
Line(180,160,160,160);
FloodFill (170,120,clWhite); // закрасить белым цветом
Line(240,160,215,100); //рисуем линии
Line(220,160,240,160);
Line(220,160,208,100);
FloodFill (220,130,clWhite); // закрашиваем белым цветом
SetPenColor(clRed); // полоса
SetPenWidth(20);
Line(135,290,265,110);
Sleep(300); // задержка
for i:=1 to 10 do
begin
SetPenColor(clYellow); // полоса
SetPenWidth(20);
Line(135,290,265,110);
Sleep(400);
SetPenColor(clRed); // полоса
SetPenWidth(20);
Line(135,290,265,110);
Sleep(400); // задержка
end;
end.
Требуется написать программу для рисования часов с круглым циферблатом и движущимися стрелками.
program g7v12z4;
uses CRT, graphABC, Utils,Sounds;
var x1,y1,xch,ych,xmin,ymin,xsec,ysec,X,Y,i,j,a,b:integer;
curTime,budil : DateTime;
n,n1,rc,rch,rm,rs,rcif:integer;
rstr:string;
procedure strelki(Colort : ColorType);
begin
SetPenColor(Colort); //устанавливаем цвет
xsec:=round(X-rs*cos(pi/180*(90+6*CurTime.Second))); //секундная стрелка (движется по окружности R=110)
ysec:=round(Y-rs*sin(pi/180*(90+6*CurTime.Second)));
line(x,y,xsec,ysec);
xmin:=round(X-rm*cos(pi/180*(90+6*CurTime.Minute))); //минутная стрелка (движется по окружности R=100)
ymin:=round(Y-rm*sin(pi/180*(90+6*CurTime.Minute)));
line(x,y,xmin,ymin);
xch:=round(X-rch*cos(pi/180*(90+6*((CurTime.Hour mod 12)*5+ CurTime.Minute div 12)))); //часовая стрелка (движется по окружности R=85)
ych:=round(Y-rch*sin(pi/180*(90+6*((CurTime.Hour mod 12)*5+ CurTime.Minute div 12))));
line(x,y,xch,ych);
end;
function nadpis(ch,m:integer):string;
var s,s1:string;
begin
s:='00'+inttostr(ch); //Это только для того, чтобы вывести время будильника на экран (если этого не будет, то например
s:=copy(s,length(s)-1,2); // время 02:00 будет написано как 2:0
s1:='00'+inttostr(m);
s1:=copy(s1,length(s1)-1,2);
nadpis:=s+':'+s1;
end;
begin
rcif:=135; //радиус цифирблата
rc:=120; //радиус окружности цифр
rch:=85; //радиус часовой стрелки
rm:=100; //радиус минутной стрелки
rs:=105; //радиус секундной стрелки
SetWindowSize(400,400);
SetWindowTitle('');
CenterWindow;
floodfill(0,0,clskyblue);
setbrushcolor(clskyblue);
hidecursor;
budil:=CurrentDateTime;
budil.hour:=10; //часы будильника
budil.minute:=20; //минуты будильника
setfontstyle(fsbold);
textout(1,1,'Будильник '+nadpis(budil.hour,budil.minute));
X:=WindowWidth div 2;
Y:=WindowHeight div 2;
setpenwidth(3);
setbrushcolor(cllime);
circle(X,Y,rcif);
//расставим деления на циферблате (i-угол в градусах)
i:=0;
j:=3; // угол в 0 градусов соответствует на циферблате цифре 3, поэтому начинаем с нее
setfontsize(12);
setfontstyle(fsbold);
setfontname('times new roman');
while i<360 do
begin
x1:=round(X+rc*cos(pi/180*i)); //120 - радиус окружности, по которой расставим цифры и точки
y1:=round(Y+rc*sin(pi/180*i));
if i mod 30=0 then //все цифры на циферблате отстоят друг от друга на 5делений*6градусов=30 градусов
begin
rstr:=inttostr(j);
if j<10 then rstr:=' '+rstr;
TextOut(x1-7,y1-7,rstr);
inc(j);
if j=13 then j:=1; //цифры от 1 до 12, но т.к. начали с 3, то 3-12 и 1-2
end
else circle(x1,y1,1);
i:=i+6; // Добавлем 6, потому что делений на циферблате 60, градусов 360 (окружность), т.е 1 деление=360:60=6 градусов
end;
xch:=X;
ych:=Y;
xmin:=X;
ymin:=Y;
xsec:=X;
ysec:=Y;
n:=LoadSound('clock.wav'); {--- загружаем звук в оперативную память ---}
n1:=LoadSound('bells.wav');
curtime:=CurrentDateTime;
curtime.hour:=9;
curtime.minute:=10;
curtime.second:=0;
lockdrawing;
repeat
SetWindowTitle(nadpis(curtime.hour,curtime.minute));
PlaySound(n);
if (curtime.hour=budil.hour) and (curtime.minute=budil.minute) then
if (curtime.second>=0) and (curtime.second<=59) then playsound(n1); //будильник звонит 1 мин
strelki(clmaroon); // рисуем стрелки
redraw;
sleep(10); //задержка на 1000 миллисекунд = секунда
strelki(cllime); //стираем стрелки
curtime.second:=curtime.second+1;
if curtime.second=60 then
begin
curtime.second:=0;
curtime.minute:=curtime.minute+1;
if curtime.minute=60 then
begin
curtime.minute:=0;
curtime.hour:=curtime.hour+1;
if curtime.hour=12 then curtime.hour:=0;
end;
end;
until ((curtime.hour=11) and (curtime.minute=20) and (curtime.second=1));
strelki(clBlack);
DestroySound(n);
DestroySound(n1);
end.
Дан рисунок с контурным изображением. Требуется написать программу для закрашивания частей этого рисунка оттенками одного цвета.
;) Как если бы рисунок раскрашивал художник в волшебных очках, окрашивающих все одним цветом!
program z5;
uses GraphABC;
var pic:integer;
begin
SetWindowSize(500,500);
CenterWindow;
SetWindowCaption('Раскраска');
pic:=LoadPicture('Z5_picture.bmp');
DrawPicture(pic,0,0);
FloodFill(0,0,RGB(129,171,235)); // разукрасили фон
FloodFill(250,210,RGB(129,171,235));
FloodFill(170,40,RGB(129,171,235));
FloodFill(318,125,RGB(129,171,235));
FloodFill(300,290,RGB(68,23,221)); // разукрасили обруч
FloodFill(150,150,RGB(31,31,234)); //разукрасили большого дельфинчика
FloodFill(300,300,RGB(31,31,234));
FloodFill(289,85,RGB(31,31,234));
FloodFill(339,84,RGB(31,31,234));
FloodFill(100,450,RGB(31,31,234));// разукрасили маленького дельфинчика
FloodFill(357,401,RGB(72,85,204)); // разукрасили капли воды
FloodFill(299,398,RGB(72,85,204));
FloodFill(254,430,RGB(72,85,204));
FloodFill(111,126,RGB(151,221,251)); // закрасили глазик
FloodFill(127,421,RGB(151,221,251));
FloodFill(194,382,RGB(103,101,181)); // закрасили мяч
FloodFill(217,407,RGB(103,101,181));
FloodFill(180,408,RGB(0,0,151));
FloodFill(215,380,RGB(0,0,151));
end.
В архиве находятся один или несколько файлов. Это рисунки, из которых можно составить ребус. Требуется написать программу для вывода в графическом окне заданного ребуса и проверки того, как пользователь расшифровал данный ребус.
program Rebus;
uses GraphABC,crt;
var pic1,pic2,pic3:integer;
a:string;
begin
SetWindowSize(600,400);
CenterWindow;
pic1:=LoadPicture('ребус4_1.jpg'); // загрузить рисунок 1
pic2:=LoadPicture('ребус4_2.jpg'); // загрузить рисунок 2
pic3:=LoadPicture('ребус4_3.jpg'); // загрузить рисунок 3
DrawPicture(pic1,40,250);
DrawPicture(pic2,230,250);
DrawPicture(pic3,420,250);
SetFontSize(70);
SetFontName('Cooper Black'); // ставим запятую
TextOut(40,190,',');
TextOut(230,190,',');
SetFontSize(20);
SetFontName('Times');
TextOut(150,250,'а=п'); //меняем знак
TextOut(350,250,'я=т');
SetPenColor(clBlue);
Line(10,200,580,200);
SetFontSize(20);
Writeln;
Writeln('Введите слово отгадку':30); // вводим отгадку
TextSize(20);
Write('':10);
read(a);
SetFontSize(20);
HideCursor;
If (a='исполнитель') or (a='Исполнитель') // надпись с заглавной буквы или с праписной будет считатся правельным ответом
then begin
SetFontColor(clGreen); // закрашиваем зелёным цветом
textOut(140,100,'Это - правильный ответ'); // вывод надписи правельного ответа
end
else begin
SetFontColor(clRed); // закрашиваем красным цветом
TextOut(140,100,'Не верно'); // вывод натписи не правельного ответо
SetFontColor(clGreen); // закрашиваем зелёным цветом
TextOut(140,150,'Правильный ответ - исполнитель'); // запись правельного ответа
end;
end.
Требуется написать программу для поднятия флагов трех государств на церемонии награждения в спортивном соревновании со звучанием гимна страны, занявшей первое место: Германия, Ирландия, Индонезия.
program z7;
uses
GraphABC, Sounds;
var
i,j,r,n: integer;
begin
{Рисование графического окна}
SetWindowSize(800,600);
CenterWindow;
{Задание начальных значений переменных}
i:=40;
j:=120;
{Подключение звукового файла}
n:=LoadSound('Germany.wav');
PlaySound(n);
//линия крепления
SetPenWidth(20);
Line(20,0,780,0);
for i:=1 to 450 do
Begin //флаг первой страны
LOCKDRAWING;
SetBrushColor(clWhite);
FillRect(299,600-i+30 ,500,600-i+100 );
SetPenWidth(2);
Line(350,500-i+120,350,0); //линия поднятия первого флага
Line(450,500-i+120,450,0); //линия поднятия первого флага
SetPenColor(clBlack);
Rectangle(300,600-i+30,500,600-(i+90));
SetPenWidth(1);
FLOODFILL(310,600-i+30-3,CLWhite);
setpencolor(clblack);
setpencolor(clblack);
rectangle(300,600-i+28-120,499,600-(i+90));
floodfill(303,630-i-85+80,clblack);
setpencolor(clred);
rectangle(299,600-i+28,499,600-(i+134)+85);
floodfill(307,630-i-85+80,clred);
setpencolor(clYellow); // желтый цвет
rectangle(299,600-i+28,499,600-(i+90)+85);
floodfill(308,630-i-85+80,clYellow);
setfontsize(14);
textout(350, 630-i,'Германия');
setpencolor(clblack);
REDRAW;
SetPenWidth(4);
//флаг второй страны
LOCKDRAWING;
SetBrushColor(clWhite);
FillRect(299-200,600-i+30,500-200,600-i+100+40 );
SetPenWidth(2);
Line(350-200,500-i+120,350-200,0); //линия для поднятия второго флага
Line(450-200,500-i+120,450-200,0); //линия для поднятия второго флага
SetPenColor(clBlack);
Rectangle(300-200+1,600-i+30+40,500-200-1,600-(i+90)+40);
SetPenWidth(1);
setpencolor(clGreen);
rectangle(102,600-i+28-40+80,170,600-(i+134)+85);
floodfill(103,630-i-85+80,clGreen);
setpencolor(RGB(255,128,0));
rectangle(235,600-i+28-40+80,170,600-(i+134)+85);
floodfill(270,630-i-85+80,RGB(255,128,0));
setpencolor(clWhite);
rectangle(170,600-i+28-40+80,235,600-(i+134)+85);
floodfill(200,630-i-85+80,clWhite);
SetPenWidth(5);
SetPenColor(clWhite);
setfontsize(14);
textout(345-200, 630-i+40,'Ирландия');
setpencolor(clblack);
REDRAW;
SetPenWidth(4);
//флаг третьей страны
LOCKDRAWING;
SetBrushColor(clWhite);
FillRect(299+200,600-i+30 ,500+200,600-i+100+80 );
SetPenWidth(2);
Line(350+200,500-i+120,350+200,0); // линия поднятия третего флага
Line(450+200,500-i+120,450+200,0); //линия поднятия третего флага
SetPenColor(clBlack);
Rectangle(300+200+1,600-i+30+80,500+200-1,600-(i+90)+80);
SetPenWidth(1);
setpencolor(clred);
rectangle(502,600-i+28-60+80,697,600-(i+90)+1+80);
floodfill(505,630-i-85+80,clred);
setfontsize(14);
textout(345+220, 630-i+80,'Индонезия');
setpencolor(clblack);
REDRAW;
SetPenWidth(4);
Sleep(180);
end;
{Организация паузы для доигрывания музыкального файла}
for i:=1 to 450 do Sleep(360000);
end.
Требуется написать программу для построения графика функции на заданном отрезке: на отрезке [2; /3].
Program grafik;
Uses GraphABC,crt;
Var a,b,c,xMin :Integer;
uMax, uMin, vMax, vMin :Integer;
u, v, n, k : Integer;
xMax, yMin, yMax, x, y, px, py, h,e,z :Real;
s:string;
function f(x:real): real;
{--- функция пользователя для определения значения заданной функции в некоторой точке x0--- }
begin
f:=a*x*x-sin(b*x+c);
end;
Begin
Setwindowsize(640,500);
writeln('a = ');
readln(a);
writeln('b = ');
readln(b);
writeln('c = ');
readln(c);
e:=-2*pi;
z:=pi/3;
begin
{--- строим шапку таблицы --- }
writeln('_______________________');
writeln('! x ! y !');
writeln('_______________________');
{--- находим и выводим значения функции
для рисовния границы используем символы подчеркивания и восклицательного знака --- }
h:=0.5; {--- шаг деления отрезка --- }
x:=e;
while x <=z do
begin
y:=f(x);
writeln('!', x:8:2, ' !', y:8:2, ' !'); {--- --- }
x:=x+h;
end;
writeln('_______________________');
end;
If a<>0 then
begin
yMax :=abs(a)*100; yMin :=(-100)*(abs(a));
end
else
begin
yMax :=3; yMin :=-3;
end;
//Построение графика
{Задание области прямоугольника декартовых координат графика}
xMin := -9; xMax := 1/2;
If a<>0 then
begin
yMax :=abs(a)*100; yMin :=(-100)*(abs(a));
end
else
begin
yMax :=3; yMin :=-3;
end;
{Задание экранных координат области графического окна построения графика}
uMin :=200; uMax := 600; vMin := 50; vMax := 300;
{Вычисление количества точек графика в экранных координатах}
n := uMax - uMin;
{Сколько точек декартовых приходится на 1 точку экранную, т.е. шаг изменения х}
h:=(xMax - xMin)/n;
{Рисование прямоугольной области, в которой будет располагаться график}
Rectangle(uMin,vMin,uMax,vMax);
{Нахождения коэффициентов сжатия}
px := (uMax - uMin)/(xMax - xMin);
py := -(vMax - vMin)/ (yMax - yMin);
{Рисование оси Оу}
x:=0;
If (x > xMin) and (x < xMax) Then
begin
u := Round(px*(x-xMin)+uMin);
Line(u,vMin,u,vMax);
SetFontColor(clRed);
SetFontSize(15);
TextOut(u,7,'Y ');
end;
{Рисование оси Ох}
y := 0;
If (y>yMin) and (y<yMax)
Then begin
v := Round(py*(y-yMax)+vMin);
Line(uMin,v,uMax,v);
SetFontSize(15);
//
end;
{Рисование графика функции}
x:=xMin;
For k:=1 to n do
Begin
y:=((a*(x*x))-sin((b*x)+c));
If (y>yMin) and (y<yMax) Then begin
u := Round((x-xMin)*px+uMin);
v := Round((y-yMax)*py+vMin);
SetPixel(u,v,clRed);
end;
x := x+h;
end; //обозначаем необходимые точки
Setpencolor(clGreen);
SetFontColor(clbrown);
Circle(580,175,3);
textout(563,153,'0');
Line(600,175,590,165);
Line(600,175,590,185);
TextOut(610,160,'X ');
//Circle(580,50,3);
Line(579,50,590,60);
Line(579,50,570,60);
TextOut(180,180,'-2pi ');
Circle(200,176,3);
TextOut(600,183,'pi/3');
Circle(600,175,3);
//TextOut(560,40,'100');
Circle(579,50,3);
//TextOut(558,300,'-100');
Circle(579,300,3);
end.
Имеется набор числовых данных. Требуется написать программу вычисления по данным некоторых значений и построения диаграмм:
Даны сведения о площади и населении некоторых стран Европы.
Австрия |
Дания |
Исландия |
Португалия |
Франция |
Испания |
Швейцария |
площадь, км2 |
||||||
83850 |
43070 |
103000 |
92080 |
547300 |
93080 |
41300 |
численность населения, тыс. чел. |
||||||
7987 |
5199 |
266 |
10562 |
57109 |
10562 |
7085 |
Данные площади отсортировать по убыванию и по ним построить круговую диаграмму.
Определить плотность населения каждой из стран и среднюю плотность населения семи стран. Вычислить отклонение (разность) плотности от средней. Исключить из набора отклонений минимальное и максимальное значения, по остальным данным отклонений построить гистограмму.
Program KrugDiag;
Uses Crt, GraphABC;
Type masuchenik = array[1..7] of string;
mas = array [1 .. 7] of integer;
mas3=array [1..7]of integer;
Var
a : mas; //массив количества стран
c : mas;
b:mas3; //массив номеров цветов для изображения секторов
v : masuchenik; //массив из строк для надписи легенды
p : masuchenik; //массив из процентов для каждой страныы
i,n,m,s,x1,x2,f,h,max,d,xi:integer;
k,sr:real; z,z1,z2,z3,z4,z5,z6,z7:string;
Begin
SetWindowSize(800,800);
// Массив надписей для легенды
v[1]:= 'Австрия-83850 км^2';
v[2]:= 'Данмя-43070 км^2';
v[3]:= 'Исландия-103000 км^2';
v[4]:= 'Португалия-92080 км^2';
v[5]:= 'Франция-547300 км^2';
v[6]:= 'Испания-93080 км^2';
v[7]:= 'Швейцария-41300 км^2';
//Определение массива цветов для построения диаграммы
SetPixel(100,100,clRed);
c[1]:=GetPixel(100,100);
SetPixel(100,100,clGreen);
c[2]:=GetPixel(100,100);
SetPixel(100,100,clBlue);
c[3]:=GetPixel(100,100);
SetPixel(100,100,clYellow);
c[4]:=GetPixel(100,100);
SetPixel(100,100,clAqua);
c[5]:=GetPixel(100,100);
SetPixel(100,100,clFuchsia);
c[6]:=GetPixel(100,100);
SetPixel(100,100,clPurple);
c[7]:=GetPixel(100,100);
//Ввод значений количество працентов страны
A[1]:=8400;
A[2]:=4300;
A[3]:=10300;
A[4]:=9200;
A[5]:=54500;
A[6]:=9300;
A[7]:=4000;
s:=0;
n:=7;
//Все страны разбили на 7 групп
For i:=1 to n do s:=s+a[i]; //Нашли количество всех жителей страны
k:=360/s; //Сколько градусов круга приходится на одну страну
{построение закрашенного прямоугольника,
в котором будет выведена легенда диаграммы}
SetBrushColor(clSkyBlue);
{Цвет прямоугольника легенды - голубой}
SetBrushStyle(bsSolid);
{Стиль закраски прямоугольника - сплошной}
RecTangle(390,200,795,350);
//вывод прямоугольника легенды
SetFontStyle(fsNormal);
For i:=1 to 7 do
begin
SetBrushStyle(bsSolid);
SetBrushColor(C[i]);
Pie(435,(i+1)*15+205,20,0,90);
// Построение сектора
Str(trunc((A[i]/s)*100),P[i]);
//Перевод процентов количества площади для каждой страны в тексте
TextOut(400,(i+1)*15+187,P[i]+'%');
//Вывод чисел и знака % впереди секторов
TextOut(455,217+(i-1)*15,V[i]);
//Вывод текста обозначающей каждую страну
end;
//построение круговой диаграммы
x1:=0;
x2:=0;
//Начальное значение угла сектора
For i:=1 to n do
If A[i]<>0 then begin
m:=trunc(k*A[i]);
//Сколько градусов приходится на одну страну
SetBrushColor(C[i]);
//Цвет закраски выбираем из созданного нами массива цветов
x1:=x2;
x2:=x2+m;
{Подготавливаем углы для каждой группы, х1 - первое значение угла,
х2 - второе значение угла сектора}
If i=n then Pie(200,250,100,x1,360)
else Pie(200,250,100,x1,x2);
{Для последнего сектора пишем второй угол 360, чтобы не было не закрашенного промежутка, который образуется из-за округления чисел}
end;
sleep (20000);
ClearWindow;
randomize;
randomize;
for i:=1 to 7 do
begin
rectangle(10,10,600,600);
sr:= Round((95+121+3+115+104+19+172)/7);
b[1]:=Round(180-sr);
b[2]:=Round(241-sr);
b[3]:=round(95-sr);
b[4]:=Round(185-sr);
b[5]:=Round(154-sr);
b[6]:=Round(100-sr);
b[7]:=Round(264-sr);
f:=Round(b[1]);
end;
//Задание ширины линии
SetPenWidth(3);
//Задание стиля линии - сплошная
SetPenStyle(psSolid);
//построение оси на которой будут стоять прямоугольники
Line(10,400,520,400);
//рассчет ширины прямоугольника для каждой страны
h:=Round((450)/7);
For i:=2 to 7 do IF b[i]>max THEN max:=b[i];
//вычисление коэффициента масштабирования по оси OY
d:=250 div max;
{координата х для первого прямоугольника диаграммы}
xi:=10;
{Строим столько прямоугольников, сколько было стран}
For i:=1 to 7 do
begin
SetBrushColor(clOlive);
{закраска прямоугольника диаграммы зеленым цветом}
SetBrushStyle(bsSolid);
{Стиль закраски прямоугольника диаграммы - сплошной}
{координата у вычисляетсчя 350 - это координата линии,
на которой стоят прямоугольники и от нее отнимается
количество деталей умноженное на коэффициент сжатия по оси ОУ -
это будет левая верхняя точка прямоугольника диаграммы. Нижняя
правая точка меняет координату х на ширину прямоугольника,
а по оси оу она расположена на прясмой}
Rectangle(xi,400-b[i]*d ,xi+h,400) ;
{вывод соответствующего номера месяца под каждым столбиком}
Str(i,z);
z1:='на83850';
z2:='43070';
z3:='103000';
z4:='92080';
z5:='547300';
z6:='93080';
z7:='41300 км^2';
{Переводим числовое значение месяца в строковую переменную}
SetBrushColor(clWhite);
{Отменяем цвет закраски области на белый}
SetFontColor(clRed);
{Устанавливаем цвет шрифта - красный}
SetFontSize(10);
{Указываем размер цифр - 10}
SetFontStyle(fsBold);
{Устанавливаем стиль шрифта - жирный}
TextOut(10+(h div 3),100,z1);
TextOut(10+h+(h div 3),100,z2);
TextOut(10+2*h+(h div 3),100,z3);
TextOut(10+3*h+(h div 3),100,z4);
TextOut(10+4*h+(h div 3),100,z5);
TextOut(10+5*h+(h div 3),100,z6);
TextOut(10+6*h+(h div 3),100,z7);
{Выводим текст под каждым прямоугольником диаграммы}
xi:=xi+h+10;
{получаем координату х для следующего прямоугольника диаграммы
10 - расстояние между столбиками }
end;
Line(10,324,520,324);
End.
А также другие работы, которые могут Вас заинтересовать | |||
13454. | Методы сетевого планирования Сетевые технологии | 518 KB | |
Управление проектами Лабораторная работа № 1.Методы сетевого планирования Сетевые технологии Сетевые технологии относятся к наиболее распространенным технологиям планирования и контроля реализации сложных мероприятий т.е. проектов. Они базируются на теории граф | |||
13455. | Cоздание нового проекта в MS Project | 363.02 KB | |
Урок 1. Планирование работ в Microsoft Project Cоздание нового проекта в MS Project Для примера рассмотрим проект по проектированию и разработке сайтавизитки магазина с использованием cms. Первыми шагами при создании календарного плана проекта являются: запуск нового плана проек | |||
13456. | Планирование ресурсов и создание назначений в Microsoft Project | 146.5 KB | |
Урок 2. Планирование ресурсов и создание назначений в Microsoft Project После того как определен состав задач нужно определить кто эти задачи будет исполнять и какое оборудование будет использоваться. Для этого нужно ввести в план проекта список ресурсов и информацию о них а з | |||
13457. | Свойства назначения в Microsoft Project | 151 KB | |
Урок 3. Свойства назначения Каждое из связанных с задачей назначений имеет набор свойств с помощью которых его можно настроить так чтобы оно в большей степени соответствовало требованиям вашего проекта. Настройка свойств назначения осуществляется в диалоговом окне Св... | |||
13458. | Ввод фактических данных | 924 KB | |
Ввод фактических данных Фактические данные это информация о ходе выполнения запланированных работ на основании которой менеджер проекта осуществляет процесс отслеживания. В системе существует несколько способов ввода фактических данных отличающихся друг от дру | |||
13459. | Анализ и оптимизация плана работ | 1.12 MB | |
Урок 4. Анализ и оптимизация плана работ. Для анализа плана работ проекта применяют две классические методики: PERT и метод критического пути СРМ. При анализе стоимости проекта используют настраиваемые поля формулы и группировки создаются формулы с условиями выявляют | |||
13460. | Анализ рисков в Microsoft Project | 882.5 KB | |
Анализ рисков. Анализ опасностей которые могут возникнуть при выполнении составленного плана один из самых интересных и сложных этапов планирования проекта. От того как проведен анализ зависит будет ли проект успешно завершен. В этом уроке вы научитесь определять | |||
13461. | Метод освоенного объема | 1.38 MB | |
Лабораторная работа Метод освоенного объема Для определения состояния проекта методом освоенного объема используется три величины: Базовая стоимость запланированных работ БСЗР обозначает сводную стоимость работ которые должны были быть осуществлены к текущем | |||
13462. | Совместное использование ресурсов | 906.5 KB | |
Лабораторная работа Совместное использование ресурсов Одновременное управление несколькими проектами в рамках организации осложняется тем что сотрудники и материальные ресурсы должны назначаться на задачи так чтобы назначения одних проектов не противоречили друг... | |||