Создание графических изображений. Модуль Graph

⇐ ПредыдущаяСтр 5 из 5

Задача 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;

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);

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;

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.

⇐ Предыдущая 1 2 3 45