251

Практика графического программирования

Задача

Информатика, кибернетика и программирование

Написать программу, составляющую из фрагментов целую фотографию. Рисование дорожного знака с элементами анимации. Создание часов с круглым циферблатом и движущимися стрелками. Вывод в графическом окне заданный ребус и проверка его расшифровки.

Русский

2012-11-14

309 KB

24 чел.

ариант №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

ЗАДАЧА 1.

В архиве находятся несколько файлов. В них - фрагменты одной фотографии. Требуется написать программу, составляющую из фрагментов целую фотографию.

ЛИСТИНГ К ЗАДАЧЕ 1.

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.

                                  

РИСУНОК К ЗАДАЧЕ

ЗАДАЧА 2.

Требуется написать программу для рисования дорожного знака.

ЛИСТИНГ К ЗАДАЧЕ 2.

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.

                                  РИСУНОК К ЗАДАЧЕ 

          

ЗАДАЧА 3.

Требуется написать программу для рисования дорожного знака с элементами анимации.

ЛИСТИНГ К ЗАДАЧЕ 3.

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.

                                  РИСУНОК К ЗАДАЧЕ 

     

ЗАДАЧА 4.

Требуется написать программу для рисования часов с круглым циферблатом и движущимися стрелками.

ЛИСТИНГ К ЗАДАЧЕ 4.

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.

                                  РИСУНОК К ЗАДАЧЕ 4

                     

ЗАДАЧА 5.

Дан рисунок с контурным изображением. Требуется написать программу для закрашивания частей этого рисунка оттенками одного цвета.
;) Как если бы рисунок раскрашивал художник в волшебных очках, окрашивающих все одним цветом!

ЛИСТИНГ К ЗАДАЧЕ 5.

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.

                                  РИСУНОК К ЗАДАЧЕ 

                         

ЗАДАЧА 6.

В архиве находятся один или несколько файлов. Это рисунки, из которых можно составить ребус. Требуется написать программу для вывода в графическом окне заданного ребуса и проверки того, как пользователь расшифровал данный ребус.

ЛИСТИНГ К ЗАДАЧЕ 6.

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.

                                  РИСУНОК К ЗАДАЧЕ 

 

ЗАДАЧА 7.

Требуется написать программу для поднятия флагов трех государств на церемонии награждения в спортивном соревновании со звучанием гимна страны, занявшей первое место: Германия, Ирландия, Индонезия.

ЛИСТИНГ К ЗАДАЧЕ 7.

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.

                                  РИСУНОК К ЗАДАЧЕ 

                 

ЗАДАЧА 8.

Требуется написать программу для построения графика функции на заданном отрезке:  на отрезке [–2; /3].

ЛИСТИНГ К ЗАДАЧЕ 8.

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.

                                  РИСУНОК К ЗАДАЧЕ

 

                    

ЗАДАЧА 9

Имеется набор числовых данных. Требуется написать программу вычисления по данным некоторых значений и построения диаграмм:

Даны сведения о площади и населении некоторых стран Европы.

Австрия

Дания

Исландия

Португалия

Франция

Испания

Швейцария

площадь, км2

83850

43070

103000

92080

547300

93080

41300

численность населения, тыс. чел.

7987

5199

266

10562

57109

10562

7085

Данные площади отсортировать по убыванию и по ним построить круговую диаграмму.

Определить плотность населения каждой из стран и среднюю плотность населения семи стран. Вычислить отклонение (разность) плотности от средней. Исключить из набора отклонений минимальное и максимальное значения, по остальным данным отклонений построить гистограмму.

ЛИСТИНГ К ЗАДАЧЕ 9.

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.

                                  РИСУНОК К ЗАДАЧЕ 

    


 

А также другие работы, которые могут Вас заинтересовать

80760. Synonyms, euphemisms and antonyms 28.96 KB
  Traditional linguistics defines synon. As words of the same category of parts of speech conveying the same concept but differing either in shades of meaning or in stylistic characteristics. A more modern and effective approach to the classification of synonyms may based on the definition describing synonyms as words differing in connotations...
80761. Phraseological Units and the principles of their classification 30 KB
  Phraseological units because they sum up the collective experience of the community.They moralize (Hell is paved with good intentions), give worring If you sing before breakfast, you will worry before night), criticize (Everyone calls his own guse swans).
80762. Object of the Theory of Grammar. Its place among Other Linguistic Sciences 29.78 KB
  Language is social by nature: it is inseparably connected with the people who are its creators users. L. consists of three parts (sides): the phonological system, the lexical system, the grammatical system; without any one of them three is no human L. in the above sense.
80763. DISTINCTIVE LINGUISTIC FEATURES OF THE MAJOR FUNCTIONAL STYLES OF ENGLISH 26.76 KB
  A functional style of language is a system of interrilated language means which serve a definite in communication. The english literary standard we distinguish the following major functional styles: the language of belles-letters, the languge publicistic literaeture, the language of newspapers...
80764. Право граждан на благоприятную окружающую среду 31.86 KB
  Право на жизнь объединяет с правом на благоприятную окружающую среду то что первое несомненно связано с состоянием окружающей среды в которой проживает человек. По оценкам Всемирной организации здравоохранения состояние здоровья человека до 80 определяется условиями среды его обитания. Есть основания предположить что годы жизни укорочены наряду с другими причинами изза деградации окружающей среды. В той части в какой право на жизнь связано с охраной природной среды оно может защищаться способами и средствами предусмотренными...
80765. Право на достоверную информацию о состоянии окружающую среду. Источники экологической информации 33.31 KB
  Источники экологической информации. ФЗ Об информации информационных технологиях и защите информации предусматривает защиту прав граждан на экологическую информацию в том числе сведения о последствиях аварий и катастроф информацию о безопасности населенных пунктов. Подобная информация не может составлять государственную тайну доступ к данной информации не может быть ограничен. Одним из критериев такой информации является ее достоверность.
80766. Права общественных формирований в области охраны окружающей среды 31.04 KB
  Полномочия общественных экологических объединений в области охраны окружающей природной среды предусмотрены рядом законодательных актов. Федерального закона Об охране окружающей среды. Одним из примеров реализации прав общественных объединений в области охраны окружающей среды может служить опротестование Российским социально-экологическим союзом в Вологодском областном арбитражном суде решения вологодских властей о строительстве на территории Национального природно-исторического парка Русский Север образованного Правительством РФ в...
80767. Право собственности на природные объекты: понятие, виды, объекты и субъекты, основания возникновения 30.39 KB
  Земля и другие природные ресурсы могут находиться в частной государственной муниципальной и иных формах собственности. Земли которые не находятся в собственности граждан юридических лиц или муниципальных образований представляют собой государственную собственность. Право собственности на природные ресурсы – возможность владения пользования и распоряжения данными природными ресурсами.
80768. Право природопользования: понятие, содержание и виды 35.24 KB
  Позитивное природопользование классифицируется по объекту природопользования на землепользование водопользование пользование лесами недрами и животным миром. Право природопользования понимается в двух значениях. В объективном смысле право природопользования это совокупность правовых норм регулирующих отношения по поводу использования и охраны природных ресурсов.