сряда, 3 януари 2018 г.

program Sprite

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.

Няма коментари:

Публикуване на коментар