咨询一个关于鼠标位置得问题

Question

你好！ 
我想咨询一个关于鼠标位置得问题？
就是用VB6.0编程。捕获鼠标移动得距离。
比如：鼠标移动到一个位置，我把鼠标得坐标清零，然后我移动鼠标1米（超出了屏幕），那么我能通过计算而知道鼠标是移动了1米吗？
 
谢谢！

Answer 1

在窗体中放上两个Command，一个Label和一个Timer。Command1的Caption为“开始测定”，Command2的Caption为“退出
写入以下代码：
Private Declare Function GetCursorPos Lib "user32" (lpPoint As pointapi) As LongPrivate Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As LongPrivate Type pointapi '定义GetCursorPos中的参数    x As Long    y As LongEnd Type'声名变量:Dim Z As pointapiDim L, S, TOTALPublic A, B, K, H'
Private Sub Command1_Click()  GetCursorPos Z '得到初始鼠标位置  A = Z.x: B = Z.y  Timer1.Enabled = TrueEnd SubPrivate Sub Command2_Click()EndEnd Sub
Private Sub Form_Load()  H = GetDeviceCaps&(hdc, 8) '得到屏幕水平分辨率（单位为象素）  K = Screen.Width '得到屏幕宽度（单位为twip）  Timer1.Interval = 10 '数值约小，测得的结果约精确  Timer1.Enabled = False  S = 0End Sub
Private Sub Timer1_Timer()  GetCursorPos Z  L = Sqr((Z.x - A) ^ 2 + (Z.y - B) ^ 2) '每次循环得到鼠标移动距离（单位为象素），方法有些象微分  S = S + L '得到总的路程（单位为象素）  TOTAL = Int(S * K / H * 2.54 / 1400 / 100 * 100) / 100 '将S单位由象素划为米,取到小数点后两位。1缇=2.540/1400/100米。  Label1.Caption = TOTAL  A = Z.x: B = Z.y '用新位置的坐标替换原来的坐标End Sub

Answer 2

模块中代码:
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPublic Type POINTAPI
        x As Long
        y As Long
End TypePublic Const Twip_m As Single = 56692.854479
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Const FLAGS = SWP_NOSIZE Or SWP_NOMOVEPublic Function StayOnTop(frm As Form)
Dim SetWinOnTop As Long
SetWinOnTop = SetWindowPos(frm.hwnd, HWND_TOPMOST, frm.ScaleLeft, frm.ScaleTop, frm.ScaleWidth, frm.ScaleHeight, FLAGS)
End FunctionPublic Function NotOnTop(frm As Form)
Dim SetWinOnTop As Long
SetWinOnTop = SetWindowPos(frm.hwnd, HWND_NOTOPMOST, frm.Left, frm.Top, frm.ScaleWidth, frm.ScaleHeight, FLAGS)
End Function--------------------------------------------------
窗体中代码:
Private PositionBefore As POINTAPI, PositionNow As POINTAPI
Private TDist As Long
Private BeforeDistance As Long, NowDistance As Long
Private SpeedPixel_Sec As Single, Speedml_Sec As SinglePrivate Sub Check1_Click()
If Check1.Value = 1 Then
    Call api.StayOnTop(Me)
    Debug.Print Me.Top
Else
    Call api.NotOnTop(Me)
End If
End SubPrivate Sub Form_Load()
Call api.SetCursorPos(0, 0)
End SubPrivate Sub timVel_Timer()
BeforeDistance = NowDistance
NowDistance = TDist
SpeedPixel_Sec = (NowDistance - BeforeDistance)
Speedml_Sec = SpeedPixel_Sec * Screen.TwipsPerPixelX / api.Twip_m
Label4 = "速度 (像素/秒): " & SpeedPixel_Sec
Label5 = "速度 (米/秒): " & Format(Speedml_Sec, "#0.0#")
End SubPrivate Sub tmr1_Timer()
PositionBefore = PositionNow
Call api.GetCursorPos(PositionNow)
Label1 = "坐标: " & PositionNow.x & ", " & PositionNow.y
TDist = TDist + Distance(PositionBefore, PositionNow)
Label2 = "总计距离 (像素): " & TDist
Label3 = "总计距离 (米): " & Format(TDist * Screen.TwipsPerPixelX / api.Twip_m, "###0.000")
End SubPrivate Function Distance(p1 As POINTAPI, p2 As POINTAPI)
Dim v As Integer, h As Integerv = Abs(p1.y - p2.y)
h = Abs(p1.x - p2.x)
Distance = Int(Sqr(v ^ 2 + h ^ 2))
End Function