如何以編程方式更改Visio中的遊標？

Question

嗨，有沒有什麼辦法可以通過編程方式在Visio中更改鼠標光標？ 我經歷了Visio SDK中的所有自動化類，並且找不到任何相關的屬性，方法，事件......

Answer 1

- 編輯：即使在以編程方式更改光標時，似乎Visio（2003 in我的電腦）不斷恢復原來的光標。我試過了，如果我不移動鼠標，我可以得到一個不同的光標（如手），直到我移動鼠標，然後返回到箭頭。

所以，現在，我的答案是：你不能改變光標。

也許這可能是其他Visio版本。

---

您可以使用來自VBA代碼的Windows API調用來更改光標。

這裏有一個例子：http://www.vbaexpress.com/kb/getarticle.php?kb_id=929

一個更好的例子，這是我得到了在Visio中的工作：http://www.tek-tips.com/viewthread.cfm?qid=1700789

及以下的，我已經使用了測試環境代碼：

首先，創建一個 「modCursor」 模塊：

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 

二，創建類模塊， 「的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 

三，插入下面的代碼插入到「的ThisDocument」模塊：

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 

現在，通過移動鼠標並點擊按鈕你在即時窗口中的一些信息。

如果您單擊左鍵，光標將變爲手，但是當您再次移動鼠標時，光標會變回。我能想到的唯一解釋是Visio的事件正在根據（視覺）上下文改變光標圖標。

Regards，