VB.NET可以幫助我們實現(xiàn)許多以前比較難已實現(xiàn)的功能。比如在鼠標(biāo)手勢的實現(xiàn)方面，就可以使用這一語言輕松的實現(xiàn)。下面就為大家詳細(xì)介紹一下這方面的應(yīng)用技巧，希望能給大家?guī)硪恍椭?/p>

1.什么是鼠標(biāo)手勢:

我的理解,按著鼠標(biāo)某鍵(一般是右鍵)移動鼠標(biāo),然后放開某鍵,程序會識別你的移動軌跡,做出相應(yīng)的響應(yīng).

 2.VB.NET鼠標(biāo)手勢實現(xiàn)原理:

首先說明一下,我在網(wǎng)上沒有找到相關(guān)的文檔,我的方法未必與其他人是一致的,實際效果感覺還可以.
鼠標(biāo)移動的軌跡我們可以將其看成是許多小段直線組成的,然后這些直線的方向就是鼠標(biāo)在這段軌跡中的方向了. 

 3.VB.NET鼠標(biāo)手勢實現(xiàn)代碼:

還要說明一下,

a)要捕獲鼠標(biāo)的移動事件,可以使用vb中的mousemove事件,但這個會受到一些限制(例如,在webbrowser控件上就沒有這個事件).于是這個例子中,我用win api,在程序中安裝個鼠標(biāo)鉤子,這樣就能夠捕獲整個程序的鼠標(biāo)事件了.

b)這個里只是個能捕獲鼠標(biāo)向上,下,左,右的移動的例子.(呵呵,其實這四方向一般也足夠了:))

新建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鼠標(biāo)手勢的程序后,在程序窗口上,按著右鍵移動鼠標(biāo),Immediate Window就會顯示出鼠標(biāo)移動的軌跡了.