Fishtank: Visual Basic Version
'*****************************************************************************
' *
' Fishtank.frm *
' *
' 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. *
' *
'*****************************************************************************
Const nFish = 11 ' total number of fish sprites
Dim FishX(6) As Long ' location of fish (x)
Dim FishY(6) As Long ' location of fish (y)
Dim FishWidth(6) As Long ' size of fish: width
Dim FishHeight(6) As Long ' size of fish: height
Dim FishOffset(6) As Long ' bitmap offsets into Fishes() array
' The Fishes array holds the bitmaps for all 6 kinds of fish
Dim Fishes(56 * 25 + 54 * 38 + 68 * 26 + 56 * 30 + 62 * 22 + 68 * 36) As Byte
' 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:
Dim Fish(nFish) As Long ' which fish bitmap applies to this fish?
Dim X(nFish) As Long ' starting x coordinate
Dim Y(nFish) As Long ' starting y coordinate
Dim xMin(nFish) As Long ' how far left (off screen) the fish can go
Dim xMax(nFish) As Long ' how far right (off screen) the fish can go
Dim xInc(nFish) As Long ' how fast the fish goes left and right
Dim Dir(nFish) As Long ' starting direction for each fish
Dim yMin(nFish) As Long ' how far up this fish can go
Dim yMax(nFish) As Long ' how far down this fish can go
Dim yInc(nFish) As Long ' how fast the fish moves up or down
Dim yCount(nFish) As Long ' counter to compare to yturn
Dim yTurn(nFish) As Long ' how long fish can go in the vertical direction
' before stopping or turning around
Dim hPal As Long
Dim hVB1 As Long, hVB2 As Long
Dim cxClient As Long, cyClient As Long
Dim AppIsRunning As Boolean
Private Sub Form_Activate()
Call fg_realize(hPal)
Refresh
End Sub
Private Sub Form_Load()
ScaleMode = 3
Call fg_setdc(hDC)
' use the default logical palette
hPal = fg_defpal()
Call fg_realize(hPal)
' create two 320x200 virtual buffers
Call 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)
Call fg_vbopen(hVB2)
Call fg_vbcolors
Call fg_showpcx(App.Path & "\CORAL.PCX", FG_AT_XY + FG_KEEPCOLORS)
' get the fish bitmaps
Call GetFish
' make the fish swim around
Visible = True
AppIsRunning = True
While AppIsRunning
DoEvents
Call GoFish
Wend
End Sub
Private Sub Form_Paint()
Call fg_vbscale(0, fg_getmaxx(), 0, fg_getmaxy(), 0, cxClient - 1, 0, cyClient - 1)
End Sub
Private Sub Form_Resize()
cxClient = ScaleWidth
cyClient = ScaleHeight
Refresh
End Sub
Private Sub Form_Unload(Cancel As Integer)
AppIsRunning = False
Call fg_vbclose
Call fg_vbfree(hVB1)
Call fg_vbfree(hVB2)
Call fg_vbfin
End Sub
Private Function Max(A As Long, B As Long)
If A > B Then
Max = A
Else
Max = B
End If
End Function
Private Function Min(A As Long, B As Long)
If A < B Then
Min = A
Else
Min = B
End If
End Function
'*****************************************************************************
' *
' GetFish() *
' *
' Fill the fish bitmap arrays. *
' *
'*****************************************************************************
Private Sub GetFish()
Dim I As Long, J As Long
FishX(0) = 0: FishX(1) = 64: FishX(2) = 128
FishX(3) = 200: FishX(4) = 0: FishX(5) = 80
FishY(0) = 199: FishY(1) = 199: FishY(2) = 199
FishY(3) = 199: FishY(4) = 150: FishY(5) = 150
FishWidth(0) = 56: FishWidth(1) = 54: FishWidth(2) = 68
FishWidth(3) = 56: FishWidth(4) = 62: FishWidth(5) = 68
FishHeight(0) = 25: FishHeight(1) = 38: FishHeight(2) = 26
FishHeight(3) = 30: FishHeight(4) = 22: FishHeight(5) = 36
Fish(0) = 2: Fish(1) = 2: Fish(2) = 3: Fish(3) = 4
Fish(4) = 4: Fish(5) = 1: Fish(6) = 1: Fish(7) = 6
Fish(8) = 5: Fish(9) = 3: Fish(10) = 4
X(0) = -100: X(1) = -150: X(2) = -450: X(3) = -140
X(4) = -200: X(5) = 520: X(6) = 620: X(7) = -800
X(8) = 800: X(9) = 800: X(10) = -300
Y(0) = 40: Y(1) = 60: Y(2) = 150: Y(3) = 80
Y(4) = 70: Y(5) = 190: Y(6) = 180: Y(7) = 100
Y(8) = 30: Y(9) = 130: Y(10) = 92
xMin(0) = -300: xMin(1) = -300: xMin(2) = -800: xMin(3) = -200
xMin(4) = -200: xMin(5) = -200: xMin(6) = -300: xMin(7) = -900
xMin(8) = -900: xMin(9) = -900: xMin(10) = -400
xMax(0) = 600: xMax(1) = 600: xMax(2) = 1100: xMax(3) = 1000
xMax(4) = 1000: xMax(5) = 750: xMax(6) = 800: xMax(7) = 1200
xMax(8) = 1400: xMax(9) = 1200: xMax(10) = 900
xInc(0) = 2: xInc(1) = 2: xInc(2) = 8: xInc(3) = 5
xInc(4) = 5: xInc(5) = -3: xInc(6) = -3: xInc(7) = 7
xInc(8) = -8: xInc(9) = -9: xInc(10) = 6
Dir(0) = 0: Dir(1) = 0: Dir(2) = 0: Dir(3) = 0
Dir(4) = 0: Dir(5) = 1: Dir(6) = 1: Dir(7) = 0
Dir(8) = 1: Dir(9) = 1: Dir(10) = 0
yMin(0) = 40: yMin(1) = 60: yMin(2) = 120: yMin(3) = 70
yMin(4) = 60: yMin(5) = 160: yMin(6) = 160: yMin(7) = 80
yMin(8) = 30: yMin(9) = 110: yMin(10) = 72
yMax(0) = 80: yMax(1) = 100: yMax(2) = 170: yMax(3) = 110
yMax(4) = 100: yMax(5) = 199: yMax(6) = 199: yMax(7) = 120
yMax(8) = 70: yMax(9) = 150: yMax(10) = 122
yTurn(0) = 50: yTurn(1) = 30: yTurn(2) = 10: yTurn(3) = 30
yTurn(4) = 20: yTurn(5) = 10: yTurn(6) = 10: yTurn(7) = 10
yTurn(8) = 30: yTurn(9) = 20: yTurn(10) = 10
For I = 0 To nFish - 1
yCount(I) = 0
yInc(I) = 0
Next I
' get the fish bitmaps from a PCX file
Call fg_vbopen(hVB1)
Call fg_vbcolors
Call fg_showpcx(App.Path & "\FISH.PCX", FG_AT_XY + FG_IGNOREPALETTE + FG_KEEPCOLORS)
J = 0
For I = 0 To 5
Call fg_move(FishX(I), FishY(I))
Call fg_getimage(Fishes(J), FishWidth(I), FishHeight(I))
FishOffset(I) = J
J = J + FishWidth(I) * FishHeight(I)
Next I
Call fg_erase
End Sub
'*****************************************************************************
' *
' GoFish() *
' *
' Make the fish swim around. *
' *
'*****************************************************************************
Private Sub GoFish()
Dim I As Long
' copy the background to the workspace
Call fg_copypage(hVB2, hVB1)
' put all the fish in their new positions
For I = 0 To nFish - 1
yCount(I) = yCount(I) + 1
If yCount(I) > yTurn(I) Then
yCount(I) = 0
yInc(I) = Int(Rnd() * 3 - 1)
End If
Y(I) = Y(I) + yInc(I)
Y(I) = Min(yMax(I), Max(Y(I), yMin(I)))
If X(I) >= -72 And X(I) < 320 Then
Call PutFish(Fish(I), X(I), Y(I), Dir(I))
End If
X(I) = X(I) + xInc(I)
If X(I) <= xMin(I) Or X(I) >= xMax(I) Then
xInc(I) = -xInc(I)
Dir(I) = 1 - Dir(I)
End If
Next I
' scale the workspace image to fill the client area
Call fg_vbscale(0, 319, 0, 199, 0, cxClient - 1, 0, cyClient - 1)
End Sub
'*****************************************************************************
' *
' PutFish() *
' *
' Draw one of the six fish anywhere you want. *
' *
'*****************************************************************************
Private Sub PutFish(FishNum As Long, X As Long, Y As Long, FishDir As Long)
Dim I As Long
' move to position where the fish will appear
Call fg_move(X, Y)
' draw a left- or right-facing fish, depending on FishDir
I = FishOffset(FishNum)
If FishDir = 0 Then
Call fg_flpimage(Fishes(I), FishWidth(FishNum), FishHeight(FishNum))
Else
Call fg_clpimage(Fishes(I), FishWidth(FishNum), FishHeight(FishNum))
End If
End Sub
|