Создание графических изображений
Модуль 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.
.....................................................................................................................................
Практические задания
.....................................................................................................................................
- Построить семейство одинаковых окружностей, центры которых лежат на окружности большего диаметра.
- По периметру экрана построить семейство разноцветных квадратов, а в середине – множество разноцветных точек.
- Построить движущиеся изображения двух прямоугольников и круга, на которых помещены слова из фразы “ КТО СКАЗАЛ МЯУ?”.
- Построить движущиеся НЛО на фоне звездного неба.
- Написать систему ниспадающего меню, которая в зависимости от выбора пользователя выводит на экран круг, квадрат или треугольник.
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.
