Если установить курсор на слова Ellipse.PAS и нажать "перевод строки", то на экране Вы увидите текст программы, иллюстрирующий применение этой процедуры). Эта информация может пригодиться даже тем, кто не знает ни одного английского слова - Вы увидите, сколько у процедуры параметров и какие у этих параметров типы; Вы можете обычным образом (клавишами управления курсором при нажатой клавише Shift) отметить текст примера, скопировать в пустое окно и запустить.
Пример 11 . Изобразить график функции y=cos(x).
При изображении графика функции необходимо иметь ввиду, что начало графических координат находится в левом верхнем углу экрана и что графические координаты принимают целые неотрицательные значения в диапазоне (0,maxx) и (0,maxy). Значения maxx и maxy для каждого режима можно определить, используя соответствующие функции. Таким образом, для получения "хорошего" графика необходимо выполнить поворот и масштабирование. Пусть, xmax - максимальное значение по оси x; ymax - максимальное значение по оси y;
(x0,y0) - графические координаты центра - точки (0,0);
(xg,yg) - графические координаты точки (x,y);
mx - масштаб по оси x, т.е. величина Abs((xg-x0)/x);
my - масштаб по оси y, т.е. величина Abs((yg-y0)/y).
Графические координаты точки (x,y): xg=x0+mx*x; yg=y0-my*f(x).
PROGRAM Primer_11;
Uses Graph;
var x,y,a,b,h : Real;
x0,y0,xg,yg,xmax,ymax,mx,my,grd,grm,c: Integer;
BEGIN
WriteLn ('Введите координаты центра: '); ReadLn (x0,y0);
WriteLn ('Введите масштаб по x и y: '); ReadLn (mx,my);
WriteLn ('Введите область задания функции по x и шаг: ');
ReadLn (a,b,h); WriteLn ('Введите цвет изображения: ');
ReadLn (c); grd:=0; grm:=0; InitGraph (grd,grm,'');
c:=getcolor; xmax:=getmaxx; ymax:=getmaxy;
Line (10,y0,xmax-10,y0); { Ось OX }
Line (x0,10,x0,ymax-10); { Ось OY }
x:=a;
While x<=b do
begin
xg:=x0+Trunc(mx*x); yg:=y0-Trunc(my*f(x));
If (xg>=0) AND (xg<=xmax) AND (yg>=0) AND (yg<=ymax)
then putpixel (xg,yg,c);
x:=x+h
end;
ReadLn;
closegraph
END.
Пример 12 . Изобразить движение шарика по синусоиде.
Движение реализуется с помощью процедур GetImage и PutImage. Процедура GetImage запоминает образ изображаемого объекта и образ области экрана такого же размера, закрашенной цветом фона. Процедура PutImage на каждом шаге последовательно заменяет старое изображение цветом фона и создает изображение на новом месте.
PROGRAM Primer_12;
{ Программа движения шарика со следом по синусоиде }
uses Graph;
var p1,p2: Pointer;
{ p1 - указатель на образ "следа",
p2 - указатель на образ шарика }
grm,grd,x,y,x1,y1: Integer;
size,c : Word;
BEGIN
grd:=0; InitGraph (grd,grm,'D:\Tp\Bgi');
{ Инициализация графического режима с автоматическим
определением подходящего драйвера }
c:=GetColor; { c - цвет изображения }
x1:=0;y1:=90; { x1,y1 - начальные координаты шарика }
PutPixel (0,y1+5,c); { Изображение "следа" }
size:=ImageSize(0,0,10,10); GetMem (p1,size);
{ size - количество байтов для изображения квадрата 11x11 }
GetImage (0,y1,10,y1+10,p1^);
{ p1 указывает на область памяти с изображением следа }
SetFillStyle (11,c); { Устанавливается тип и цвет закраски }
Circle (x1+5,y1+5,5); { Окружность с центром в (x1,y1) }
FloodFill (x1+5,y1+5,c); { Закраска окружности }
GetMem (p2,size); GetImage (x1,y1,x1+10,y1+10,p2^);
{ p2 указывает на область памяти с изображением шарика }
For x:=1 to 300 do
begin
y:=Trunc (40*sin(0.1*x)+90);
{ x,y - графические координаты нового положения шарика }
PutImage (x1,y1,p1^,0); { На месте шарика изображается след }
PutImage (x,y,p2^,0); { Шарик изображается на новом месте }
x1:=x; y1:=y { Запоминаются новые координаты шарика }
end;
ReadLn; Closegraph
END.
Пример 13 . Управление движением объекта.
Направление движения определяется нажатой клавишей (стрелки влево, вправо, вверх, вниз). Шаг перемещения вводится. Реализация движения характеризуется тем, что на каждом шаге запоминается образ области экрана, куда помещается курсор, затем при смещении курсора изображение восстанавливается.
PROGRAM Primer_13;
{ Программа управления движением курсора.
Курсор - прямоугольный объект, двигающийся вверх, вниз,
вправо, влево при нажатии соответствующих стрелок.
Выход при нажатии клавиши ESC }
uses Crt,Graph;
{ Модуль Crt необходим для использования Readkey }
PROCEDURE BadKey;
{ Процедура формирует звук при нажатии неправильной клавиши }
BEGIN
Sound (500); Delay (100); Sound (400);
Delay (200); Nosound
END;
var p,pc: Pointer;
{pc - указатель на образ курсора,
p - указатель на образ изображения "под" курсором }
grm,grd,curx,cury,curx0,cury0,lx,ly,hx,hy:integer;
size,c:word; ch:char;
{ grd,grm - переменные для номеров графических драйверов и режима
curx,cury - координаты текущего положения курсора
curx0,cury0 - переменные для запоминания координат курсора
lx,ly - ширина и длина курсора прямоугольного вида
hx,hy - шаги движения курсора по горизонтали и вертикали }
BEGIN
WriteLn ('Введите размеры курсора и шаги движения');
ReadLn (lx,ly,hx,hy);
{ Установка значения системной переменной для обеспечения
совместимости работы модулей Crt и Graph }
DirectVideo:=FALSE;
grd:=0; InitGraph (grd,grm,'D:\Tp\Bgi');
{ Инициализация графического режима с автоматическим
определением подходящего драйвера }
c:=GetColor; { c - цвет изображения }
size:=ImageSize (0,0,lx,ly);
{ size - количество байтов для изображения курсора }
GetMem (pc,size); GetMem (p,size);
{ Выделяются области для хранения образа курсора,
и образа изображения под курсором }
SetFillStyle (1,c); { устанавливается тип и цвет закраски курсора }
GetImage (0,0,lx,ly,p^);
{ p указывает на область памяти, где хранится изображение,
которое будет "закрыто" курсором }
curx:=0; cury:=0;
Bar (0,0,lx,ly); GetImage (0,0,lx,ly,pc^);
{ pc указывает на область памяти с изображением курсора }
SetColor (6); SetFillStyle (1,2);
Bar3d (150,150,200,30,10,TRUE);
{ Параллелограмм, на фоне которой происходит движение }
Repeat { Цикл по вводу символа }
ch:=ReadKey; { Ввод очередного символа }
If Ord(ch)=0
then { Нажата управляющая клавиша }
begin
ch:=ReadKey;
curx0:=curx; cury0:=cury;
{ В переменных curx,cury запоминаются координаты курсора }
Case Ord(ch) of
77: If curx<getmaxx-hx
then curx:=curx+hx; { Шаг вправо }
75: If curx>hx
then curx:=curx-hx; { Шаг влево }
72: If cury>hy
then cury:=cury-hy; { Шаг вверх }
80: If cury<getmaxy-hy
then cury:=cury+hy { Шаг вниз }
else BadKey { Нажата "неправильная" клавиша }
end;
If (curx<>curx0) OR (cury<>cury0)
then begin
PutImage (curx0,cury0,p^,0);
{ Восстановить изображение, которое было "закры-
то" курсором }
GetImage (curx,cury,curx+lx, cury+ly,p^);
{ Запомнить то изображение, которое будет "зак-
рыто" курсором }
PutImage (curx,cury,pc^,0);
{ Установить курсор в новое положение }
end
end
else BadKey
until Ord(ch)=27;
CloseGraph
END.
Пример 14. Вычеркивание по выбору граф элементы.
uses graph,crt;
var gd,gm,choice:integer;
begin
initgraph(gd,gm,'');
outtext('Выберите длину отрезка:1-50 точек(1), 2-150 точек(2)');
readln(choice);
case choice of
1:LINE (295, 240,345, 240);
2:LINE (245, 240,395, 240);
end;
repeat;
until keypressed;
closegraph;
end.
Пример 15. Выполнение граф построений
uses graph,crt;
var gd,gm:integer;
begin
initgraph(gd,gm,'c:\bp\bgi');
LINE (150, 100,67, 100);
LINE (67, 100,102, 68);
LINE (102, 68,150, 100);
floodfill (100, 90, 15);
delay(2000);
clearviewport;
bar(73, 49,141, 109);
delay(2000);
clearviewport;
LINE (73, 49,103, 79);
LINE (103, 79,92, 120);
LINE (92, 120,50, 120);
LINE (50, 120,31, 79);
LINE (31, 79,73, 49);
floodfill (90, 90, 15);
delay(2000);
clearviewport;
LINE (73, 49,111, 49);
LINE (111, 49,132, 71);
LINE (132, 71,111, 93);
LINE (111, 93,73, 93);
LINE (73, 93,52, 71);
LINE (52, 71,73, 49);
floodfill (100, 90, 15);
repeat;
until keypressed;
closegraph;
end.
Пример 16. Начертить N окружностей.
uses graph,crt;
var gd,gm,n,i:integer;
begin
initgraph(gd,gm,'c:\bp\bgi');
outtext('Введите кол-во окружностей');
readln(n);
clearviewport;
FOR i:= 1 TO n do
begin;
CIRCLE (Random(640),Random(480), 50)
end;
repeat;
until keypressed;
closegraph;
end.
Пример 17. Построить многоугольник со сторонами 60 и 20 точек.
uses graph,crt;
var gd,gm,x,x1,y,y1:integer;
begin
initgraph(gd,gm,'c:\bp\bgi');
outtextxy(20,0,'Введите координаты левого верхнего угла прямоугольника (x,y)');
readln(x);
readln(y);
outtextxy(20,10,'Введите координаты правого нижнего угла прямоугольника (x1,y1)');
readln(x1);
readln(y1);
rectangle(x,y,x1,y1);
repeat;
until keypressed;
closegraph;
end.
Пример 18. Построить и закрасить круг.
uses graph,crt;
var gd,gm,x,y,r:integer;
begin
initgraph(gd,gm,'c:\bp\bgi');
outtextxy(40,0,'Введите координаты центра окружности');
readln(x);
readln(y);
outtextxy(40,20,'Введите радиус окружности');
readln(r);
CIRCLE (x, y, r);
floodfill(x,y, 15);
repeat;
until keypressed;
closegraph;
end.
Пример 19. Построить из окружностей рисунок облака.
uses graph,crt;
var gd,gm:integer;
begin
initgraph(gd,gm,'c:\bp\bgi');
SetFillStyle(1, 15);
setcolor(15);
CIRCLE (320, 240, 100);
floodfill (320, 240, 15);
CIRCLE (220, 240, 80);
floodfill (200, 240, 15);
CIRCLE (420, 240, 80);
floodfill (440, 240, 15);
repeat;
until keypressed;
closegraph;
end.
Пример 20. Построение звезды.
uses graph,crt;
var gd,gm:integer;
begin
initgraph(gd,gm,'c:\bp\bgi');
setcolor(15);
line(220,240,320,100);
line(320,100,420,240);
line(220,140,420,140);
line(220,140,420,240);
line(420,140,220,240);
delay(3000);
end.
Пример 21 . Построение квадрата.
uses graph,crt;
var gd,gm,x,y,side:integer;
begin
initgraph(gd,gm,'c:\bp\bgi');
outtextxy(30,0,'Введите сторону квадрата.');
readln(side);
clearviewport;
outtextxy(30,0,'Введите координаты центра квадрата(X и Y через ENTER)');
readln(x);
readln(y);
clearviewport;
rectangle(x-side,y - side ,x + side , y + side );
repeat;
until keypressed;
closegraph;
end.
Пример 22. Рисование луны.
uses crt,graph;
var gd,gm,choice:integer;
label 1,2,3;
begin;
clrscr;
writeln('1.полнолуние, 2.1/2 луны, 3.месяц');
readln(choice);
initgraph(gd,gm,'c:\bp\bgi');
IF choice = 1 THEN GOTO 1;
IF choice = 2 THEN GOTO 2;
IF choice = 3 THEN GOTO 3;
halt;
1:
CIRCLE (320, 240, 100);
floodfill(320,240,15);
repeat;
until keypressed;
halt;
2 :
arc(320, 240, 90, 270, 100);
LINE (320, 140,320, 340);
floodfill(300,240,15);
repeat;
until keypressed;
halt;
3 :
arc(320, 240, 90, 270, 100);
arc(490, 240, 150, 210, 200);
floodfill(285,240,15);
repeat;
until keypressed;
halt;
closegraph;
end.
Пример 23. Построение треугольника по заданным координатам.
uses crt,graph;
var gd,gm,x,y,a,c:integer;
begin
clrscr;
writeln('Введите координаты центра звезды X и Y ');
readln(x);
readln(y);
writeln('Введите длину луча звезды (не меньше 90)');
readln(a);
initgraph(gd,gm,'c:\bp\bgi');
c:=round(3/4*a);
line(x,y-a,x+c,y+2*c);
line(x,y-a,x-c,y+2*c);
line(x+c,y+2*c,x-a-10,y-25);
line(x-c,y+2*c,x+a+10,y-25);
line(x+a+10,y-25,x-a-10,y-25);
delay(3000);
closegraph;
end.
Пример 24. Построение кораблика
uses graph,crt;
var gd,gm:integer;
a,h:real;
begin
initgraph(gd,gm,'c:\bp\bgi');
outtextxy (30,0,'Введите высоту и длину палубы (H и A через Enter)');
readln(h);
readln(a);
LINE (320 + round(a / 2), 240 - round(h / 2),320 + round(a/2), 240 + round(h/ 2));
LINE (320 + round(a / 2), 240 - round(h / 2),320 - round(a / 2), 240 - round(h / 2));
LINE (320 - round(a / 4), 240 + round(h / 2),320 + round(a / 2), 240 + round(h / 2));
LINE (320 - round(a / 4), 240 + round(h / 2),320 - round(a / 2), 240 - round(h / 2));
LINE (320, 240 - round(h / 2),320, 240 - round(h * 2));
LINE (320, 240 - round(h * 2),320 + round(a / 5), round(240 - h));
LINE (320, 240 - round(h),320 + round(a / 5),round( 240 - h));
repeat;
until keypressed;
closegraph;
end.
Пример25. Программа рисует звездное небо с 400 звездами, вспыхивающими постепенно, полную желтую луну.
Program Work_8;
Uses Graph, Crt;
Var k, gd, gm: integer ;
Begin
Gd:=detect ;
InitGrapf (gd, gm, ‘’);
Randomize;
For i:=1 to 400 do
Begin
Putpixel(random(640), random(480), random(15)+1);
Deley (10); {задержка – пауза в 1 сек}
End;
SetColor (14); {задаем цвет окружности 14 - желтый}
Circle (300,100,30);
Floodfill (310,110,yellow); {закрашиваем луну}
Repeat until keypressed ; {пока не нажата любая клавиша}
Closegraph ; {закрываем графический режим}
End.
