Fade: Visual Basic Version

'*****************************************************************************
'                                                                            *
'  Fade.frm                                                                  *
'                                                                            *
'  This program shows how perform a palette fade.                            *
'                                                                            *
'*****************************************************************************
Const vbWidth = 320
Const vbHeight = 200
Dim Original(236 * 3) As Byte
Dim Current(236 * 3) As Byte
Dim hPal As Long
Dim hVB As Long
Dim cxClient As Long, cyClient As Long
Private Sub Form_Activate()
   Call fg_realize(hPal)
   Refresh
End Sub
Private Sub Form_Load()
   ScaleMode = 3
   Call fg_setdc(hDC)
   hPal = fg_defpal()
   Call fg_realize(hPal)
   Call fg_vbinit
   hVB = fg_vballoc(vbWidth, vbHeight)
   Call fg_vbopen(hVB)
   Call fg_vbcolors
   Call fg_showpcx(App.Path & "\MOUSE.PCX", FG_AT_XY)
   Call fg_getdacs(10, 236, Original(0))
End Sub
Private Sub Form_Paint()
   Call fg_vbscale(0, vbWidth - 1, 0, vbHeight - 1, 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)
   Call fg_vbclose
   Call fg_vbfree(hVB)
   Call fg_vbfin
End Sub
'*****************************************************************************
'                                                                            *
'  FadeIn_Click()                                                            *
'                                                                            *
'  Fade an image back to its original colors.                                *
'                                                                            *
'*****************************************************************************
Private Sub mnuFadeIn_Click()
   Dim I As Long
   Dim Fading As Boolean
   Screen.MousePointer = 11
   Erase Current
   Do
      Fading = False
      For I = 0 To 236 * 3 - 1
         If Current(I) <> Original(I) Then
            Current(I) = Current(I) + 1
            Fading = True
         End If
      Next I
      Call fg_setdacs(10, 236, Current(0))
      If fg_colors > 8 Then
         Call fg_vbscale(0, vbWidth - 1, 0, vbHeight - 1, 0, cxClient - 1, 0, cyClient - 1)
      End If
   Loop While Fading
   mnuFadeIn.Enabled = False
   mnuFadeOut.Enabled = True
   Screen.MousePointer = 0
End Sub
'*****************************************************************************
'                                                                            *
'  FadeOut_Click()                                                           *
'                                                                            *
'  Fade an image to black.                                                   *
'                                                                            *
'*****************************************************************************
Private Sub mnuFadeOut_Click()
   Dim I As Long
   Dim Fading As Boolean
   Screen.MousePointer = 11
   For I = 0 To 236 * 3 - 1
      Current(I) = Original(I)
   Next I
   Do
      Fading = False
      For I = 0 To 236 * 3 - 1
         If Current(I) <> 0 Then
            Current(I) = Current(I) - 1
            Fading = True
         End If
      Next I
      Call fg_setdacs(10, 236, Current(0))
      If fg_colors > 8 Then
         Call fg_vbscale(0, vbWidth - 1, 0, vbHeight - 1, 0, cxClient - 1, 0, cyClient - 1)
      End If
   Loop While Fading
   mnuFadeOut.Enabled = False
   mnuFadeIn.Enabled = True
   Screen.MousePointer = 0
End Sub
Private Sub mnuExit_Click()
   Unload Me
End Sub