Office中国论坛/Access中国论坛

标题: ［求助］捕捉鼠标移出事件遇到的钩子问题 [打印本页]
作者: 红尘如烟    时间: 2009-4-11 13:29
标题: ［求助］捕捉鼠标移出事件遇到的钩子问题
  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

  29. Public gfrmMouseMove As Form
  30. Public gctlMouseMove As Control

  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

  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

  76. Sub g_MouseMove(ctl As Control)
  77. ctl.BackColor = vbRed
  78. End Sub

  80. Sub g_MouseOut(ctl As Control)
  81. ctl.BackColor = vbWhite
  82. End Sub





复制代码
作者: t小宝    时间: 2009-4-11 13:46
把 hMod参数 设为 0 试试
作者: liwen    时间: 2009-4-11 15:17
本帖最后由 liwen 于 2009-4-11 15:23 编辑

试试
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    时间: 2009-4-11 16:05
试试下面的代码
Dim hInst As Long
  Dim Thread As Long
  hInst = GetModuleHandle(vbNullString)
  Thread = GetCurrentThreadId()         
  
mhHook = SetWindowsHookEx(WH_MOUSE, AddressOf HookProc, hInst, Thread)
作者: andymark    时间: 2009-4-11 16:07
在调用前必须加上GetModuleHandle GetCurrentThreadId API 的声明



欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3