Иллюстрированный самоучитель по Turbo Pascal

Сохранение и выдача изображений

Следующая программа рисует "Неопознанный Летающий Объект" – летающую тарелку на звездном фоне (рис. 14.10).

Рис. 14.10. Иллюстрация процедур Getlmage/Putlmage:

Uses Graph, CRT;
const
r = 20; {Характерный размер НЛО}
pause = 50; {Длительность паузы}
var
d,m,e,xm/ym,x,y/lx,ly,rx,ry,
Size,i,dx,dy,Width,Height: Integer;
Saucer: Pointer;
label
loop;
begin
{Инициируем графику}
d: = Detect; lnitGraph(d, m, ' ');
e: = GraphResult; if e <> grOk then
WriteLn(GraphErrorMsg(e))
else
begin
x: = r*5;
у: = r*2;
xm: = GetMaxX div 4;
ym: = GetMaxY div 4;
{Создаем "тарелку" из двух эллипсов с усами антенн}
Ellipse (х,у,0.360,r,r div 3+2);,
Ellipse (х,у-4.190.357,r,r div 3);
Line (х+7,у-б,х+10,у-12);
Line (x-7,y-6, х-10, у-12);
Circle (x+10,y-12.2);
Circle (х-10,у-12.2);
FloodFill(x+l,y+4,White);
{Определяем габариты НЛО и помещаем его в кучу}
1х: = х-r-1;
1у: = у-14;
rх: = х+r+1;
rу: = у+r div 3+3;
Width: = rx -lx + 1;
Height: = ry -ly + 1;
Size: = ImageSize(lx, ly, rx, ry);
GetMem (Saucer, Size);
Getlmage (lx, ly, rx, ry, Saucer^);
{Стираем построенное}
Putlmage (lx, ly, Saucer^, xorPut);
{Создаем звездное небо}
Rectangle(xm,ym,3 *xm,3 *ym);
SetViewPort(xm+1,ym+1.3*xm-1.3*ym-1,ClipOn);
xm: = 2*xm;
ym: = 2*ym;
for i: = 1 to 200 do
PutPixe1 (Random(xm), Random(ym), White);
{Задаем начальное положение НЛО и направление движения}
х: = xm div 2;
у: = ym div 2;
dx: = 10;
dy: = 10;
{Основной цикл}
repeat
Putlmage(x,y,Saucer^,xorPut); {Изображаем НЛО на}
Delay(pause); {новом месте и после}
Putlmage (x, у, Saucer^, XorPut);{паузы стираем его}
{Получаем новые координаты}
loop: x: = x+dx;
у: = y+dy;
{НЛО достиг границы экрана?}
if (x<0) or (x+Width+1>xm) or
(у<0) or (y+Height+1>ym) then
begin {Да – НЛО достиг границы: меняем направление его перемещения}
x: = x-dx;
y: = y-dy;
dx: = GetMaxX div 10 – Random(GetMaxX div 5);
dy: = GetMaxY div 30 – Random(GetMaxY div 15);
goto loop
end
until KeyPressed;
if ReadKey=#0 then x: = ord(ReadKey);
CloseGraph
end
end.