Better screen cursor management in VB

One of the more subtle aspects of traditional VB application development is controlling the screen cursor when you’re performing some lengthy operation which might involve multiple functions or subroutines. The polite thing to do is obviously set the screen cursor to an hourglass just before you commence a processing task which is likely to take more than second or so. The polite thing is to also switch it back to an arrow, once you’re finished.

While this is obvious to most of us, it’s not that easy to implement if your functions or subroutines can have multiple entry points as in this example:

Public Sub A(ByVal Max As Long)
   Screen.MousePointer = vbHourglass
   B Max
   C Max
   Screen.MousePointer = vbArrow
End Sub

Public Sub B(ByVal Max As Long)
   Screen.MousePointer = vbHourglass
   D Max
   Screen.MousePointer = vbArrow
End Sub

Private Sub C(ByVal Max As Long)
   Dim I As Long
   For I = 0 To Max - 1
      DoEvents
   Next I
End Sub

Private Sub D(ByVal Max As Long)
   Dim I As Long
   For I = 0 To Max - 1
      DoEvents
   Next I
End Sub

A() calls B() and C(), in that order. Because both A() and B() are public routines, which have been designed to be invoked from anywhere in the application, they both set the cursor to an hourglass, in expectation of some processing delay. The trouble is that when B() is finished, it sets the cursor to an arrow and then returns to A(), which then proceeds to call C(), except that the cursor is no longer an hourglass.

One solution is to implement a screen cursor “stack”, which ensures that the cursor is never changed prematurely. This can be done via a “static” variable whose value is preserved between calls to a procedure. Put this code into one of your global modules:

Public Enum CursorTypes
    ARROW = 0
    HOURGLASS = 1
End Enum

Public Sub SetCursor(ByVal CursorType As CursorTypes)
   Static Stack As Long
   Select Case CursorType
      Case HOURGLASS
         Stack = Stack + 1
      Case ARROW
         Stack = Stack - 1
      Case Else
         Stack = Stack - 1
   End Select
   Screen.MousePointer = IIf(Stack > 0, vbHourglass, vbArrow)
End Sub

The sample code in our examples above now looks like this:

Public Sub A(ByVal Max As Long)
   SetCursor HOURGLASS
   B Max
   C Max
   SetCursor ARROW
End Sub

Public Sub B(ByVal Max As Long)
   SetCursor HOURGLASS
   D Max
   SetCursor ARROW
End Sub

Private Sub C(ByVal Max As Long)
   Dim I As Long
   For I = 0 To Max - 1
      DoEvents
   Next I
End Sub

Private Sub D(ByVal Max As Long)
   Dim I As Long
   For I = 0 To Max - 1
      DoEvents
   Next I
End Sub

The difference now is that even though B() attempts to reset the cursor to an arrow, it will remain an hourglass because SetCursor() will only change it to an arrow when the “stack” is empty.

Posted in Development, Tips, Visual Basic by Ivan