有没有办法通过VBA中的winapi覆盖游标行为？

Question

我想在我的excel宏运行时更改光标图像。我设法通过这些winapi函数更改光标：SetCursor和LoadCursorFromFileA。

这是一个例子：

Option Explicit

Declare Function LoadCursorFromFileA Lib "user32" (ByVal lpFileName As String) As Long
Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long

Sub TestCursor()
     Call SetCursor(LoadCursorFromFileA("C:\Temp\cursor2.cur"))
    ' Waits 5 seconds, any movement of the mouse will revert the cursor back to default
    Application.Wait Now + TimeValue("00:00:05")
    ' Cursor is back to default at the end of the sub
End Sub

但是，如果存在事件（如对话框窗口）或光标移动，光标将变回默认值。

从this link看来，当鼠标悬停在元素上时Excel会更新光标。

我发现了一个solution，但它阻止了我的宏运行，因为它使用的是无限循环。

有没有办法覆盖Excel与光标的交互方式？

Answer 1

这是一些子类代码示例。在Excel中，Application.hWnd拥有您想要的hWnd。

Public Const WM_SETCURSOR = &H20

当您获得上述消息时返回True（-1）以停止光标中的进一步更改。

gWindowProc = true

---

Public Sub Hook()
   lpPrevWndProc = SetWindowLong(EditNote.gRtfHwnd, GWL_WNDPROC, _
   AddressOf gWindowProc)
End Sub

Public Sub Unhook()
   Dim temp As Long
   temp = SetWindowLong(EditNote.gRtfHwnd, GWL_WNDPROC, lpPrevWndProc)
End Sub

Public Function gWindowProc(ByVal hwnd As Long, ByVal Msg As Long, _
                 ByVal wParam As Long, ByVal lParam As Long) As Long
   If Msg = WM_CONTEXTMENU Then
        If EditNote.mnuViewEditContextMenu.Checked Then EditNote.PopupMenu EditNote.mnuEdit
'        gWindowProc = CallWindowProc(lpPrevWndProc, hWnd, Msg, wParam, _
         lParam)
   Else ' Send all other messages to the default message handler
      gWindowProc = CallWindowProc(lpPrevWndProc, hwnd, Msg, wParam, _
         lParam)
   End If
End Function

备注

当窗口进入菜单模式时，lParam的高位字为零。 DefWindowProc函数在处理之前将WM_SETCURSOR消息传递给父窗口。如果父窗口返回TRUE，则停止进一步处理。将消息传递到窗口的父窗口使父窗口控制子窗口中光标的设置。 DefWindowProc函数还使用此消息将光标设置为箭头（如果它不在客户端区域中），或者将光标设置为已注册的类光标（如果它位于客户端区域中）。如果lParam参数的低位字是HTERROR并且lParam的高位字指定按下其中一个鼠标按钮，则DefWindowProc调用MessageBeep函数。

MSDN 2001