Fishtank: Delphi Version


{*****************************************************************************
*                                                                            *
*  Fishtank.dpr                                                              *
*  FishtankU.pas                                                             *
*                                                                            *
*  This program shows how to perform simple animation using Fastgraph for    *
*  Windows. Several types of tropical fish swim back and forth against a     *
*  coral reef background. The background image and fish sprites are stored   *
*  in PCX files.                                                             *
*                                                                            *
*****************************************************************************}
unit FishtankU;
interface
uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, FGWin;
type
  TForm1 = class(TForm)
    procedure AppOnActivate(Sender: TObject);
    procedure AppIdle(Sender: TObject; var Done: Boolean);
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  end;
var
  Form1: TForm1;
implementation
{$J+}
{$R *.DFM}
var
  dc   : hDC;
  hPal : hPalette;
  hVB1, hVB2 : integer;
  cxClient, cyClient : integer;
  { fish bitmaps }
  Fish1 : array [0..1399] of byte;
  Fish2 : array [0..2051] of byte;
  Fish3 : array [0..1767] of byte;
  Fish4 : array [0..1679] of byte;
  Fish5 : array [0..1363] of byte;
  Fish6 : array [0..2447] of byte;
const
  { number of fish }
  NFISH = 11;
  { location of fish (x & y) }
  FishX : array [0..5] of integer = (0,   64,128,200,  0, 80);
  FishY : array [0..5] of integer = (199,199,199,199,150,150);
  { size of fish (width and height) }
  FishWidth  : array [0..5] of integer = ( 56, 54, 68, 56, 62, 68);
  FishHeight : array [0..5] of integer = ( 25, 38, 26, 30, 22, 36);
  { for convenience, an array of pointers to fish bitmaps }
  Fishes : array [0..5] of ^byte = (@Fish1,@Fish2,@Fish3,@Fish4,@Fish5,@Fish6);
{*****************************************************************************
*                                                                            *
*  Min                                                                       *
*                                                                            *
*  Determine the smaller of two integer values.                              *
*                                                                            *
*****************************************************************************}
function Min (Value1, Value2 : integer) : integer;
begin
  if (Value1 <= Value2) then
    Min := Value1
  else
    Min := Value2;
end;
{*****************************************************************************
*                                                                            *
*  Max                                                                       *
*                                                                            *
*  Determine the larger of two integer values.                               *
*                                                                            *
*****************************************************************************}
function Max (Value1, Value2 : integer) : integer;
begin
  if (Value1 >= Value2) then
    Max := Value1
  else
    Max := Value2;
end;
{*****************************************************************************
*                                                                            *
*  GetFish()                                                                 *
*                                                                            *
*  Fill the fish bitmap arrays.                                              *
*                                                                            *
*****************************************************************************}
procedure GetFish;
var
  FishNum : integer;
begin
  { get the fish bitmaps from a PCX file }
  fg_vbopen(hVB1);
  fg_vbcolors;
  fg_showpcx('FISH.PCX'+chr(0),FG_AT_XY or FG_KEEPCOLORS);
  for FishNum := 0 to 5 do
  begin
    fg_move(FishX[FishNum],FishY[FishNum]);
    fg_getimage(Fishes[FishNum]^,FishWidth[FishNum],FishHeight[FishNum]);
  end;
end;
{*****************************************************************************
*                                                                            *
*  PutFish()                                                                 *
*                                                                            *
*  Draw one of the six fish anywhere you want.                               *
*                                                                            *
*****************************************************************************}
procedure PutFish (FishNum, x, y, FishDir : integer);
begin
  { move to position where the fish will appear }
  fg_move(x,y);
  { draw a left- or right-facing fish, depending on FishDir }
  if (FishDir = 0) then
    fg_flpimage(Fishes[FishNum]^,FishWidth[FishNum],FishHeight[FishNum])
  else
    fg_clpimage(Fishes[FishNum]^,FishWidth[FishNum],FishHeight[FishNum]);
end;
{*****************************************************************************
*                                                                            *
*  GoFish()                                                                  *
*                                                                            *
*  Make the fish swim around. This procedure is called by the application's  *
*  OnIdle event handler.                                                     *
*                                                                            *
*****************************************************************************}
procedure GoFish;
type
  FishArray = array [0..NFISH-1] of integer;
