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

2024-06-02 16:02| 来源: 网络整理| 查看: 265

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

起因是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

【本文地址】

公司简介

联系我们