form1.frm

variant code in this rar zipped package

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "显示鼠标轨迹"
   ClientHeight    =   3390
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4650
   LinkTopic       =   "form1"
   ScaleHeight     =   3390
   ScaleWidth      =   4650
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer Timer1 
      Interval        =   300
      Left            =   240
      Top             =   2880
   End
   Begin VB.CommandButton Command1 
      Caption         =   "退 出"
      Height          =   375
      Left            =   3120
      TabIndex        =   7
      Top             =   2880
      Width           =   1215
   End
   Begin VB.Frame FraUnits 
      Caption         =   "选择计程单位"
      Height          =   2055
      Left            =   360
      TabIndex        =   0
      Top             =   120
      Width           =   3855
      Begin VB.OptionButton OptUnits 
         Caption         =   "英寸"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   1
         Top             =   600
         Width           =   1095
      End
      Begin VB.OptionButton OptUnits 
         Caption         =   "厘米"
         Height          =   255
         Index           =   1
         Left            =   2280
         TabIndex        =   2
         Top             =   600
         Width           =   1095
      End
      Begin VB.OptionButton OptUnits 
         Caption         =   "英尺"
         Height          =   255
         Index           =   2
         Left            =   240
         TabIndex        =   3
         Top             =   1080
         Width           =   1095
      End
      Begin VB.OptionButton OptUnits 
         Caption         =   "米"
         Height          =   255
         Index           =   3
         Left            =   2280
         TabIndex        =   4
         Top             =   1080
         Width           =   1095
      End
      Begin VB.OptionButton OptUnits 
         Caption         =   "英里"
         Height          =   255
         Index           =   4
         Left            =   240
         TabIndex        =   5
         Top             =   1560
         Width           =   1095
      End
      Begin VB.OptionButton OptUnits 
         Caption         =   "公里"
         Height          =   255
         Index           =   5
         Left            =   2280
         TabIndex        =   6
         Top             =   1560
         Width           =   1095
      End
   End
   Begin VB.Label Label2 
      Caption         =   "鼠标行程："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   255
      Left            =   240
      TabIndex        =   9
      Top             =   2400
      Width           =   1455
   End
   Begin VB.Label Label1 
      Height          =   255
      Left            =   2040
      TabIndex        =   8
      Top             =   2400
      Width           =   2295
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Type PointAPI
    X As Long
    Y As Long
End Type
Dim MousePos As PointAPI
Private Declare Function GetCursorPos Lib "user32" _
(lpPoint As PointAPI) As Long
Dim OldX As Long
Dim OldY As Long
Dim NewX As Long
Dim NewY As Long
Dim Distance As Double
Dim Unit As Integer
Dim UnitValue As Long
Dim UnitName As String
Dim FormatStr As String
Const FormatStr1 = "000000.00"
Const FormatStr2 = "0000.0000"


Private Sub Command1_Click()
End
End Sub

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command1.FontBold = True
End Sub

Private Sub Form_Load()
    UnitValue = 1440
    UnitName = "英寸"
    FormatStr = FormatStr1
    Timer1.Enabled = True
    GetCursorPos MousePos
    OldX = MousePos.X * Screen.TwipsPerPixelX
    OldY = MousePos.Y * Screen.TwipsPerPixelY
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Command1.FontBold = False
End Sub

Private Sub OptUnits_Click(Index As Integer)
Dim i As Integer
For i = 0 To 5
If OptUnits(i).Value = True Then Unit = i
Next i
Select Case Unit
Case 0
UnitValue = 1440
UnitName = "英寸"
FormatStr = FormatStr1
Case 1
UnitValue = 567
UnitName = "厘米"
FormatStr = FormatStr1
Case 2
UnitValue = 14400
UnitName = "英尺"
FormatStr = FormatStr1
Case 3
UnitValue = 56700
UnitName = "米"
FormatStr = FormatStr1
Case 4
UnitValue = 144000000
UnitName = "英里"
FormatStr = FormatStr2
Case 5
UnitValue = 56700000
UnitName = "公里"
FormatStr = FormatStr2
End Select
End Sub

Private Sub Timer1_Timer()
 Label1.Caption = Format(Distance / UnitValue, FormatStr) & UnitName
    GetCursorPos MousePos
    NewX = MousePos.X * Screen.TwipsPerPixelX
    NewY = MousePos.Y * Screen.TwipsPerPixelY
    Distance = Distance + Sqr((NewX - OldX) * (NewX - OldX) + _
    (NewY - OldY) * (NewY - OldY))
    OldX = NewX
    OldY = NewY
End Sub