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.
|