1.什么是鼠标手势:
   我理解,按着鼠标某键(般是右键)移动鼠标,然后放开某键,会识别你移动轨迹,做出相应响应.

2.实现原理:
首先介绍说明下,我在网上没有找到相关文档,我思路方法未必和其他人是致,实际效果感觉还可以.
鼠标移动轨迹我们可以将其看成是许多小段直线组成,然后这些直线方向就是鼠标在这段轨迹中方向了.
3.实现代码:
还要介绍说明下,
a)要捕获鼠标移动事件,可以使用vb中mousemove事件,但这个会受到些限制(例如,在webbrowserControl控件上就没有这个事件).于是这个例子中,我用win api,在中安装个鼠标钩子,这样就能够捕获整个鼠标事件了.
b)这个里只是个能捕获鼠标向上,下,左,右移动例子.(呵呵,其实这 4方向般也足够了:))

新建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 UnMouseHook
End Sub


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 UnhookWindowsHookEx 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, lpPo 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 tHWindowFromPo 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.Pr 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.Pr 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 UnMouseHook
    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
        mouseEventDsp = 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.Pr Timer, tStr
DebugDir = tStr
End Function

运行后,在窗口上,按着右键移动鼠标,Immediate Window就会显示出鼠标移动轨迹了.

这里面常数 ptGap 就是"鼠标移动轨迹我们可以将其看成是许多小段直线组成"中小段长度平方.里面用到api使用方法,可以参考msdn.这里我就懒说了.



lingll ([email protected])
2004-7-23