Scroller: Visual Basic Version

Visual Basic programs can also use the animation-based message loop. Unlike other languages, we must set up a loop at the end of the form's load handler that executes until we exit the program:

Visible = True
AppIsRunning = True
While AppIsRunning
   DoEvents
   Call Scroll
Wend

Before the loop begins, we make the form visible and we set the global Boolean variable AppIsRunning to True. The message loop first processes any pending Windows events with the DoEvents statement, then it calls our Scroll() function to perform one iteration of the scroll. This process continues until we set AppIsRunning to False in the OnDestroy handler, and our program then exits gracefully.

'*****************************************************************************
'                                                                            *
'  Scroller.frm                                                              *
'                                                                            *
'  This program demonstrates circular scrolling within a virtual buffer.     *
'                                                                            *
'  Because fg_scroll() requires a "hidden" virtual buffer to save and then   *
'  restore portions of the area being scrolled, we create a second virtual   *
'  buffer for this purpose.                                                  *
'                                                                            *
'*****************************************************************************
Const vbWidth = 320
Const vbHeight = 200
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)
   hPal = fg_defpal()
   Call fg_realize(hPal)
   Call fg_vbinit
   hVB1 = fg_vballoc(vbWidth, vbHeight)
   hVB2 = fg_vballoc(vbWidth, vbHeight)
   Call fg_vbopen(hVB2)
   Call fg_vbcolors
   Call fg_vbopen(hVB1)
   Call fg_vbcolors
   Call fg_sethpage(hVB2)
   Call fg_setcolor(19)
   Call fg_fillpage
   Call fg_setcolor(25)
   Call fg_rect(132, 188, 50, 150)
   Call fg_setcolor(20)
   Call fg_move(160, 67)
   Call fg_draw(175, 107)
   Call fg_draw(140, 82)
   Call fg_draw(180, 82)
   Call fg_draw(145, 107)
   Call fg_draw(160, 67)
   Call fg_paint(160, 77)
   Call fg_paint(150, 87)
   Call fg_paint(160, 87)
   Call fg_paint(170, 87)
   Call fg_paint(155, 97)
   Call fg_paint(165, 97)
   Visible = True
   AppIsRunning = True
   While AppIsRunning
      DoEvents
      Call Scroll
   Wend
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)
   AppIsRunning = False
   Call fg_vbclose
   Call fg_vbfree(hVB1)
   Call fg_vbfree(hVB2)
   Call fg_vbfin
End Sub
'*****************************************************************************
'                                                                            *
' Scroll()                                                                   *
'                                                                            *
' The Scroll() subroutine moves the scrolling region up four pixels in a     *
' circular manner. It is called from the message loop in Form_Load when no   *
' messages are waiting.                                                      *
'                                                                            *
'*****************************************************************************
Private Sub Scroll()
   Call fg_scroll(136, 184, 50, 150, -4, 0)
   Call fg_vbscale(0, vbWidth - 1, 0, vbHeight - 1, 0, cxClient - 1, 0, cyClient - 1)
End Sub