251

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

Задача

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

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

Русский

2012-11-14

309 KB

23 чел.

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

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

    


 

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

43255. Исследование методов сортировки с поиском минимума и деревом 211 KB
  Простейшая задача сортировки заключается в упорядочении элементов массива по возрастанию или убыванию. Другой задачей является упорядочение элементов массива в соответствии с некоторым критерием. Обычно в качестве такого критерия выступают значения определенной функции, аргументами которой выступают элементы массива. В работе приводится постановка задачи сортировки и поиска данных, описание алгоритмов, описание программы и правила ее использования, а также прилагается текст программы, решающей поставленную задачу.
43256. Расчет гидропривода 486 KB
  Под гидроприводом понимают совокупность устройств, предназначенных для приведения в движение механизмов и машин посредством рабочей жидкости под давлением. В качестве рабочей жидкости в станочных гидроприводах используется минеральное масло.
43257. Схема для живлення переговорного пристрою 624.5 KB
  Аналізуючи ці схеми, можна впевнитися, що дана схема є найбільш актуальною у розробці, порівняно з її аналогами, приведеними нижче. Схема, що розробляється, призначена для живлення, як потужної так і малопотужної апаратури, залежно від максимально допустимого рівня пульсації на вході. З точки зору схемотехнічного проектування виробу, дана схема є найбільш простою, так як має найменшу кількість елементів, та не має потужних елементів схеми, які присутні в двох аналогічних схемах.
43258. Разработка и расчет законченного электронного устройства 669 KB
  Датчиком температуры описываемого прибора служит кремниевый диод. При этом используется линейная зависимость паления напряжения на нем от температуры при фиксированном прямом токе смешения. Температурный коэффициент напряжения (ТКН) для кремниевых диодов практически постоянен в диапазоне -60...+ 100°С и составляет -2...-2,5 мВ/°С — в зависимости от типа диода и значения тока смешения. Как показали исследования, практически любой кремниевый диод или транзистор может быть использован как линейный температурный преобразователь в диапазоне от -55-С до+125°С.
43259. Разработка усилителя низкой частоты 5.43 MB
  Рассчитаем максимальное напряжение в нагрузке по формуле: В Определим максимальный ток протекающий через нагрузку: Рассчитаем требуемый коэффициент усиления усилителя по формуле: Определим ориентировочное количество каскадов предварительного усиления по следующей формуле: Полученное по формуле количество каскадов округляют до ближайшего целого нечетного числа так как схема с ОЭ дает сдвиг фаз 180 n = 3 Выходной каскад ставится на выходе усилителя и обеспечивает усиление мощности полезного сигнала в нагрузку.4...
43260. Проектирование усилительного устройства 205 KB
  Курсовая работа содержит 12 листов текста 2 чертежа 3 источника литературы Содержание Предварительный расчет Структурная схема усилителя Расчет элементов схемы Расчет усилителя мощности Описание схемы электрической принципиальной Выбор схемы блока питания Список используемой литературы Введение Основной задачей курсового проекта является разработка схемы электрической принципиальной усилительного устройства по заданным параметрам а так же освоение практических навыков в области проектирования для более...
43261. Проектирование усилительного устройства 224.5 KB
  Основной задачей курсового проекта является разработка схемы электрической принципиальной усилительного устройства по заданным параметрам, а так же освоение практических навыков в области проектирования, для более близкого знакомства со всеми этапами разработки электрической схемы
43262. Розрахунок та побудова кривих швидкості і часу ходу поїзда 833.5 KB
  Перевірка розрахункової маси поїзда на можливість надійного подолання підйому крутість якого перевищує крутість розрахункового підйому. Перевірка розрахованої маси поїзда на зрушення з місця. Перевірка маси поїзда по довжині колій станцій Спрямлення профілю колії. Розрахунок та побудова кривих швидкості і часу ходу поїзда.
43263. Расчет годовых объемов работ 995.5 KB
  Исходные значения трудоемкостей основных видов работ № п п Наименование Значение 1 Мойка и уборка 06 2 Приемка и выдача 078 3 Предпродажная подготовка 55 4 ТО и ТР 61 5 Площадь автомобиля м2 215 Годовой объем уборочномоечных работ. Уборочномоечные работы выполняются перед ТО и ТР или как самостоятельный вид услуг. Годовой объем работ УМР где tУМР – средняя...