Создание графических изображений. Модуль GraphЗадача 1. Построить различные геометрические фигуры. Uses Graph, Crt; VAR Gd,Gm: INTEGER; Radius, I, Width, K: INTEGER; Y0, Y1, Y2, X1, X2: INTEGER; Pattern: FillPatternType; Points: ARRAY[1..6] OF PointType; BEGIN Gd:=vga; Gm:=1; { Инициализация графического режима } InitGraph(Gd,Gm,'C:\tp7\bgi'); IF GraphResult<>0 THEN HALT(1); SetBkColor(0); SetColor(2); {Цвет фона и изображения} I:=0; FOR Radius:=1 TO 5 DO Begin {Построение окружностей } SetColor(Radius+4); Circle(150,150,Radius*25); Inc(I); IF I=4 THEN I:=0; End; ReadLn; ClearDevice; SetBkColor(1); SetColor(5); SetLineStyle(0,0,3); Ellipse(130,130,0,360,30,50); {эллипс} ReadLn; ClearDevice; SetColor(4); Ellipse(130,130,0,180,100,70); { эллиптическая дуга} ReadLn; ClearDevice; K:=4; FOR Radius:=1 TO 5 DO Begin SetColor(K); Arc(300,100,0,90,Radius*20); {дуги} Inc(K); end; ReadLn; ClearDevice; Width:=20; SetColor(1); SetBkColor(11); FOR I:=1 TO 5 DO Begin SetFillStyle(7,I+4); {определение стиля заполнения} Bar(I*Width,I*20,Succ(I)*Width,200); {построение прямоугольников} end; SetFillStyle(5,12); Bar(150,150,250,250); ReadLn; {Построение параллелепипеда с верхней плоскостью} SetFillStyle(8,4); ClearDevice; Y1:=100; Y2:=200; X1:=230; X2:=300; SetLineStyle(3,0,3); {Определение стиля линии} Bar3d(x1,y1,x2,y2,10,topon); ReadLn; {Построение параллелепипеда без верхней плоскости} ClearDevice; SetLineStyle(0,0,1); setfillstyle(11,1); bar3d(x1,y1,x2,y2,10,topoff); ReadLn; {Пользовательский шаблон заполнения} CleardDevice; SetColor(6); SetLineStyle(0,0,3); { Стиль линии} {заполнение массива} Pattern[1]:=31; Pattern[2]:=62; Pattern[3]:=124; Pattern[4]:=248; Pattern[5]:=124; Pattern[6]:=62; Pattern[7]:=31; Pattern[8]:=0; SetFillPattern(pattern,12); {Задание шаблона пользователя} Bar(10,10,GetMaxX Div 2,GetMaxY Div 2); Rectangle(10,10,GetMaxX Div 2,GetMaxY Div 2); ReadLn; {Построение закрашенного сектора эллипса} ClearDevice; SetBkColor(3); SetColor(4); SetFillStyle(7,14); Sector(100,100,0,90,50,70); ReadLn; ClearDevice; SetFillStyle(1,14); {Построение закрашенного сектора круга} Pieslice(150,150,90,360,100); ReadLn; {Построение эллипса, заполненного текущим цветом} ClearDevice; SetFillStyle(6,13); SetLineStyle(3,0,1); FillEllipse(200,200,50,100); ReadLn; {Построение закрашенного многоугольника} ClearDevice; Randomize; SetLineStyle(0,0,1); SetFillStyle(11,1); {Определение случайных координат вершин} FOR I:=1 TO 5 DO Begin Points[I].X:=Random(GetMaxX); Points[I].Y:=Random(GetMaxY); End; Points[6].X:=Points[1].Y; Points[6].Y:=Points[1].Y; Fillpoly(6,Points); ReadLn; CloseGraph; END. Задача 2. Написать систему ниспадающего меню, которая в зависимости от выбора пользователя выводит на экран: красит экран в белый и черный цвет; термометр, у которого ртутный столбик поднимается; термометр, у которого ртутный столбик опускается. USES Graph, Crt; VAR Dr, Md, M, X, Y, I: INTEGER; Ch:CHAR; BEGIN Dr:=Detect; InitGraph(Dr,Md,'c:\tp7\bgi'); IF GraphResult<>0 then HALT(1); REPEAT SetBkColor(1); SetColor(6); SetTextStyle(0,0,2); ClearDevice; { Вывод меню } OutTextXY(50,140,'Пробел - Красим экран'); OutTextXY(50,170,'Стрелка вверх - Столбик поднимается'); OutTextXY(50,200,'Стрелка вниз - Столбик опускается'); OutTextXY(50,230,'ESC - Выход'); REPEAT Ch:=ReadKey; {разветвление программы по нажатию клавиши} CASE Ch OF #32:Begin { Красим экран } ClearDevice; SetBkColor(0); SetFillStyle(1,15); Bar(0,0,GetMaxX div 2,GetMaxY); SetFillStyle(1,0); Bar(GetMaxX div 2,0,GetMaxX,GetMaxY); OutTextXY(70,GetMaxY-25,'Нажмите DEL'); End; #72:Begin { Ртутный столбик поднимается } ClearDevice; SetLineStyle(0,0,1); SetBkColor(1); SetColor(4); X:=GetMaxX div 2; Y:=GetMaxY div 2; Rectangle(X,Y,X+40,GetMaxY-20); FOR I:=1 TO120 DO Begin SetColor(4); SetLineStyle(0,0,3); Line(X,GetMaxY-20-I,X+40,GetMaxY-20-i); Delay(250); End; OutTextXY(70,GetMaxY-25,'Нажмите DEL'); End; #80:Begin { Ртутный столбик опускается } ClearDevice; SetLineStyle(0,0,1); SetBkColor(1); SetColor(4); X:=GetMaxX div 2; Y:=GetMaxY div 2; Rectangle(x,y,x+40,GetMaxY-20); SetFillStyle(1,4); Bar(x,GetMaxY-140,x+40,GetMaxY-20); FOR I:=1 TO 117 DO Begin SetColor(1); SetLineStyle(0,0,3); Line(x+1,GetMaxY-140+i,x+39,GetMaxY-140+i); Delay(250); End; SetColor(4); OutTextXY(70,GetMaxY-25,'Нажмите DEL'); End; End; UNTIL (Ch=#83) or (Ch=#27); UNTIL (Ch=#27); CloseGraph; END. Задача 3. Написать систему ниспадающего меню, которая в зависимости от выбора пользователя выводит на экран день и ночь. USES Crt,Graph; LABEL Ex,New; VAR Gd,Gm: INTEGER; Av: CHAR; PROCEDURE DAY; {процедура-солнечное затмение} VAR X,Y,X1,Y1: INTEGER; U: REAL; BEGIN ClearDevice; SetFillStyle(1,14); SetColor(14); X:=GetMaxX DIV 2; Y:=GetMaxY DIV 2; FillEllipse(X,Y,50,50); {солнце} FOR Gm:=1 TO 150 DO Begin U:=Random(359); X1:=Trunc(Random (200)*COS(U))+X; Y1:= Trunc (Random (200)*SIN(U))+Y; Line(X,Y,X1,Y1); {солнечные лучи} End; SetFillStyle(1,8); SetColor(8); FillEllipse(X-15,Y,50,50); {тень луны} REPEAT UNTIL KeyPressed; {задержка до нажатия любой клавиши} END; PROCEDURE NOCH; {процедура - лунная ночь со звездами} VAR R,X,Y,I:INTEGER; BEGIN ClearDevice; SetFillStyle (1,15); SetColor (15); FOR I:=1 TO 50 DO Begin R:= Random (2); PutPixel(Random (GetMaxX), Random (GetMaxY),15); PutPixel(Random (GetMaxX), Random (GetMaxY),15); FillEllipse(Random (GetMaxX), Random (GetMaxY),R,R); End; SetFillStyle (1,15); SetColor (15); FillEllipse (200,100,50,50); SetFillStyle (1,0); SetColor (0); FillEllipse (180,100,50,50); {луна} REPEAT UNTIL KeyPressed; {задержка до нажатия любой клавиши} END; BEGIN{основная программа} Gd:=Detect; InitGraph(Gd,Gm,'C:\tp7\BGI'); WHILE true DO Begin SetFillStyle (1,1); FloodFill(10,10,1); SetFillStyle (1,0); Bar(215,115,415,365); SetColor (5); SetFillStyle (1,5); Bar(200,100,400,350);{меню} SetTextStyle(7,0,5); SetColor (0); OutTextXY(237,117,'MENU'); OutTextXY (237,287,'EXIT'); SetColor (12); OutTextXY (235,115,'MENU'); SetColor (4); OutTextXY (235,285,'EXIT'); SetTextStyle (0,0,3); SetColor (0); OutTextXY (227,207,'D:ДЕНЬ'); OutTextXY (227,247,'N:НОЧЬ'); SetColor (3); OutTextXY (225,205,'D:ДЕНЬ'); OutTextXY (225,245,'N:НОЧЬ'); SetColor (15); SetTextStyle (0,0,2); OutTextXY (100,450,'использовать клавиши D,N,ESC'); Av:=ReadKey; CASE Av OF {разветвление программы по нажатию клавиши} 'D','d': DAY; 'N','n': NOCH; CHR(27): GOTO Ex; End; End; Ex: CloseGraph; END. Задача 4. Построить график функции. USES Crt, Graph; VAR Gd, Gm: INTEGER; X0, Y0: INTEGER; { Начало осей координат } X, Y: INTEGER; Mx, My, I: INTEGER; A, B, H, F: REAL; BEGIN WriteLn('Введите интервал и шаг изменения функции'); ReadLn(A,B,H); WriteLn('Введите масштаб по X и Y'); ReadLn(Mx,My); Gd:=Detect; Gm:=1; InitGraph(Gd,Gm,'c:\tp7\bgi'); IF GraphResult<>0 THEN HALT(1); { Построение осей координат } X0:=GetMaxX div 2; Y0:=GetMaxY div 2; Line(10,Y0,GetMaxX,Y0); Line(X0,10,X0,GetMaxY); { Построение стрелок } Line(X0,10,X0-10,20); Line(X0,10,X0+10,20); Line(GetMaxX,Y0,GetMaxX-10,Y0-10); Line(GetMaxX,Y0,GetMaxX-10,Y0+10); OutTextXY(X0-25,10,'X'); OutTextXY(GetMaxX-20,Y0+20,'Y'); { Разметка осей координат } I:=X0; REPEAT I:=I+Mx; PutPixel(I,Y0-1,15); PutPixel(2*X0-I,Y0-1,15); UNTIL I>GetMaxX; I:=Y0; REPEAT I:=I+My; PutPixel(X0+1,I,15); PutPixel(X0+1,2*Y0-I,15); UNTIL I>GetMaxY; { Построение графика функции } REPEAT F:=A*A; { функция } X:=Trunc(X0+A*Mx); Y:=Trunc(Y0-F*My); PutPixel(X,Y,15); A:=A+H; UNTIL A>B; ReadLn; END. Задача 5. Построить круговую диаграмму. USES Сrt,Graph; VAR Gd, Gm: INTEGER; I,N,S,C: INTEGER; M: ARRAY[1..10] OF INTEGER; Nk, Kk: INTEGER; P:REAL; BEGIN WriteLn('Введите количество значений'); ReadLn(N); S:=0; FOR I:=1 TO N DO Begin Writeln('Введите ',I,' значение'); ReadLn(M[I]); S:=S+M[I]; end; P:=360/S; {приходится радиан на 1% } Gd:=Detect; Gm:=1; InitGraph(Gd,Gm,'c:\tp7\bgi'); IF GraphResult<>0 THEN HALT(1); S:=0; C:=1; FOR I:=1 TO N DO Begin Nk:=Trunc(P*S); { Начальный угол } Kk:=Trunc(P*(S+M[I])); { Конечный угол } SetFillStyle(1,C); PieSlice(GetMaxX div 2,GetMaxY div 2,nk,kk,100); S:=S+m[i]; C:=C+1; IF C=14 THEN C:=1; { Изменение цвета } End; ReadLn; CloseGraph; END. Задача 6. Построить пятиконечную звезду. USES Crt,Graph; VAR Gd,Gm: INETEGER; X,Y,Rb,Rm: INETEGER; Points: ARRAY [1..11] OF PointType; {Массив вершин } I, A: REAL; BEGIN Gd:=Detect; Gm:=1; InitGraph(Gd,Gm,'c:\tp7\bgi'); IF GraphResult<>0 THEN HALT(1); Rb:=150; Rm:=70; ClearDevice; SetBkColor(3); SetColor(4); SetFillStyle(1,4); I:=1; A:=0.94; { Определение координат вершин звезды } WHILE (I<=10) DO Begin X:=Trunc(Rb*COS(A))+300; Points[I].X:=X; Y:=Trunc(Rb*SIN(A))+200; Points[I].Y:=Y; Inc(I); A:=A+0.628; X:=Trunc(Rm*COS(A))+300; Points[I].X:=X; Y:=Trunc(RM*SIN(A))+200; Points[I].Y:=Y; Inc(I); A:=A+0.628; End; { Связь координат первой и последней вершин } Points[11].X:=Points[1].X; Points[11].Y:=Points[1].Y; FillPoly(11,Points); { Построение звезды } ReadLn; CloseGraph; END. Задача 7. Построить объект, который передвигается с помощью навигационных клавиш. USES Crt,Graph; VAR Gd,Gm: INTEGER; Av: CHAR; X,Y,I,T,Z,K: INTEGER; St: STRING[225]; BEGIN Gd:=Detect; InitGraph(Gd,Gm,'C:\tp7\BGI'); ClearDevice; X:=GetMaxX DIV 2; Y:=GetMaxY DIV 2; T:=0; I:=0; K:=500; REPEAT SetColor(15); { Построение объекта } Line(X,Y-10,X,Y-3); Line (X,Y+10,X,Y+3); Line (X-10,Y,X-3,Y); Line (X+10,Y,X+3,Y); Circle(X,Y,7); Av:=ReadDKey; { Изменение координат при нажатии клавиши } IF CHR(75)=Av THEN T:=-10; IF CHR(77)=Av THEN T:=10; IF CHR(72)=Av THEN I:=-10; IF CHR(80)=Av THEN I:=10; SetColor (0); Line (X,Y-10,X,Y-3); Line (X,Y+10,X,Y+3); Line (X-10,Y,X-3,Y); Line (X+10,Y,X+3,Y); Circle(X,Y,7); X:=X+T; Y:=Y+I; I:=0; T:=0; IF X>(GetMaxX-2) THEN X:=GetMaxX-2; IF X<2 THEN X:=2; IF Y>(GetMaxY-2) THEN Y:=GetMaxY-2; IF Y<2 THEN Y:=2; UNTIL ORD(Av)=27; { Пока не нажата клавиша Esc } END. Задача 8. Построить орнамент. USES Crt, Graph; VAR Gd,Gm: INTEGER; Av: CHAR; X1, Y1, X, Y: INTEGER; U, H: REAL; BEGIN Gd:=Detect; InitGraph(Gd,Gm,'C:\tp7\BGI'); SetFillStyle(1,14); SetBkColor(5); SetColor(14); X:=GetMaxX DIV 2; Y:=GetMaxY DIV 2; U:=2*Pi; While U>=0 DO Begin X1:=Trunc(100*COS(U))+X; Y1:=Tunc(100*SIN(U))+Y; Circle(X1,Y1,3); Delay(1000); U:=U-0.1; End; H:=-5; While H<=45 DO Begin X:=Trunc(100+H*10); Y:=Trunc(100-SIN(H)*10); Circle(X,Y,2); Delay(500); H:=H+0.5; End; H:=-5; While H<=45 DO Begin X:=Trunc(100+H*10); Y:=Trunc(380-SIN(H)*10); Circle(X,Y,2); Delay(500); H:=H+0.5; End; ReadLn; END. ..................................................................................................................................... Практические задания ..................................................................................................................................... 1. Построить семейство одинаковых окружностей, центры которых лежат на окружности большего диаметра. 2. По периметру экрана построить семейство разноцветных квадратов, а в середине – множество разноцветных точек. 3. Построить движущиеся изображения двух прямоугольников и круга, на которых помещены слова из фразы “ КТО СКАЗАЛ МЯУ?”. 4. Построить движущиеся НЛО на фоне звездного неба. 5. Написать систему ниспадающего меню, которая в зависимости от выбора пользователя выводит на экран круг, квадрат или треугольник.
uses crt; var i:byte; CH:CHAR; begin clrscr; for i:=0 to 255 do write (chr(i):2); REPEAT CH:=READKEY; WRITE(ORD(CH):4); UNTIL CH='D'; end.
|