How to programmatically change cursor in Visio?

Hi is there any way I can change the 开发者_开发知识库mouse cursor in Visio programmatically? I went through all the Automation classes in Visio SDK and could not find any related property, method, event....

-- Edit: Even while you can programmatically change the cursor, it seems that Visio (2003 in my computer) continuously restores the original cursor. I've tried it and, if I don't move the mouse, I can get a different cursor (like the hand) until I move the mouse, then it goes back to the arrow.

So, for now, my answer is: you can't change the cursor.

Maybe it is possible for other Visio versions.

You can use Windows API calls from your VBA code to change the cursor.

There is an example here: http://www.vbaexpress.com/kb/getarticle.php?kb_id=929

A better example, which I have got to work in Visio: http://www.tek-tips.com/viewthread.cfm?qid=1700789

And below, the code I have used for the testing environment:

First, create a "modCursor" module:

Option Explicit

'Declare Windows API Constants for Windows System cursors.
Public Const IDC_APPSTARTING = 32650&    'Standard arrow and small hourglass.
Public Const IDC_ARROW = 32512&          'Standard arrow.
Public Const IDC_CROSS = 32515           'Crosshair.
Public Const IDC_HAND = 32649            'Hand.
Public Const IDC_HELP = 32651            'Arrow and question mark.
Public Const IDC_IBEAM = 32513&          'Text I-beam.
Public Const IDC_ICON = 32641&           'Windows NT only: Empty icon.
Public Const IDC_NO = 32648&             'Slashed circle.
Public Const IDC_SIZE = 32640&           'Windows NT only: Four-pointed arrow.
Public Const IDC_SIZEALL = 32646&        'Four-pointed arrow pointing north, south, east, and west.
Public Const IDC_SIZENESW = 32643&       'Double-pointed arrow pointing northeast and southwest.
Public Const IDC_SIZENS = 32645&         'Double-pointed arrow pointing north and south.
Public Const IDC_SIZENWSE = 32642&       'Double-pointed arrow pointing northwest and southeast.
Public Const IDC_SIZEWE = 32644&         'Double-pointed arrow pointing west and east.
Public Const IDC_UPARROW = 32516&        'Vertical arrow.
Public Const IDC_WAIT = 32514&           'Hourglass.

'Declarations for API Functions.
Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Long

'Declare handles for cursor.
Private hOldCursor As Long
Private hNewCursor As Long

'The UseCursor function will load and set a system cursor or a cursor from file to a
'controls event property.
Public Function UseCursor(ByVal NewCursor As Variant)

    'Load new cursor.
    Select Case TypeName(NewCursor)
        Case "String" 'Custom cursor from file.
            hNewCursor = LoadCursorFromFile(NewCursor)
        Case "Long", "Integer" 'System cursor.
            hNewCursor = LoadCursor(ByVal 0&, NewCursor)
        Case Else 'Do nothing
    End Select
    'If successful set new cursor.
    If (hNewCursor > 0) Then
        hOldCursor = SetCursor(hNewCursor)
    End If
    'Clean up.
    hOldCursor = DestroyCursor(hNewCursor)
    hNewCursor = DestroyCursor(hOldCursor)

End Function

Second, create a Class Module, "MouseListener":

Option Explicit

Dim WithEvents vsoWindow As Window

Private Sub Class_Initialize()

    Set vsoWindow = ActiveWindow

End Sub

Private Sub Class_Terminate()

    Set vsoWindow = Nothing

End Sub

Private Sub vsoWindow_MouseDown(ByVal Button As Long, ByVal KeyButtonState As Long, ByVal x As Double, ByVal y As Double, CancelDefault As Boolean)

    If Button = 1 Then

        Debug.Print "Left mouse button clicked"

    ElseIf Button = 2 Then

        Debug.Print "Right mouse button clicked"

    ElseIf Button = 16 Then

        Debug.Print "Center mouse button clicked"

    End If

End Sub

Private Sub vsoWindow_MouseMove(ByVal Button As Long, ByVal KeyButtonState As Long, ByVal x As Double, ByVal y As Double, CancelDefault As Boolean)

    Debug.Print "x-position is "; x
    Debug.Print "y-position is "; y

    modCursor.UseCursor modCursor.IDC_HAND

End Sub

Private Sub vsoWindow_MouseUp(ByVal Button As Long, ByVal KeyButtonState As Long, ByVal x As Double, ByVal y As Double, CancelDefault As Boolean)

    If Button = 1 Then

        Debug.Print "Left mouse button released"
        modCursor.UseCursor modCursor.IDC_HAND

    ElseIf Button = 2 Then

        Debug.Print "Right mouse button released"
        modCursor.UseCursor modCursor.IDC_ARROW

    ElseIf Button = 16 Then

        Debug.Print "Center mouse button released"

    End If

End Sub

Third, insert the following code into the "ThisDocument" module:

Private myMouseListener As MouseListener

Private Sub Document_DocumentSaved(ByVal doc As IVDocument)

Set myMouseListener = New MouseListener

End Sub

Private Sub Document_BeforeDocumentClose(ByVal doc As IVDocument)

Set myMouseListener = Nothing

End Sub

Now, by moving the mouse and clicking the buttons you get some information in the immediate window.

If you click the left button, the cursor changes to the hand, but when you move the mouse again, the cursor changes back. The only explanation I can think of is that Visio's events are changing the cursor icon depending on the (visual) context.

Regards,