Winapi 如何在Visio中以编程方式更改光标?

Winapi 如何在Visio中以编程方式更改光标?,winapi,vba,visio,Winapi,Vba,Visio,您好,有什么方法可以通过编程方式更改Visio中的鼠标光标吗? 我浏览了Visio SDK中的所有自动化类,但找不到任何相关的属性、方法、事件 --编辑:即使您可以通过编程方式更改光标,Visio(我的计算机中的2003)似乎仍在不断地恢复原始光标。我已经试过了,如果我不移动鼠标,我可以得到一个不同的光标(比如手),直到我移动鼠标,然后它返回到箭头 现在,我的答案是:你不能改变光标 也许其他Visio版本也可以 您可以使用VBA代码中的Windows API调用来更改光标 这里有一个例子: 我

您好,有什么方法可以通过编程方式更改Visio中的鼠标光标吗? 我浏览了Visio SDK中的所有自动化类,但找不到任何相关的属性、方法、事件

--编辑:即使您可以通过编程方式更改光标,Visio(我的计算机中的2003)似乎仍在不断地恢复原始光标。我已经试过了,如果我不移动鼠标,我可以得到一个不同的光标(比如手),直到我移动鼠标,然后它返回到箭头

现在,我的答案是:你不能改变光标

也许其他Visio版本也可以


您可以使用VBA代码中的Windows API调用来更改光标

这里有一个例子:

我必须在Visio中使用的一个更好的示例:

下面是我用于测试环境的代码:

首先,创建一个“modCursor”模块:

其次,创建一个类模块“MouseListener”:

第三,在“ThisDocument”模块中插入以下代码:

现在,通过移动鼠标并单击按钮,您可以在即时窗口中获得一些信息

如果单击左键,光标将变为手,但再次移动鼠标时,光标将变回。我能想到的唯一解释是Visio的事件会根据(视觉)上下文更改光标图标

关于,

--Edit:即使您可以通过编程方式更改光标,Visio(在我的计算机中为2003)似乎仍会持续还原原始光标。我已经试过了,如果我不移动鼠标,我可以得到一个不同的光标(比如手),直到我移动鼠标,然后它返回到箭头

现在,我的答案是:你不能改变光标

也许其他Visio版本也可以


您可以使用VBA代码中的Windows API调用来更改光标

这里有一个例子:

我必须在Visio中使用的一个更好的示例:

下面是我用于测试环境的代码:

首先,创建一个“modCursor”模块:

其次,创建一个类模块“MouseListener”:

第三,在“ThisDocument”模块中插入以下代码:

现在,通过移动鼠标并单击按钮,您可以在即时窗口中获得一些信息

如果单击左键,光标将变为手,但再次移动鼠标时,光标将变回。我能想到的唯一解释是Visio的事件会根据(视觉)上下文更改光标图标

问候,

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
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
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