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

<< Prev

Next >>

Contents
Fastgraph Home Page

 

copyright 2001 Ted Gruber Software, Inc.