Студопедия — Создание графических изображений. Модуль Graph
Студопедия Главная Случайная страница Обратная связь

Разделы: Автомобили Астрономия Биология География Дом и сад Другие языки Другое Информатика История Культура Литература Логика Математика Медицина Металлургия Механика Образование Охрана труда Педагогика Политика Право Психология Религия Риторика Социология Спорт Строительство Технология Туризм Физика Философия Финансы Химия Черчение Экология Экономика Электроника

Создание графических изображений. Модуль 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.







Дата добавления: 2015-09-19; просмотров: 551. Нарушение авторских прав; Мы поможем в написании вашей работы!



Аальтернативная стоимость. Кривая производственных возможностей В экономике Буридании есть 100 ед. труда с производительностью 4 м ткани или 2 кг мяса...

Вычисление основной дактилоскопической формулы Вычислением основной дактоформулы обычно занимается следователь. Для этого все десять пальцев разбиваются на пять пар...

Расчетные и графические задания Равновесный объем - это объем, определяемый равенством спроса и предложения...

Кардиналистский и ординалистский подходы Кардиналистский (количественный подход) к анализу полезности основан на представлении о возможности измерения различных благ в условных единицах полезности...

Тема: Составление цепи питания Цель: расширить знания о биотических факторах среды. Оборудование:гербарные растения...

В эволюции растений и животных. Цель: выявить ароморфозы и идиоадаптации у растений Цель: выявить ароморфозы и идиоадаптации у растений. Оборудование: гербарные растения, чучела хордовых (рыб, земноводных, птиц, пресмыкающихся, млекопитающих), коллекции насекомых, влажные препараты паразитических червей, мох, хвощ, папоротник...

Типовые примеры и методы их решения. Пример 2.5.1. На вклад начисляются сложные проценты: а) ежегодно; б) ежеквартально; в) ежемесячно Пример 2.5.1. На вклад начисляются сложные проценты: а) ежегодно; б) ежеквартально; в) ежемесячно. Какова должна быть годовая номинальная процентная ставка...

ФАКТОРЫ, ВЛИЯЮЩИЕ НА ИЗНОС ДЕТАЛЕЙ, И МЕТОДЫ СНИЖЕНИИ СКОРОСТИ ИЗНАШИВАНИЯ Кроме названных причин разрушений и износов, знание которых можно использовать в системе технического обслуживания и ремонта машин для повышения их долговечности, немаловажное значение имеют знания о причинах разрушения деталей в результате старения...

Различие эмпиризма и рационализма Родоначальником эмпиризма стал английский философ Ф. Бэкон. Основной тезис эмпиризма гласит: в разуме нет ничего такого...

Индекс гингивита (PMA) (Schour, Massler, 1948) Для оценки тяжести гингивита (а в последующем и ре­гистрации динамики процесса) используют папиллярно-маргинально-альвеолярный индекс (РМА)...

Studopedia.info - Студопедия - 2014-2024 год . (0.015 сек.) русская версия | украинская версия