Changing the System Cursor

I was thinking about implementing a “What’s This?” type help system on an Excel userform. The first task, it seems, is changing the cursor. In Changing the Cursor in VBA, I discussed the built-in way to modify the cursor. The options there are pretty limited and they particularly don’t include a question mark that I might like to use for this application.

AllAPI.net had an example from Jerry Grant that seemed to fill the bill. It uses several API’s of which I understand most. I modified the example a little to suit the situation. Here is the declaration section of a standard module:

Option Explicit
 
Public Declare Function CopyIcon Lib “user32” _
   (ByVal hIcon As Long) As Long
 
Public Declare Function LoadCursorFromFile Lib “user32” Alias “LoadCursorFromFileA” _
    (ByVal lpFileName As String) As Long
 
Public Declare Function SetCursor Lib “user32” _
    (ByVal hCursor As Long) As Long
 
Public Declare Function SetSystemCursor Lib “user32” _
    (ByVal hcur As Long, ByVal id As Long) As Long
 
Public Declare Function GetCursor Lib “user32” () As Long
 
Public Const lOCR_NORMAL As Long = 32512

And here is the code behind the userform that changes the cursor.

Private mbWhatActive As Boolean
Private mlCurrCursor As Long
Private mlDefCursor As Long

Private Sub cmdWhat_Click()

    If mbWhatActive Then
        ChangeCursor
        mbWhatActive = False
    Else
        ChangeCursor “C:Windowscursorshelp_r.cur”
        mbWhatActive = True
    End If
   
End Sub

Private Sub ChangeCursor(Optional sCursPath As String)
   
    Dim lCursor As Long
   
    If Len(sCursPath) = 0 Then
        lCursor = mlDefCursor
    Else
        mlCurrCursor = GetCursor()
        mlDefCursor = CopyIcon(mlCurrCursor)
        lCursor = LoadCursorFromFile(sCursPath)
    End If
   
    SetSystemCursor lCursor, lOCR_NORMAL
   
End Sub

I was messing around with cursors, and I think I like this one the best:

userform showing changed cursor

Posted in Uncategorized

