Visual Basic Programming Code Examples

Visual Basic > Windows and Controls Code Examples

Permanently alter a system cursor



Permanently alter a system cursor

The following function permanently alters the specified system cursor:

Private Declare Function SetSystemCursor Lib "user32.dll" (ByVal hcur As Long, ByVal id As Long) As Long
Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long

Public Enum eCursorType
    ecAppStarting = 32650           'The application starting (arrow and hourglass) cursor.
    ecCross = 32515                 'The cross-shaped cursor.
    ecIBeam = 32513                 'The text selection (I-beam) cursor.
    ecIcon = 32641                  'The empty icon cursor (Win NT only).
    ecNo = 32648                    'The circle with slash through it cursor.
    ecNormal = 32512                'The normal arrow cursor.
    ecSize = 32640                  'The four-arrow resize/move cursor (Win NT only).
    ecSizeAll = 32646               'The four-arrow resize/move cursor.
    ecSizeNESW = 32643              'The double-arrow resize/move cursor pointing to the upper-right and lower-left.
    ecSizeNS = 32645                'The double-arrow resize/move cursor pointing up and down.
    ecSizeNWSE = 32642              'The double-arrow resize/move cursor pointing to the upper-left and lower-right.
    ecSizeWE = 32644                'The double-arrow resize/move cursor pointing left and right.
    ecUp = 32516                    'The up arrow cursor.
    ecWait = 32514                  'The waiting (hourglass) cursor.
End Enum


'Purpose     :  Permanently changes the specified system cursor
'Inputs      :  eSysCursorType                  The system cursor to alter.
'               sCursorPath                     The path of the new cursor to use.
'Outputs     :  Returns True on success


Function SystemCursor(sCursorPath As String, eSysCursorType As eCursorType) As Boolean
    Dim lhwndNewCursor As Long
    
    If Len(Dir$(sCursorPath)) > 0 And Len(sCursorPath) > 0 Then
        'Load the cursor from file
        lhwndNewCursor = LoadCursorFromFile(sCursorPath)
        'Set the new system cursor
        SystemCursor = CBool(SetSystemCursor(lhwndNewCursor, eSysCursorType))  'Returns 1 if successful, or 0 if an error occured
    End If
End Function