［求助］捕捉鼠标移出事件遇到的钩子问题

红尘如烟

1. Option Explicit
   
2. Public Const WM_MOUSEMOVE = &H200
   
3. Public Const WH_MOUSE = 7
   
4. Type POINTAPI
   
5. X As Long
   
6. Y As Long
   
7. End Type
   
8. Type MOUSEHOOKSTRUCT
   
9. pt As POINTAPI
   
10. hwnd As Long
    
11. wHitTestCode As Long
    
12. dwExtraInfo As Long
    
13. End Type
    
14. Type RECT
    
15. Left As Long
    
16. Top As Long
    
17. Right As Long
    
18. Bottom As Long
    
19. End Type
    
20. Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    
21. Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
    
22. Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
    
23. Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, ByVal lpvSource As Long, ByVal cbCopy As Long)
    
24. Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
    
25. Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
    
26. Private mhHook As Long
    
27. Private mctlRect As RECT
    
28. 
    
29. Public gfrmMouseMove As Form
    
30. Public gctlMouseMove As Control
    
31. 
    
32. Function g_MouseMoveEvent(ctl As Control, frm As Form) As Boolean
    
33. Dim pid As Long
    
34. If mhHook = 0 Then
    
35. Set gctlMouseMove = ctl
    
36. Set gfrmMouseMove = frm
    
37. With mctlRect
    
38. .Top = ctl.Top
    
39. .Left = ctl.Left
    
40. .Right = .Left + ctl.Width
    
41. .Bottom = .Top + ctl.Height
    
42. End With
    
43. '问题就在下面这一行中,hMod参数是应用程序实例的句柄，用Application.hWndAccessApp无效，要怎么弄？
    
44. mhHook = SetWindowsHookEx(WH_MOUSE, AddressOf HookProc, hmod:=Application.hWndAccessApp, _
    
45. dwThreadId:=GetWindowThreadProcessId(gfrmMouseMove.hwnd, pid))
    
46. g_MouseMoveEvent = True
    
47. End If
    
48. End Function
    
49. 
    
50. Function HookProc(ByVal code As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    
51. Dim msu As MOUSEHOOKSTRUCT
    
52. Dim blnMoveIn As Boolean
    
53. Dim blnOnControl As Boolean
    
54. Static i As Integer
    
55. If wParam <> WM_MOUSEMOVE Then Exit Function
    
56. CopyMemory msu, lParam, LenB(msu)
    
57. Call ScreenToClient(gfrmMouseMove.hwnd, msu.pt)
    
58. blnOnControl = (msu.pt.X * 15 >= mctlRect.Left And msu.pt.X * 15 <= mctlRect.Right _
    
59. And msu.pt.Y * 15 >= mctlRect.Top And msu.pt.Y * 15 <= mctlRect.Bottom)
    
60. If blnOnControl = False Then
    
61. HookProc = 0
    
62. CallNextHookEx mhHook, code, wParam, lParam
    
63. If mhHook <> 0 Then
    
64. Call UnhookWindowsHookEx(mhHook)
    
65. mhHook = 0
    
66. End If
    
67. Call g_MouseOut(gctlMouseMove)
    
68. Else
    
69. If blnMoveIn = False Then
    
70. Call g_MouseMove(gctlMouseMove)
    
71. blnMoveIn = True
    
72. End If
    
73. End If
    
74. End Function
    
75. 
    
76. Sub g_MouseMove(ctl As Control)
    
77. ctl.BackColor = vbRed
    
78. End Sub
    
79. 
    
80. Sub g_MouseOut(ctl As Control)
    
81. ctl.BackColor = vbWhite
    
82. End Sub
    
83. 
    
84. 
    
85. 
    
86. 
    
87. 
    

复制代码

t小宝

把 hMod参数 设为 0 试试

liwen

试试
Public Declare Function GetWindowLong Lib "user32" Alias _
         "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) _
         As Long

Public Const GWL_HINSTANCE = (-6)
hmod=GetWindowLong(Forms!窗体A.hwnd, (-6))

andymark

试试下面的代码
Dim hInst As Long
  Dim Thread As Long
  hInst = GetModuleHandle(vbNullString)
  Thread = GetCurrentThreadId()         
  
mhHook = SetWindowsHookEx(WH_MOUSE, AddressOf HookProc, hInst, Thread)

andymark

在调用前必须加上GetModuleHandle GetCurrentThreadId API 的声明