真正的精确到毫秒级的动态秒表

转载请标明出处。用多媒体计数器做的真正的动态秒表。

演示窗体下载地址  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