251

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

Задача

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

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

Русский

2012-11-14

309 KB

25 чел.

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

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

    


 

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

74098. Ыбырай Алтынсарин 24.63 KB
  Ыбырай 1841 жылы қазан айының 20сында қазіргі Қостанай облысы Қостанай ауданында дүниеге келеді. Сөйтіп немересі кішкентай Ыбырайды Орынборда ашылады деп күтілген орысқазақ мектебіне күні бұрын жаздырып қояды. Атаң мұнда анаңмен есенаман Сүйіп сәлем жазады бүгін саған.
74099. Скиф-сақ әлеміндегі қоғамдық ұйымдар 24.17 KB
  I мыңжылдықтың басы сақ қоғамындағы алғашқы рулық қатынастар ыдырап жаңа әлеуметтік құрылымның қалыптасу үрдісінің жедел жүруімен сипатгалады. Сол кездің өзіндеақ алғашқы ірі қоғамдық еңбек бөлінісінен мыс пен қола металлургиясының тууы мен дамуынан кейін алғашында үлкен патриархаттық ал одан кейін шағын және моногамиялы отбасылар окшаулана бастады. Археологиялық деректер жеке адамдық ал кейін барып отбасылық меншіктің шыққанын айқын көрсетеді. II мыңжылдыктың аяғында және I мыңжылдыктың басында қыш ыдыстар мен кейбір қола заттарға...
74100. Қаңлы мемлекеті 22.17 KB
  II ғасырдың екінші жартысында ЧжанЦянь Қаңлы жерлерінің оңтүстігінде юечжиге ал солтүстігінде ғұндарға тәуелді екенін айтса біздің заманымыздағы I ғасырда мұндағы жағдай өзгереді. Егер Чжан Цянь юечжи әскерін 100200 мың ал қаңлы әскерін 90 мың деп хабарлаған болса ЦаньХаньШу енді қаңлы әскерін 120 мың юечжи әскерін 100 мың дейді14. Бұл кезенде Орта Азиядағы қос өзен аралығында юечжилердің негізгі бөлігінің оңтүстікке сол жағалаудағы Бактрияға ығысуы жерге отырықшылық орын алып жекежеке бес иелікке бөлінгенін мұның өзі қаңлымен...
74101. Қазан Хандығы 21.84 KB
  Қазанға орнығып бұл хандықтың дербес болуына негіз салды. Қазан Хандығы тұрғындарының негізгі кәсібі егіншілік болды; оған қосымша мал шаруашылығы баубақша жабайы араның балын жинау аңшылық балықшылық кәсіптерімен айналысты. Қазан Хандығында жоғары өкімет билігі ханның қолында болды бірақ оған ірі ақсүйектер кеңесі диуан бағыт сілтеп бақылау жүргізіп отырды.
74102. Қазақстан жеріндегі әскери қозғалыстар мен соғысқа кіруі 21.52 KB
  Қазақстан азамат соғысы жылдарында 19181920 жж. Ленин қол қойған халық комитетінің декреті бойынша қырғыз қазақ революциялық комитеті қүрылды. Оның қарамағына Қазақ Совет автономиясы жарияланып өлке Советтерінщ құрылтай съезі шақырылғанға дейін қазақ тұрғындары мекендеген Орал ТорғайАқмола Семей облысы мен Астрахань губерниясы жерівдегі барлық жоғарғы әскериазаматтық басқармалар берілді.
74103. Көтерілістің шығу себептері 21.34 KB
  Қатардағы қарапайым қазақтар жерді солардан жалға алып пайдаланды. Қазақ ақсүйектері орыс помещиктерінен жалға алған жерлерді өздерінің жеке қалауы бойынша қазақ ауылдарынакөтеріңкі қымбат бағаға тағы да қайыра жалға беріп отырды. Сөйтіп қазақтардан әр түрлі айыппұлдар мен алымсалықты еселеп алып тұрды 1836 жылы халық көтерілісі басталды.
74104. соты және олардың қазақ қоғамы өміріндегі атқарған рөлі 21.14 KB
  XIX ғасырдың 20жылдарынан бастап патша үБилер билер соты және олардың қазақ қоғамы өміріндегі атқарған рөлі[өңдеу] Ресей Қазақстан аумағына азаматтық және әскери сот жүйесін енгізгенге дейін мұнда дәстүрлі билер соты болатын. Қазақ қоғамында билер ешқашан сайланып та тағайындалып та қойылмаған. Ондай билердің атақдаңқы жөніндегі хабар дала тұрғындары арасына тез таралатын.
74105. Түрік қағандығы 20.71 KB
  Түрік немесе қажыр қайраттылар деген атпен белгілі болды. Түрік қағанаты Түрік Қағандығының қоғамдық өмірінде әскери іс маңызды орын алды. Түріктер мал шмен аңшылықпен айналысты.