真正的精确到毫秒级的动态秒表
转载请标明出处。用多媒体计数器做的真正的动态秒表。
演示窗体下载地址 http://download.csdn.net/source/318216
我选择了多媒体计数器！运行一分钟误差十几毫秒，调用自定义的函数TimeLabel转换时间，付出了代价，花了些时间。
理论上，高精度频率计数器最精确，毕竟API QueryPerformanceFrequency,QueryPerformanceCounter可以精确到微秒级；但是，它要认计算机，跟什么样的主板和操作系统有关，通用性不好，同时，它还会受外界影响，比如：拖动窗体计数器会暂停响应；适合短时间计时。
实际上，多媒体计数器最适用，适合长时间计时，最适合计算机软件运行计时；同时，API函数timeSetEvent内部实现多线程，不会受外界影响。
'标准模块：Module1.bas
Option Explicit
Public Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, ByVal uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, ByVal uFlags As Long) As Long
Public Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long
Public Declare Function GetTickCount Lib "kernel32" () As Long
Public MediaCount As Single '累加量
Public TimeID As Long '返回多媒体记时器对象标识
Public StartTime As Long '开始时间
Public EndTime As Long '结束时间
Public h As Long, m As Long, s As Long, ms As Long
Public cjlms As String
'API函数timeSetEvent使用的回调过程
Public Sub TimeSEProc(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, ByVal dw1 As Long, ByVal dw2 As Long)
Form1.Label1.Caption = TimeLabel(CLng(MediaCount * 1000))
MediaCount = MediaCount + 0.001
End Sub
Public Function TimeLabel(msTime As Long) As String '将毫秒时间转换成时间标签：时：分：秒.毫秒
Dim x As Long
x = msTime '单位毫秒
h = Int(x / 3600000) '计算小时
m = Int((x Mod 3600000) / 60000) '计算分钟
If m > = 60 Then
m = 0: h = h + 1
End If
s = Int((x Mod 3600000) Mod 60000) / 1000 '计算秒钟
If s > = 60 Then
s = 0: m = m + 1
End If
ms = ((x Mod 3600000) Mod 60000) Mod 1000 '计算毫秒数
If Len(Trim(Str(ms))) = 1 Then
cjlms = "00" & Trim(Str(ms))
End If
If Len(Trim(Str(ms))) = 2 Then
cjlms = "0" & Trim(Str(ms))
End If
If Len(Trim(Str(ms))) > 2 Then
cjlms = Trim(Str(ms))
End If
TimeLabel = IIf(Len(Trim(Str(h))) < 2, "0" & Trim(Str(h)), Trim(Str(h))) & ":" & IIf(Len(Trim(Str(m))) < 2, "0" & Trim(Str(m)), Trim(Str(m))) & ":" & IIf(Len(Trim(Str(s))) < 2, "0" & Trim(Str(s)), Trim(Str(s))) & "." & cjlms
End Function
'Form1的窗体模块
Option Explicit
Private Sub Form_Load()
Form1.Caption = "真正的动态秒表（小时：分：秒.毫秒）"
Form1.BackColor = &HFF8080
Command1.Caption = "开始计时[&S]"
Command2.Caption = "停止计时[&E]"
Command1.Enabled = True
Command2.Enabled = False
Label1.Alignment = 2 '居中对齐
Label1.Caption = "00:00:00.000"
Label2.Caption = "开始时间：" & "00:00:00.000"
Label3.Caption = "结束时间：" & "00:00:00.000"
Label4.Caption = "运行时间：" & "00:00:00.000"
Label1.BackColor = &H0&
Label1.ForeColor = &HFF00&
Label1.Font.Name = "Arial Rounded MT Bold"
Label1.Font.Size = 24
Label2.ForeColor = &HFFFF00
Label3.ForeColor = &HFFFF00
Label4.ForeColor = &HFFFF00
End Sub
Private Sub Command1_Click()
Command1.Enabled = False
Command2.Enabled = True
Label3.Caption = "结束时间：" & "00:00:00.000"
Label4.Caption = "运行时间：" & "00:00:00.000"
MediaCount = 0
StartTime = GetTickCount '记住开始时间
Label2.Caption = "开始时间：" & TimeLabel(StartTime)
TimeID = timeSetEvent(1, 0, AddressOf TimeSEProc, 1, 1) '间隔时间为1毫秒
End Sub
Private Sub Command2_Click()
Command2.Enabled = False
Command1.Enabled = True
Call timeKillEvent(TimeID)
EndTime = GetTickCount '记住结束时间
Label3.Caption = "结束时间：" & TimeLabel(EndTime)
Label4.Caption = "运行时间：" & TimeLabel(GetTickCount - StartTime)
Form1.Caption = "运行了" & IIf(Len(Trim(Str(h))) < 2, "0" & Trim(Str(h)), Trim(Str(h))) & "小时" & IIf(Len(Trim(Str(m))) < 2, "0" & Trim(Str(m)), Trim(Str(m))) & "分" & IIf(Len(Trim(Str(s))) < 2, "0" & Trim(Str(s)), Trim(Str(s))) & "秒" & cjlms & "毫秒"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unload Me
End Sub