const
{
*   There are 11 fish total, and 6 different kinds of fish. These
*   arrays keep track of what kind of fish each fish is, and how each
*   fish moves:
*
*   Fish[]   -- which fish bitmap applies to this fish?
*   xStart[] -- starting x coordinate
*   yStart[] -- starting y coordinate
*
*   xMin[]   -- how far left (off screen) the fish can go
*   xMax[]   -- how far right (off screen) the fish can go
*   xInc[]   -- how fast the fish goes left and right
*   Dir[]    -- starting direction for each fish
*
*   yMin[]   -- how far up this fish can go
*   yMax[]   -- how far down this fish can go
*   yInc[]   -- how fast the fish moves up or down
*   yTurn[]  -- how long fish can go in the vertical direction
*               before stopping or turning around
*   yCount[] -- counter to compare to yTurn
}
  Fish   : FishArray =
                (   1,   1,   2,   3,   3,   0,   0,   5,   4,   2,   3);
  xStart : FishArray =
                (-100,-150,-450,-140,-200, 520, 620,-800, 800, 800,-300);
  yStart : FishArray =
                (  40,  60, 150,  80,  70, 190, 180, 100,  30, 130,  92);
  xMin   : FishArray =
                (-300,-300,-800,-200,-200,-200,-300,-900,-900,-900,-400);
  xMax   : FishArray =
                ( 600, 600,1100,1000,1000, 750, 800,1200,1400,1200, 900);
  xInc   : FishArray =
                (   2,   2,   8,   5,   5,  -3,  -3,   7,  -8,  -9,   6);
  Dir    : FishArray =
                (   0,   0,   0,   0,   0,   1,   1,   0,   1,   1,   0);
  yMin   : FishArray =
                (  40,  60, 120,  70,  60, 160, 160,  80,  30, 110,  72);
  yMax   : FishArray =
                (  80, 100, 170, 110, 100, 199, 199, 120,  70, 150, 122);
  yTurn  : FishArray =
                (  50,  30,  10,  30,  20,  10,  10,  10,  30,   20, 10);
  yCount : FishArray =
                (   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0);
  yInc   : FishArray =
                (   0,   0,   0,   0,   0,   0,   0,   0,   0,   0,   0);
var
  i : integer;
begin
  { copy the background to the workspace }
  fg_copypage(hVB2,hVB1);
  { put all the fish in their new positions }
  for i := 0 to NFISH-1 do
  begin
    inc(yCount[i]);
    if (yCount[i] > yTurn[i]) then
    begin
       yCount[i] := 0;
       yInc[i] := random(3) - 1;
    end;
    inc(yStart[i],yInc[i]);
    yStart[i] := Min(yMax[i],Max(yStart[i],yMin[i]));
    if (xStart[i] >= -72) and (xStart[i] < 320) then
      PutFish(Fish[i],xStart[i],yStart[i],Dir[i]);
    inc(xStart[i],xInc[i]);
    if (xStart[i] <= xMin[i]) or (xStart[i] >= xMax[i]) then
    begin
      xInc[i] := -xInc[i];
      Dir[i] := 1 - Dir[i];
    end;
  end;
  { scale the workspace image to fill the client area }
  fg_vbscale(0,319,0,199,0,cxClient-1,0,cyClient-1);
end;
{****************************************************************************}
procedure TForm1.AppOnActivate(Sender: TObject);
begin
  fg_realize(hPal);
  Invalidate;
end;
procedure TForm1.AppIdle(Sender: Tobject; var Done: Boolean);
begin
  GoFish;
  Done := False;
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
  fg_realize(hPal);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  { use the default logical palette }
  dc := GetDC(Form1.Handle);
  fg_setdc(dc);
  hPal := fg_defpal;
  fg_realize(hPal);
  { create two 320x200 virtual buffers }
  fg_vbinit;
  hVB1 := fg_vballoc(320,200);
  hVB2 := fg_vballoc(320,200);
  { display the coral background in virtual buffer #2 (which  }
  { will always contain a clean copy of the background image) }
  fg_vbopen(hVB2);
  fg_vbcolors;
  fg_showpcx('CORAL.PCX'+chr(0),FG_AT_XY or FG_IGNOREPALETTE or FG_KEEPCOLORS);
  { get the fish bitmaps }
  GetFish;
  Application.OnActivate := AppOnActivate;
  Application.OnIdle := AppIdle;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
  fg_vbscale(0,fg_getmaxx,0,fg_getmaxy,0,cxClient-1,0,cyClient-1);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
  cxClient := ClientWidth;
  cyClient := ClientHeight;
  Invalidate;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
  fg_vbclose;
  fg_vbfree(hVB1);
  fg_vbfree(hVB2);
  fg_vbfin;
  DeleteObject(hPal);
  ReleaseDC(Form1.Handle,dc);
end;
end.

<< Prev

Next >>

Contents
Fastgraph Home Page

 

copyright 2001 Ted Gruber Software, Inc.