program Sprite;
uses
Crt, Graph;
var
GraphDriver : integer; { The Graphics device driver }
GraphMode : integer; { The Graphics mode value }
MaxX, MaxY : word; { The maximum resolution of the screen }
ErrorCode : integer; { Reports any graphics errors }
MaxColor : word; { The maximum color value available }
procedure Initialize;
{ Initialize graphics and report any errors that may occur }
var
PathToDriver : string; { Stores the DOS path to *.BGI & *.CHR }
begin
GraphDriver := VGA;
GraphMode := VGAHi;
PathToDriver := '';
InitGraph(GraphDriver, GraphMode, PathToDriver);
ErrorCode := GraphResult; { preserve error return }
if ErrorCode <> grOK then { error? }
begin
Writeln('Graphics error: ', GraphErrorMsg(ErrorCode));
Halt(1); { Some other error:
terminate }
end;
Randomize; { init random number generator }
MaxColor := GetMaxColor; { Get the maximum allowable drawing color
}
MaxX := GetMaxX; { Get screen resolution values }
MaxY := GetMaxY;
end; { Initialize }
procedure PutImagePlay;
{ Demonstrate the GetImage and PutImage commands }
const
r = 20;
StartX = 100;
StartY = 50;
var
CurPort : ViewPortType;
procedure MoveSaucer(var X, Y : integer; Width, Height : integer);
var
Step : integer;
begin
Step := Random(2*r);
if Odd(Step) then
Step := -Step;
X := X + Step;
Step := Random(r);
if Odd(Step) then
Step := -Step;
Y := Y + Step;
{ Make saucer bounce off viewport walls }
with CurPort do
begin
if (x1 + X + Width - 1 > x2) then
X := x2-x1 - Width + 1
else
if (X < 0) then
X := 0;
if (y1 + Y + Height - 1 > y2) then
Y := y2-y1 - Height + 1
else
if (Y < 0) then
Y := 0;
end;
end; { MoveSaucer }
var
Pausetime : word;
Saucer : pointer;
Pos : array[1..2] of record
X, Y : integer;
XOld, YOld : integer;
end;
ulx, uly : word;
lrx, lry : word;
Size : word;
I : word;
begin
{ PaintScreen }
SetViewPort(0, 0, MaxX, MaxY, ClipOn);
ClearViewPort;
GetViewSettings(CurPort);
{ DrawSaucer }
Ellipse(StartX, StartY, 0, 360, r, (r div 3)+2);
Ellipse(StartX, StartY-4, 190, 357, r, r div 3);
Line(StartX+7, StartY-6, StartX+10, StartY-12);
Circle(StartX+10, StartY-12, 2);
Line(StartX-7, StartY-6, StartX-10, StartY-12);
Circle(StartX-10, StartY-12, 2);
SetFillStyle(SolidFill, MaxColor);
FloodFill(StartX+1, StartY+4, GetColor);
{ ReadSaucerImage }
ulx := StartX-(r+1);
uly := StartY-14;
lrx := StartX+(r+1);
lry := StartY+(r div 3)+3;
Size := ImageSize(ulx, uly, lrx, lry);
GetMem(Saucer, Size);
GetImage(ulx, uly, lrx, lry, Saucer^);
PutImage(ulx, uly, Saucer^, XORput); { erase image }
{ Plot some "stars" }
for I := 1 to 1000 do
PutPixel(Random(MaxX), Random(MaxY), Random(MaxColor));
Pos[1].X := MaxX div 3;
Pos[1].Y := MaxY div 2;
Pos[2].X := MaxX div 3*2;
Pos[2].Y := MaxY div 2;
PauseTime := 70;
{ Move the saucer around }
repeat
SetVisualPage(0);
SetActivePage(1); { double buffer }
for I := 1 to 2 do { draw image }
PutImage(Pos[I].X, Pos[I].Y, Saucer^, XORput);
SetVisualPage(1);
for I := 1 to 2 do begin
Pos[I].XOld := Pos[I].X;
Pos[I].YOld := Pos[I].Y;
end;
for I := 1 to 2 do { width/height }
MoveSaucer(Pos[I].X, Pos[I].Y, lrx - ulx + 1, lry - uly + 1);
Delay(PauseTime);
for I := 1 to 2 do { erase image }
PutImage(Pos[I].XOld, Pos[I].YOld, Saucer^, XORput);
until KeyPressed;
FreeMem(Saucer, size);
end; { PutImagePlay }
begin { program body }
Initialize;
PutImagePlay;
CloseGraph;
end.
Няма коментари:
Публикуване на коментар