VB.NET鼠标手势实现技巧分享

VB.NET可以帮助我们实现许多以前比较难已实现的功能。比如在鼠标手势的实现方面，就可以使用这一语言轻松的实现。下面就为大家详细介绍一下这方面的应用技巧，希望能给大家带来一些帮助。

1.什么是鼠标手势:

我的理解,按着鼠标某键(一般是右键)移动鼠标,然后放开某键,程序会识别你的移动轨迹,做出相应的响应.

 2.VB.NET鼠标手势实现原理:

首先说明一下,我在网上没有找到相关的文档,我的方法未必与其他人是一致的,实际效果感觉还可以.
鼠标移动的轨迹我们可以将其看成是许多小段直线组成的,然后这些直线的方向就是鼠标在这段轨迹中的方向了. 

 3.VB.NET鼠标手势实现代码:

还要说明一下,

a)要捕获鼠标的移动事件,可以使用vb中的mousemove事件,但这个会受到一些限制(例如,在webbrowser控件上就没有这个事件).于是这个例子中,我用win api,在程序中安装个鼠标钩子,这样就能够捕获整个程序的鼠标事件了.

b)这个里只是个能捕获鼠标向上,下,左,右的移动的例子.(呵呵,其实这四方向一般也足够了:))

新建Standrad EXE,添加一个Module

form1的代码如下

Option Explicit   
Private Sub Form_Load()   
Call InstallMouseHook   
End Sub   
Private Sub Form_QueryUnload
(Cancel As Integer, 
UnloadMode As Integer)   
Call UninstallMouseHook   
End Sub  

#p#

Module1的代码如下

Option Explicit   
Public Const HTCLIENT As Long = 1   
Private hMouseHook As Long   
Private Const KF_UP As Long = &H80000000   
Public Declare Sub CopyMemory Lib "kernel32"
 Alias "RtlMoveMemory" (hpvDest As Any,
 hpvSource As Any, ByVal cbCopy As Long)   
Private Type POINTAPI   
X As Long   
Y As Long   
End Type   
Public Type MOUSEHOOKSTRUCT   
pt As POINTAPI   
hwnd As Long   
wHitTestCode As Long   
dwExtraInfo As Long   
End Type   
Public Declare Function CallNextHookEx
 Lib "user32" _   
(ByVal hHook As Long, _   
ByVal ncode As Long, _   
ByVal wParam As Long, _   
ByVal lParam As Long) As Long   
Public 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   
Public Declare Function UnhookWindows
HookEx Lib "user32" _   
(ByVal hHook As Long) As Long   
Public Const WH_KEYBOARD As Long = 2   
Public Const WH_MOUSE As Long = 7   
Public Const HC_SYSMODALOFF = 5   
Public Const HC_SYSMODALON = 4   
Public Const HC_SKIP = 2   
Public Const HC_GETNEXT = 1   
Public Const HC_ACTION = 0   
Public Const HC_NOREMOVE As Long = 3   
Public Const WM_LBUTTONDBLCLK As Long = &H203   
Public Const WM_LBUTTONDOWN As Long = &H201   
Public Const WM_LBUTTONUP As Long = &H202   
Public Const WM_MBUTTONDBLCLK As Long = &H209   
Public Const WM_MBUTTONDOWN As Long = &H207   
Public Const WM_MBUTTONUP As Long = &H208   
Public Const WM_RBUTTONDBLCLK As Long = &H206   
Public Const WM_RBUTTONDOWN As Long = &H204   
Public Const WM_RBUTTONUP As Long = &H205   
Public Const WM_MOUSEMOVE As Long = &H200   
Public Const WM_MOUSEWHEEL As Long = &H20A   
Public Declare Function PostMessage Lib 
"user32" Alias "PostMessageA" (ByVal hwnd 
As Long, ByVal wMsg As Long, ByVal wParam 
As Long, ByVal lParam As Long) As Long   
Public Const MK_RBUTTON As Long = &H2   
Public Declare Function ScreenToClient 
Lib "user32" (ByVal hwnd As Long, lpPoint
 As POINTAPI) As Long   
