高精度计时器演示

[转载请注明出处]EXE演示程序下载地址：http://download.csdn.net/source/330199

这是前一遍文章《真正的精确到毫秒级的动态秒表》的改进，改进了前一遍文章只能在VB开发环境中运行，而编译成EXE文件不能运行的错误（一开始计时就崩溃）。同时，增加了高精度计时器的演示。

'标准模块：Module1.bas
Option Explicit

Public Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
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 Type LARGE_INTEGER
    lowpart As Long
    highpart As Long
End Type
Public Const TIME_PERIODIC = 1  '  program for continuous periodic event
Public Const TIME_ONESHOT = 0  '  program timer for single event
Public Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
Public Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long

Public MediaCount As Single '累加量
Public TimeID As Long    '返回多媒体记时器对象标识
Public StartTime As Long '开始时间
Public EndTime As Long   '结束时间

Public Type msTime '自定义时间类型
    h As Long  '时
    m As Long  '分
    s As Long  '秒
    ms As Long '毫秒
    us As Long '微秒
End Type
Public MediaCounter As msTime, Hirpc As msTime '声明2个结构类型变量

'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.Caption可以看出来，只是显示到屏幕上没有跟上进度。
       Dim X As Double
       MediaCount = MediaCount + 0.01
       X = MediaCount * 1000  '单位毫秒
       MediaCounter.h = Int(X / 3600000) '计算小时
       MediaCounter.m = Int((X Mod 3600000) / 60000) '计算分钟
       If MediaCounter.m >= 60 Then
          MediaCounter.m = 0: MediaCounter.h = MediaCounter.h + 1
       End If
       MediaCounter.s = Int((X Mod 3600000) Mod 60000) / 1000 '计算秒钟
       If Media