VB 6.0 精确到毫秒的计时器 demo

工作需要，研究了一个精确到毫秒的计时器。

起因是VB的timer在间隔设置为100ms以下时不能准确的运行，所以不能用1ms为周期去执行毫秒的加一。

然后根据http://wenwen.sogou.com/z/q170447361.htm 这个受到启发 采用读取系统时间来进行计算。

===================================================

在vb中新建项目，再新建一个窗口。

在窗口中拖进一个Label、TextBox、CommandButton、Timer，并把TextBox的MultiLine属性设置为True。

然后把代码复制进去。

Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As systemTime)
Private Type systemTime
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type
Dim TIME_NOW As systemTime
Dim TIME_BEGAIN As systemTime
Dim TIME_END As systemTime

Dim time_msec_temp As Integer
Dim frist_start As Boolean

Dim timer_count As Integer

Private Sub Form_Load()
    Timer1.Enabled = False
    Timer1.Interval = 100
    
    Command1.Caption = "开始计时"
End Sub

Private Sub Command1_Click()
    If Command1.Caption = "开始计时" Then
        Call startTimer
    Else
        Call stopTimer
    End If
End Sub

Private Sub Timer1_Timer()
    GetSystemTime TIME_NOW
    If frist_start = True Then
'        记录开始的系统时间
        TIME_BEGAIN = TIME_NOW
        frist_start = False
    Else
        Label1.Caption = systemTimeToString(systemTimeMinu(TIME_NOW, TIME_BEGAIN))
    End If
    Text1.Text = Text1.Text & systemTimeToString(systemTimeMinu(TIME_NOW, TIME_BEGAIN)) & vbCrLf
    
'    测试只运行10次
    timer_count = timer_count + 1
    If timer_count = 10 Then
        timer_count = 1
''''''''        在这里调用的结束 所以结束的时候 时间可能会和textbox里面的不一样
        Call stopTimer
    End If
End Sub

'两个系统时间的差值
Private Function systemTimeMinu(ByRef time_big As systemTime, ByRef time_small As systemTime) As systemTime
    Dim dateBig, dateSmal, dateResult As Date
    Dim secondResult As Integer
    
    dateBig = getDateBySystemTime(time_big)
    dateSmall = getDateBySystemTime(time_small)
    dateResult = dateBig - dateSmall
'    开始计算毫秒的差值
'    先看秒数是不是相同
    If dateBig = dateSmall Then
'        时间相同 只有毫秒数不一样 直接用大的毫秒数减去小的毫秒数
        secondResult = time_big.wMilliseconds - time_small.wMilliseconds
    Else
'        时间不同 算一下最后的秒数 最后看是不是大于1000
        secondResult = 1000 - time_small.wMilliseconds + time_big.wMilliseconds
        If secondResult > 999 Then
'            大于1000也不用进位 直接减去即可
            secondResult = secondResult - 1000
        End If
    End If
    systemTimeMinu = getSystemTimeByDate(dateResult, secondResult)
'15:42:30.100
'+ 00:00:00.900  = 15:42:31.0
'+ 00:00:59.00    = 15:43:30.0
'+ 00:00:00.900 = 15:43.30.900
'=00:01:00.800
'15:43:30.900
'
'15:42:30.100
'+ 00:00:00.900  = 15:42:31.0
'+ 00:00:59.00    = 15:43:30.0
'+ 00:00:00.100 = 15:43.30.100
'=00:01:00.100
'15:43:30.100
End Function

'系统时间转为DATE类型 抹去毫秒
Private Function getDateBySystemTime(ByRef systemTime As systemTime) As Date
    Dim strDate, strTime As String
    strDate = systemTime.wYear & "/" & systemTime.wMonth & "/" & systemTime.wDay
    strTime = systemTime.wHour & ":" & systemTime.wMinute & ":" & systemTime.wSecond
    getDateBySystemTime = DateValue(strDate) + TimeValue(strTime)

'    getDateBySystemTime = DateValue(systemTime.wYear & "/" & systemTime.wMonth & "/" & systemTime.wDay) + TimeValue(systemTime.wHour & ":" & systemTime.wMinute & ":" & systemTime.wSecond)
End Function

'DATE类型专为系统时间  返回用作展示 所以只需要分钟、秒、毫秒就够了
Private Function getSystemTimeByDate(ByVal newDate As Date, ByVal newSecond As Integer) As systemTime
'    getSystemTimeByDate.wYear
'    getSystemTimeByDate.wMonth
'    getSystemTimeByDate.wDayOfWeek
'    getSystemTimeByDate.wDay
'    getSystemTimeByDate.wHour
    getSystemTimeByDate.wMinute = Minute(newDate)
    getSystemTimeByDate.wSecond = Second(newDate)
    getSystemTimeByDate.wMilliseconds = newSecond
End Function

'把系统时间类型转化为String
Private Function systemTimeToString(ByRef systemTime As systemTime) As String
    systemTimeToString = systemTime.wMinute & ":" & systemTime.wSecond & "." & systemTime.wMilliseconds
End Function

Sub startTimer()
    frist_start = True
    Timer1.Enabled = True
    Command1.Caption = "停止"
    Text1.Text = ""
    Label1.Caption = ""
End Sub

Sub stopTimer()
    Timer1.Enabled = False
    Command1.Caption = "开始计时"
'    记录结束时的系统时间
    GetSystemTime TIME_NOW
    TIME_END = TIME_NOW
    Label1.Caption = systemTimeToString(systemTimeMinu(TIME_END, TIME_BEGAIN))
End Sub

1.代码中是把记录开始时间放在Timer里面了，也可以放在按钮里执行。当然我觉得放在按钮里，刚按下的时候就记录比较好。
2.需要更改输出格式的，请修改"systemTimeToString"
3.有错误欢迎指出

demo下载传送门：

http://download.csdn.net/detail/wc250025/9417155