Source code for Issue Number 74

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Just create a new Class Module and then paste this source code into it. You should name the class cMouseCursor.

'----------------------------------------------------------------------
'
'   Module Name:    cMouseCursor
'   Written By:     C&D Programming Corp.
'   Create Date:    1/99
'   Copyright:      Copyright 1999 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit

Private mlOldCursor As Long
Private mbStartTask As Boolean

'
'   Here are the available mouse cursor values
'   as of VB 5.
'
'Constant           Value   Description
'vbDefault          0       Default
'vbArrow            1       Arrow
'vbCrosshair        2       Cross
'vbIbeam            3       I beam
'vbIconPointer      4       Icon
'vbSizePointer      5       Size
'vbSizeNESW         6       Size NE, SW
'vbSizeNS           7       Size N, S
'vbSizeNWSE         8       Size NW, SE
'vbSizeWE           9       Size W, E
'vbUpArrow          10      Up arrow
'vbHourglass        11      Hourglass
'vbNoDrop           12      No drop
'vbArrowHourglass   13      Arrow and hourglass; (available only in 32-bit Visual Basic 5.0)
'vbArrowQuestion    14      Arrow and question mark; (available only in 32-bit Visual Basic 5.0)
'vbSizeAll          15      Size all; (available only in 32-bit Visual Basic 5.0)
'vbCustom           99      Custom icon specified by the MouseIcon property

'
'   MousePointerConstants is a public Enum located in the VBRUN library
'
Public Sub StartTask(Optional MouseCursor As MousePointerConstants = vbHourglass)
    ' save old cursor and set new one.
    mlOldCursor = Screen.MousePointer
    Screen.MousePointer = MouseCursor
    mbStartTask = True
End Sub

Public Sub StopTask()
    Screen.MousePointer = mlOldCursor
    mbStartTask = False
End Sub

Private Sub Class_Initialize()
    mbStartTask = False
End Sub

Private Sub Class_Terminate()
    ' in case we forgot to return the mouse cursor back to original this will
    ' do it.
    If mbStartTask Then
        StopTask
    End If
End Sub