如何得知Mouse已离开某物件(Mouse Hook)

最新推荐文章于 2025-05-23 13:53:13 发布

转载最新推荐文章于 2025-05-23 13:53:13 发布 · 912 阅读

文章标签：

#hook #command #button #reference #function

vb.net and vb 专栏收录该内容

21 篇文章

订阅专栏

本文介绍了一种利用Mouse Hook技术解决鼠标进入和离开控件时触发特定行为的方法。通过设置本地Hook监听所有鼠标事件，并检查鼠标坐标来判断鼠标是否位于指定控件范围内。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

来源:cww

常见到某些软体，当Mouse进入其区域时，会启动某个行为，Mouse离开时，又有其他的
动作，例如Cool   Bar，当Mouse移入时，Button会上升，离开时Button水变平面。

第一个想到的是在物件的MouseMove中设定进入的行为，这没有问题，但离开呢？有几
个想法：1.如果该物件在Form上，可以在Form的MouseMove上作离开的动作。2.於该物
件的MouseMove上Check是否Mouse的座标已在物件的边缘，若是则执行离开的动作。
但这两者，都会遇上一个问题，如果Mouse的移动很快，使得MouseMove的Event根本没
有在该物件或Form上面发生，那就不可行了；所以看来简单的问题又变复杂了，那只好
使用Mouse   Hook来做。

Mouse   Hook是拦截硬体所产生Mouse硬体的讯息，不管Mouse现在於何处，都会将Mouse的
讯息送往Hook   Procedure，当然，一般情况下，是於该程式正处於Active的情况下
(Local   Hook)，讯息才会送往该Hook   Procedure，如果别的程式所产生的Mouse讯息也要
进入该Hook   Function时，那便得使用Remote   Hook，而Remote   Hook的方式，是要把Hook
    Procedure放在.Dll之中，而Local   Hook只要把   Hook   Procedure放在.Bas之中便可以了。

因挂上了Mouse   Hook(Local)，所以该程式执行时所有的Mouse   的讯息便会送往该Hook
Function，而且有包含Mouse所在的座标(相对於Screen)，於是我们可以Check   Mouse
的座标，进而得知Mouse是否仍在物件范围。

Please   Reference   :   如何得知Mouse已离开某物件(二)
'以下在.Bas

Option   Explicit   
    
  Public   Const   WM_MOUSEMOVE   =   &H200   
  Public   Const   WH_MOUSE   =   7   
    
  Type   POINTAPI   
  X   As   Long   
  Y   As   Long   
  End   Type   
  Type   MOUSEHOOKSTRUCT   
  pt   As   POINTAPI   
  hwnd   As   Long   
  wHitTestCode   As   Long   
  dwExtraInfo   As   Long   
  End   Type   
  Type   RECT   
  Left   As   Long   
  Top   As   Long   
  Right   As   Long   
  Bottom   As   Long   
  End   Type   
    
  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   
  Declare   Function   UnhookWindowsHookEx   Lib   "user32"   _   
        (ByVal   hHook   As   Long)   As   Long   
  Declare   Function   CallNextHookEx   Lib   "user32"   (ByVal   hHook   As   Long,   _   
        ByVal   nCode   As   Long,   ByVal   wParam   As   Long,   lParam   As   Any)   As   Long   
  Declare   Sub   CopyMemory   Lib   "KERNEL32"   Alias   "RtlMoveMemory"   _   
      (lpvDest   As   Any,   ByVal   lpvSource   As   Long,   ByVal   cbCopy   As   Long)   
  Declare   Function   ScreenToClient   Lib   "user32"   (ByVal   hwnd   As   Long,   lpPoint   As   POINTAPI)   As   Long   
  Public   theForm   As   Form   
  Public   hHook   As   Long       '   handle   of   Hook   Procedure   
  Public   imgRect   As   RECT   
  Sub   EnableHook(ctl   As   Control)   
        If   hHook   =   0   Then   
              imgRect.Top   =   ctl.Top   
              imgRect.Left   =   ctl.Left   
              imgRect.Right   =   imgRect.Left   +   ctl.Width   
              imgRect.Bottom   =   imgRect.Top   +   ctl.Height   
              hHook   =   SetWindowsHookEx(WH_MOUSE,   AddressOf   MouseHookProc,   App.hInstance,   App.ThreadID)   
        End   If   
  End   Sub   
  Sub   FreeHook()   
  Dim   ret   As   Long   
  If   hHook   <>   0   Then   
        ret   =   UnhookWindowsHookEx(hHook)   
        hHook   =   0   
  End   If   
  End   Sub   
  Function   MouseHookProc(ByVal   code   As   Long,   ByVal   wParam   As   Long,   _   
  ByVal   lParam   As   Long)   As   Long   
    Dim   mStru   As   MOUSEHOOKSTRUCT,   i   As   Long   
    If   wParam   =   WM_MOUSEMOVE   Then   
          CopyMemory   mStru,   lParam,   LenB(mStru)   
          'mStru.pt的座标是萤幕座标，所以要经转换成相对於Form的座标   
          Call   ScreenToClient(Screen.ActiveForm.hwnd,   mStru.pt)   
    
          '不在imgButton之内    
          If   Not   (mStru.pt.Y   >=   imgRect.Top   And   mStru.pt.Y   <=   imgRect.Bottom   And   _   
                mStru.pt.X   >=   imgRect.Left   And   mStru.pt.X   <=   imgRect.Right)   Then   
                MouseHookProc   =   0   
                Call   CallNextHookEx(hHook,   code,   wParam,   lParam)   
                Call   FreeHook   
                Debug.Print   "Out   of   The   Range   "   
                Exit   Function   
          Else   
                Debug.Print   "In   The   Range"   
          End   If   
    End   If   
    MouseHookProc   =   0   '表示要处理这个讯息   
    Call   CallNextHookEx(hHook,   code,   wParam,   lParam)   
  End   Function   
    
  '以下在Form，需一个Command1    
  Private   Sub   Command1_MouseMove(Button   As   Integer,   Shift   As   Integer,   X   As   Single,   Y   As   Single)   
  Call   EnableHook(Command1)   
  End   Sub   
    
  Private   Sub   Form_Load()   
  Me.ScaleMode   =   3   
  End   Sub   