Panner: Visual Basic Version

'*****************************************************************************
'                                                                            *
'  Panner.frm                                                                *
'                                                                            *
'  This program shows how to pan the contents of a virtual buffer through    *
'  a smaller window.                                                         *
'                                                                            *
'*****************************************************************************
Const vbWidth = 640
Const vbHeight = 480
Dim hPal As Long
Dim hVB As Long
Dim cxClient As Long, cyClient As Long
Dim X As Long, Y As Long
Dim xLimit As Long, yLimit 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_showbmp(App.Path & "\PORCH.BMP", 0)
   X = 0
   Y = 0
End Sub
Private Sub Form_Paint()
   Call fg_vbpaste(X, X + (vbWidth - 1), Y, Y + (vbHeight - 1), 0, vbHeight - 1)
End Sub
Private Sub Form_Resize()
   cxClient = ScaleWidth
   cyClient = ScaleHeight
   If cxClient < vbWidth Then
      xLimit = vbWidth - cxClient
      If X > 0 Then mnuLeft.Enabled = True
      If X < xLimit Then mnuRight.Enabled = True
   Else
      xLimit = 0
      mnuLeft.Enabled = False
      mnuRight.Enabled = False
   End If
   If cyClient < vbHeight Then
      yLimit = vbHeight - cyClient
      If Y > 0 Then mnuUp.Enabled = True
      If Y < yLimit Then mnuDown.Enabled = True
   Else
      yLimit = 0
      mnuUp.Enabled = False
      mnuDown.Enabled = False
   End If
   Refresh
End Sub
Private Sub Form_Unload(Cancel As Integer)
   Call fg_vbclose
   Call fg_vbfree(hVB)
   Call fg_vbfin
End Sub
Private Sub mnuLeft_Click()
   If X = xLimit Then mnuRight.Enabled = True
   X = X - 1
   Call fg_vbpaste(X, X + (vbWidth - 1), Y, Y + (vbHeight - 1), 0, vbHeight - 1)
   If X = 0 Then mnuLeft.Enabled = False
End Sub
Private Sub mnuRight_Click()
   If X = 0 Then mnuLeft.Enabled = True
   X = X + 1
   Call fg_vbpaste(X, X + (vbWidth - 1), Y, Y + (vbHeight - 1), 0, vbHeight - 1)
   If X = xLimit Then mnuRight.Enabled = False
End Sub
Private Sub mnuUp_Click()
   If Y = yLimit Then mnuDown.Enabled = True
   Y = Y - 1
   Call fg_vbpaste(X, X + (vbWidth - 1), Y, Y + (vbHeight - 1), 0, vbHeight - 1)
   If Y = 0 Then mnuUp.Enabled = False
End Sub
Private Sub mnuDown_Click()
   If Y = 0 Then mnuUp.Enabled = True
   Y = Y + 1
   Call fg_vbpaste(X, X + (vbWidth - 1), Y, Y + (vbHeight - 1), 0, vbHeight - 1)
   If Y = yLimit Then mnuDown.Enabled = False
End Sub
Private Sub mnuReset_Click()
   X = 0
   Y = 0
   Call fg_vbpaste(0, vbWidth - 1, 0, vbHeight - 1, 0, vbHeight - 1)
   If xLimit > 0 Then mnuRight.Enabled = True
   If yLimit > 0 Then mnuDown.Enabled = True
   mnuLeft.Enabled = False
   mnuUp.Enabled = False
End Sub
Private Sub mnuExit_Click()
   Unload Me
End Sub