Public Declare Function GetAsyncKeyState 
Lib "user32" (ByVal vKey As Long) As Integer   
Public Const VK_LBUTTON As Long = &H1   
Public Const VK_RBUTTON As Long = &H2   
Public Const VK_MBUTTON As Long = &H4   
Dim mPt As POINTAPI   
Const ptGap As Single = 5 * 5   
Dim preDir As Long   
Dim mouseEventDsp As String   
Dim eventLength As Long   
'######### mouse hook #############   
Public Sub InstallMouseHook()   
hMouseHook = SetWindowsHookEx(WH_MOUSE, 
AddressOf MouseHookProc, _   
App.hInstance, App.ThreadID)   
End Sub   
Public Function MouseHookProc(ByVal iCode 
As Long, ByVal wParam As Long, ByVal 
lParam As Long) As Long   
Dim Cancel As Boolean   
Cancel = False   
On Error GoTo due   
Dim i&   
Dim nMouseInfo As MOUSEHOOKSTRUCT   
Dim tHWindowFromPoint As Long   
Dim tpt As POINTAPI   
If iCode = HC_ACTION Then   
CopyMemory nMouseInfo, ByVal lParam, 
Len(nMouseInfo)   
tpt = nMouseInfo.pt   
ScreenToClient nMouseInfo.hwnd, tpt   
'Debug.Print tpt.X, tpt.Y   
If nMouseInfo.wHitTestCode = 1 Then   
Select Case wParam   
Case WM_RBUTTONDOWN   
mPt = nMouseInfo.pt   
preDir = -1   
mouseEventDsp = ""   
Cancel = True   
Case WM_RBUTTONUP   
Debug.Print mouseEventDsp   
Cancel = True   
Case WM_MOUSEMOVE   
If vkPress(VK_RBUTTON) Then   
Call GetMouseEvent(nMouseInfo.pt)   
End If   
End Select   
End If   
End If   
If Cancel Then   
MouseHookProc = 1   
Else   
MouseHookProc = CallNextHookEx(hMouseHook,
 iCode, wParam, lParam)   
End If   
Exit Function   
due:   
End Function   
Public Sub UninstallMouseHook()   
If hMouseHook <> 0 Then   
Call UnhookWindowsHookEx(hMouseHook)   
End If   
hMouseHook = 0   
End Sub   
Public Function vkPress(vkcode As Long) As Boolean   
If (GetAsyncKeyState(vkcode) And &H8000) <> 0 Then   
vkPress = True   
Else   
vkPress = False   
End If   
End Function   
Public Function GetMouseEvent(nPt As POINTAPI) As Long   
Dim cx&, cy&   
Dim rtn&   
rtn = -1   
cx = nPt.X - mPt.X: cy = -(nPt.Y - mPt.Y)   
If cx * cx + cy * cy > ptGap Then   
If cx > 0 And Abs(cy) <= cx Then   
rtn = 0   
ElseIf cy > 0 And Abs(cx) <= cy Then   
rtn = 1   
ElseIf cx < 0 And Abs(cy) <= Abs(cx) Then   
rtn = 2   
ElseIf cy < 0 And Abs(cx) <= Abs(cy) Then   
rtn = 3   
End If   
mPt = nPt   
If preDir <> rtn Then   
mouseEventDspmouseEventDsp = mouseEventDsp
 & DebugDir(rtn)   
preDir = rtn   
End If   
End If   
GetMouseEvent = rtn   
End Function   
Public Function DebugDir(nDir&) As String   
Dim tStr$   
Select Case nDir   
Case 0   
tStr = "右"   
Case 1   
tStr = "上"   
Case 2   
tStr = "左"   
Case 3   
tStr = "下"   
Case Else   
tStr = "无"   
End Select   
Debug.Print Timer, tStr   
DebugDir = tStr   
End Function  

运行VB.NET鼠标手势的程序后,在程序窗口上,按着右键移动鼠标,Immediate Window就会显示出鼠标移动的轨迹了.