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.

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

    


 

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

20618. Восходящий синтаксический метод 180.5 KB
  Значения атрибутов вычисляются согласно семантическим правилам которые связаны с продукциями грамматики. В этом обобщении с каждым грамматическим символом связываются множество атрибутов. Синтезируемые атрибуты Наследуемые атрибуты каждому символу грамматики можно поставить ряд атрибутов Синтезируемые атрибуты значение вычисляется по значению атрибутов в дочерних по отношению к данному узлу узлах. Наследуемые атрибуты значение определяется значением атрибутов соседних узлов и родительского узла.
20619. Синтаксическое дерево 93.5 KB
  Синтаксическое дерево. Синтаксическое дерево представляет собой дерево синтаксического разбора сжатом виде и может быть построено на основе синтаксически управляемых определений. Грамматическое правило Семантическое правило Синтаксическое дерево узлы которого могут иметь одного родителя называется направленным ациклическим графом выражений DAG. Для ускорения поиска используется ХЭШ функция по сигнатуре op l r Пример: Построить дерево синтаксического разбора синтаксическое дерево и DAG для выражения.
20620. Семантический анализ 144.5 KB
  Генерация промежуточного кода Основные формы промежуточного кода6 Для примитивных трансляторов используется синтаксическое дерево или DAG Постфиксная запись Трехадресный код: x:=y op z Пример: синтаксическое дерево t1=c t2=bt1 t4=c t5=bt4 t3=t5t2 a=t3 DAG t1=c t2=bt1 t3=t2t2 a=t3 постфиксная запись Трехадресный код представляет собой выражение типа Типы трехадресных конструкций инструкции присвоения где op арифметическая или логическая операция где op унарная операция инструкции копирования инструкции...
20621. Этап генерация кода исполняемой машины 58 KB
  1 a:=bc d:=ac mov R0 b add R0 c → mov a R0 mov R0 b add R0 c mov d R0 2 t:=ab t:=tc t:=t d mov R0 a add R0 b mov R1 c mul R0 R1 mov R1 d div R0 R1 mov t R0 не помещая переменные в регистры Характеристики описывающие целевую машину: набор инструкций вида op destination source способы адресации прямая регистровая абсолютная косвенная Адресация Обозначение Адрес Добавочная стоимость абсолютная регистровая индексированная косвеннорегистровая косвенноиндексированная константа в команде M R CR R CR C M...
20622. Базовые блоки 111.5 KB
  Говорят что трехадресная инструкция вида определяет x и использует y и z. Выход: список базовых блоков такой что каждая трех адресная инструкция принадлежит только одному блоку. Правила: первая инструкция является лидером. любая инструкция являющаяся целевой инструкцией условного или безусловного переходов является лидером.
20623. Многообразие и единство мира 92 KB
  Элементарные частицы фундаментальные частицы и частицы переносчики фундаментальных взаимодействий3. В соответствии с этими представлениями выделяются следующие уровни: Уровни Условные границы Размер м Масса кг Микромир r =108 m = 1010 Макромир r 108 107 m 1010 1020 Мегамир r 107 m 1020 Понятие микромир охватывает фундаментальные и элементарные частицы ядра атомы и молекулы. Элементарные частицы фундаментальные частицы и частицы переносчики фундаментальных взаимодействий Элементарные частицы это частицы входящие в состав...
20624. Мегамир, основные космологические и космогонические представления 115 KB
  среднее расстояние от Земли до Солнца равное 15×1011м. Все планеты остывшие тела светящиеся отраженным от Солнца светом. Солнечная система Девять планет вращающиеся вокруг Солнца принято делить на две группы: планеты Земной группы Меркурий Венера Земля Марс и планетыгиганты Юпитер Сатурн Уран Нептун Плутон. Считается что диаметр Солнечной системы равен приблизительно 6×1016 м: на этом расстоянии планеты удерживаются силой тяготения Солнца.
20625. Мегамир. Основные космогонические представления 81.5 KB
  Звезды их характеристики источники энергии2. Звезды их характеристики источники энергии Более 90 видимого вещества Вселенной сосредоточено в звездах. Именно звезды и планеты были первыми объектами астрономических исследований. Пожалуй лишь диск нашего солнца позволяет реально наблюдать процессы происходящие на поверхности звезды.
20626. Мегамир, основные космогонические представления 107 KB
  Имеются многочисленные данные подтверждающие предположение что звезды образуются при конденсации облаков межзвездной пыли и газа. Глобула становится зародышем будущей звезды протозвездой и начинает светиться так как энергия движения частиц переходит в тепло. Дальнейшее сжатие протозвезды приводит к такому повышению температуры и давления что становятся возможными термоядерные реакции синтеза гелия из водорода. При этом силы тяготения стремящиеся сжать вещество звезды уравновешиваются силами внутреннего давления.