7 thoughts on “Changing the System Cursor

  1. Hi Dick,

    No need to resort to the API for the arrow+question mark cursor.
    Try the following code in a userform with a button.

    Private Sub CommandButton1_Click()
    ‘ arrow + questionmark
    Me.MousePointer = fmMousePointerHelp
    End Sub
    Private Sub UserForm_Click()
    Me.MousePointer = fmMousePointerDefault
    End Sub

    Also this may help.
    http://www.andypope.info/vba/whatsthishelp.htm

  2. Dick,

    its very useful to change the m-icon. However when I close the UserForm when the hlp icon is active and restart restart the form the hlp icon won’t change back to default.
    The solution was a little script addition:

    Private Sub cmdWhat_Click()
    If mbWhatActive Then
    ChangeCursor “C:WINNTcursorsarrow_m.cur”
    mbWhatActive = False
    Else
    ChangeCursor “C:WINNTcursorshelp_r.cur”
    mbWhatActive = True
    End If

    End Sub

    Private Sub ChangeCursor(Optional sCursPath As String)

    Dim lCursor As Long

    If sCursPath “C:WINNTcursorshelp_r.cur” Then

    mlCurrCursor = GetCursor()
    mlDefCursor = CopyIcon(mlCurrCursor)
    lCursor = LoadCursorFromFile(sCursPath)

    Else
    mlCurrCursor = GetCursor()
    mlDefCursor = CopyIcon(mlCurrCursor)
    lCursor = LoadCursorFromFile(sCursPath)
    End If

    SetSystemCursor lCursor, lOCR_NORMAL

    End Sub

    Cheers

    Lars

  3. Lars: The problem with that is if the user has changed their default cursor, then you’d be changing it back to your default cursor. Once fully developed, the user wouldn’t be able to close the userform because all the close mechanism would have help associated with them. However, a call to ChangeCursor (with no arguments) from the QueryClose event does the trick too.

  4. Apologies if I am incorrect to post here.

    I am seeking to replace the ‘busy’ hourglass icon on the worksheet and thought by modifying the suggestions above it might do the trick. Not. In DeployCursor there are 2 options for testing. One, a msgbox, meant to represent some work. This shows the icon correctly until the msgbox is acknowledged and the cursor reverts. The other is real work but then the icon replace does NOT work. Clearly there is some other stuff going on here – but what?

    All code goes into a standard module:

    Option Explicit

    Public Declare Function CopyIcon Lib “user32” _
                                     (ByVal hIcon As Long) As Long

    Public Declare Function LoadCursorFromFile Lib “user32” Alias “LoadCursorFromFileA” _
                                               (ByVal lpFileName As String) As Long

    Public Declare Function SetCursor Lib “user32” _
                                      (ByVal hCursor As Long) As Long

    Public Declare Function SetSystemCursor Lib “user32” _
                                            (ByVal hcur As Long, ByVal id As Long) As Long

    Public Declare Function GetCursor Lib “user32” () As Long

    Public Const lOCR_NORMAL As Long = 32512

    Private mbWhatActive As Boolean
    Private mlCurrCursor As Long
    Private mlDefCursor As Long

    Dim sCursPath As String

    Private Sub ToggleCursor()

        If mbWhatActive Then
            ChangeCursor “C:Windowscursorsarrow_m.cur”
            mbWhatActive = False
        Else
            ChangeCursor Application.Path & “MSN.ico”
            mbWhatActive = True
        End If

    End Sub

    Private Sub ChangeCursor(Optional sCursPath As String)

        Dim lCursor As Long

        If sCursPath = Application.Path & “MSN.ico” Then

            mlCurrCursor = GetCursor()
            mlDefCursor = CopyIcon(mlCurrCursor)
            lCursor = LoadCursorFromFile(sCursPath)

        Else
            mlCurrCursor = GetCursor()
            mlDefCursor = CopyIcon(mlCurrCursor)
            lCursor = LoadCursorFromFile(sCursPath)
        End If

        SetSystemCursor lCursor, lOCR_NORMAL

    End Sub

    Sub DeployCursor()

        Dim x As Long, y As Long

        ToggleCursor

        MsgBox “”
       
        ”    For x = 1 To 1000
       ”        For y = 1 To 10000
       ”        Next y
       ”    Next x

        ToggleCursor

    End Sub

  5. Example for a Textbox in a Userform

    This example vill force the cursor to be a hand when you rihgtclick on the Textbox. The cursor vill not change even if any other code will run while rightclick witch normay would set the cursor to a houerglass.

    ****************************************

    Private Declare Function LoadCursorFromFile Lib “user32? Alias “LoadCursorFromFileA” (ByVal lpFileName As String) As Long
    Private Declare Function CopyIcon Lib “user32? (ByVal hIcon As Long) As Long
    Private Declare Function SetSystemCursor Lib “user32? (ByVal hcur As Long, ByVal id As Long) As Long
    Private Declare Function GetCursor Lib “user32? () As Long

    Private mbWhatActive As Boolean
    Private mlCurrCursor As Long
    Private mlDefCursor As Long
    Private Const lOCR_NORMAL As Long = 32512

    Private Sub TextBox1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 2 Then
    Custor_locked True
    ‘Any code
    End If
    End Sub

    Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If Button = 2 Then
    Custor_locked False
    End If
    End Sub

    Private Sub Custor_locked(Locked As Boolean)
    Dim lCursor As Long
    If Locked And mlDefCursor = 0 Then
    Application.Cursor = xlNorthwestArrow
    mlCurrCursor = GetCursor()
    mlDefCursor = CopyIcon(mlCurrCursor)
    lCursor = LoadCursorFromFile(“C:Windowscursorshns.cur”)
    SetSystemCursor lCursor, lOCR_NORMAL
    ElseIf Not Locked And Not mlDefCursor = 0 Then
    Application.Cursor = xlDefault
    lCursor = mlDefCursor
    mlDefCursor = 0
    SetSystemCursor lCursor, lOCR_NORMAL
    End If
    End Sub


Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published.