ID: 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

ЗАДАЧА 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.

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