如何得知Mouse已离开某物件(Mouse Hook)来源: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 ExplicitPublic Const WM_MOUSEMOVE = &H200 Public Const WH_MOUSE = 7Type 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 TypeDeclare 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 SubPrivate Sub Form_Load() Me.ScaleMode = 3 End Sub
如何得知Mouse已离开某物件(二) 来源:cww 叁考 王国荣先生的作法 上一回使用mouse Hook的方式来Check Mouse是否已离开某物件,详见 如何得知Mouse已离开某物件(Mouse Hook)但使用这个方法太麻 烦了,改用SetCapture 来使Mouse的Message转到某个Window之上,如此,不管Mouse移动 於何处,都会将Mouse Input Message传给某个Window,最後使用ReleaseCapture来取消这 个作用。Private Declare Function ReleaseCapture Lib "user32" () As Long Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As LongPrivate Sub Command1_Click() Command1.Tag = "" End SubPrivate Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Command1.Tag = "In" Then If X < 0 Or Y < 0 Or X > Command1.Width Or Y > Command1.Height Then Command1.Tag = "" ReleaseCapture Command1.Caption = "离开" End If Else Command1.Tag = "In" SetCapture Command1.hwnd Command1.Caption = "进入" End IfEnd Sub
我想知道api怎么实现
然后加分
可以吗?
动作,例如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 ExplicitPublic Const WM_MOUSEMOVE = &H200
Public Const WH_MOUSE = 7Type 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 TypeDeclare 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 SubPrivate Sub Form_Load()
Me.ScaleMode = 3
End Sub
如何得知Mouse已离开某物件(二)
来源:cww 叁考 王国荣先生的作法
上一回使用mouse Hook的方式来Check Mouse是否已离开某物件,详见
如何得知Mouse已离开某物件(Mouse Hook)但使用这个方法太麻
烦了,改用SetCapture 来使Mouse的Message转到某个Window之上,如此,不管Mouse移动
於何处,都会将Mouse Input Message传给某个Window,最後使用ReleaseCapture来取消这
个作用。Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As LongPrivate Sub Command1_Click()
Command1.Tag = ""
End SubPrivate Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Command1.Tag = "In" Then
If X < 0 Or Y < 0 Or X > Command1.Width Or Y > Command1.Height Then
Command1.Tag = ""
ReleaseCapture
Command1.Caption = "离开"
End If
Else
Command1.Tag = "In"
SetCapture Command1.hwnd
Command1.Caption = "进入"
End IfEnd Sub