p; 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
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.Print Timer, tStr
DebugDir = tStr
End Function
运行程序后,在程序窗口上,按着右键移动鼠标,Immediate Window就会显示出鼠标移动的轨迹了.
这里面的常数 ptGap 就是"鼠标移动的轨迹我们可以将其看成是许多小段直线组成的"中的小段的长度的平方.里面用到的api函数的用法,可以参考msdn.这里我就懒说了.
lingll (lingll2001@21cn.com)
2004-7-23
