首页 新闻 论坛 群组 Blog 文档 下载 读书 Tag 网摘 搜索 .NET Java 游戏 视频 人才 外包 培训 数据库 书店 程序员
中国软件网
欢迎您:游客 | 登录 注册 帮助
  • 为一个网友写的真正的精确到毫秒级的动态秒表。顺便散分! [已结贴,结贴人:chenjl1031]
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-25 17:36:34 楼主
    为一个网友写的真正的精确到毫秒级的动态秒表。这个网友发贴子提问,只精确到了秒,我觉得动得不够快,所以改进了一下,动得很快,并修改了这个网友的错误。

    转载请标明出处。 VB演示窗体下载(源码):http://download.csdn.net/source/316696

    Option Explicit

    Dim x As Long
    Dim h As Long, m As Long, s As Long, ms As Long
    Dim cjlh As Long, cjlm As Long, cjls As Long
    Dim cjlms As String
    Private Sub Form_Load()
          'Form1.StartUpPosition = 2
          Form1.Caption = "真正的动态秒表(小时:分:秒.毫秒)"
          Command1.Caption = "开始[&S]"
          Command2.Caption = "结束[&E]"
          Label1.Alignment = 2            '居中对齐
          Label1.Caption = "00:00:00.000"
          Timer1.Interval = 10
          Timer1.Enabled = False
          Label1.BackColor = &H0&
          Label1.ForeColor = &HFF00&
          Label1.Font.Name = "Arial Rounded MT Bold"
          Label1.Alignment = 2
          x = 0
    End Sub
    Private Sub Command1_Click()
          Timer1.Enabled = True
          Label1.Font.Size = 24
    End Sub
    Private Sub Command2_Click()
          Timer1.Enabled = False
          Label1.Font.Size = 14
          x = 0
          Label1.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 & "毫秒"
          Form1.Caption = Label1.Caption
    End Sub
    Private Sub Timer1_Timer()            '每1秒钟触发100次
            x = x + 10 '单位是毫秒
            cjlh = Int(x / 3600000)
            h = cjlh '取得小时
            cjlm = Int(((x Mod 3600000) / 60000))  '关键在这里,用INT取整,不用INT的话,每30秒进1,有点奇怪
            m = cjlm '取得分钟
            cjls = Int(((x Mod 3600000) Mod 60000) / 1000)
            s = cjls '取得秒种
            ms = (((x Mod 3600000) Mod 60000) Mod 1000)
            If Len(Trim(Str(ms))) = 2 Then
              cjlms = "0" & Trim(Str(ms))
            End If
            If Len(Trim(Str(ms))) >= 3 Then
              cjlms = Trim(Str(ms))
            End If
            cjlms = Left(cjlms, 2) & Trim(Str(Int(Rnd * 9)))
            Label1.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


    50  修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-25 18:00:041楼 得分:2
    不错,学习了。
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-25 21:28:372楼 得分:2
    你强,我无话可说。
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-25 23:16:463楼 得分:2
    似乎问题很大
    timer 控件的 Interval 属性 不能作为真正的时间来参考
    你的秒表走了20秒 我电脑时间已经走了30秒
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-26 11:16:394楼 得分:0
    楼上说得没错,问题是很大。原因是用INT取整后,误差太大。
    但也不是像你说的timer控件不能用来计时,Timer事件定时触发是很准的,只是我的算错了,看来要把误差加上,缩小些差距。
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-26 11:19:305楼 得分:2
    接分
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-26 12:23:386楼 得分:2
    既然这么强,那就施舍点分吧
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    • tzwsoho
    • 等级:
    发表于:2007-12-26 14:46:037楼 得分:2
    接分
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-26 16:09:328楼 得分:2
    不错.
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    • myjian
    • 等级:
    发表于:2007-12-26 16:40:089楼 得分:2
    当我看到没有任何API声明时........我就知道这个一定无法精确到MS,哈哈

    代码没有看完~~

    不过送你两个API,它们才是真正的"精确"~~~

    QueryPerformanceFrequency,QueryPerformanceCounter

    至于小刀所说的"timer  控件的  Interval  属性  不能作为真正的时间来参考",是有根据的.

    使用API:SetTimer来写一个Timer控件看看~~其实控件里面也是用的这个API,只是封装起来而已.

    因为事件的触发是依靠应用程序里代码的响应的,所以应用程序里面只要有处理不及时,那么马上就会有误差.

    最简单的例子.....你在程序里弹出个Msgbox看看~~它还走不...呵呵

    用那两个API再改一下,重新发布吧~~~:)
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-26 17:35:3010楼 得分:0
    各位同仁,不怕你们笑话,今天上机一试不行,用X累加是不行的,我第一感想到了API,现在正在测试中...
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-26 17:37:4611楼 得分:2
    接分
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-26 18:31:5112楼 得分:2
    Private  Sub  Timer1_Timer()                        '每1秒钟触发100次

    Timer是做不到1秒钟内产生100次定时事件的。
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-26 19:01:4713楼 得分:2
      明眼人↑ 一看就明了  哈哈
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    • myjian
    • 等级:
    发表于:2007-12-26 20:16:3514楼 得分:2
    闹笑话很正常啊.

    大家谁敢说自己就没有闹过笑话~~呵呵

    只要以后尽量注意就差不多啦~~~~:)
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-26 20:54:0615楼 得分:2
    不算啥 我也经常这样`
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-26 21:08:5116楼 得分:2
    我以前测试过Timer控件每秒内能够触发的最大次数,在P3机器上可以达到100次;但在P4机器上却只有64次。这是由硬件决定的。下面是测量Timer控件每秒内能够触发的最大次数的代码,你们可以试试,开始的时候把Timer的Inteval属性设成1(ms):
    Option Explicit

    Private m_Count As Single, m_Time(99) As Single

    Option Explicit

    Private m_Count As Single, m_Time(99) As Single

    Private Sub Command1_Click()
        m_Count = 0
        Timer1.Enabled = True
        Command1.Enabled = False
    End Sub

    Private Sub Timer1_Timer()
        m_Time(m_Count) = Timer
        If m_Count = 99 Then
            Timer1.Enabled = False
            Command1.Enabled = True
            Text1.Text = "每秒最多触发" & Format$(100 / (m_Time(99) - m_Time(0)), "0") & "次"
        Else
            m_Count = m_Count + 1
        End If
    End Sub

    至于计时部分,由于Timer两次触发间的间隔在10ms量级,也就没必要使用QueryPerformanceCounter这样的高精度计时器,使用GetTickCount或timeGetTime即可,事实上Timer两次触发间的间隔正好也是后两个API所能分辨的最小间隔,这是完全匹配的。
    当然要是偶的话直接用VB的Timer属性,Timer属性能分辨的最小间隔和后两个函数完全一样,但代码可以写的非常简单。
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    • windlysnowly
    • 等级:
    发表于:2007-12-26 21:13:0617楼 得分:2
    up  学习
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-26 21:32:3818楼 得分:2
    楼主的代码可能是在P3的机器上写的,到了更高级的机器上水土不服。
    使用Timer属性的话可以定义个模块级的Single型m_Start,在计时开始时给m_Start赋值:
    m_Start=Timer
    然后在Timer控件引发的事件中用Timer-m_Start即可以计算出经历的秒数,精度能够达到10ms级。
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-26 23:48:1919楼 得分:2
    這個題目,用 TIMER 控件,本來就不對了。
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-27 09:46:2820楼 得分:2
    我用过TIMER控件做实事控制,这个控件非常的不准,当其他的进程阻塞了,定时精度有时秒级都达不到.
    我认为在VB中要精确定时还得靠API。
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-27 10:31:0321楼 得分:0
    重新发布,原来的作废。

    是我错了,错了就是错了,既然要做就把它做好,否则对不起这位网友。
    最后选择了多媒体计数器!运行一分钟误差十几毫秒,调用自定义的函数TimeLabel转换时间,付出了代价,花了些时间。
    理论上,高精度频率计数器最精确,毕竟API QueryPerformanceFrequency,QueryPerformanceCounter可以精确到微秒级;但是,它要认计算机,跟什么样的主板和操作系统有关,通用性不好,同时,它还会受外界影响,比如:拖动窗体计数器会暂停响应;适合短时间计时。
    实际上,多媒体计数器最适用,适合长时间计时,最适合计算机软件运行计时;同时,API函数timeSetEvent内部实现多线程,不会受外界影响。
    ------------------------------------------------------------------------------------------------------
    遗憾的是,这几个VB代码只能在VB开发环境下运行,编译成EXE运行会崩溃,我还没来得及找是什么原因,各位朋友有兴趣的话帮我分析一下。
    ------------------------------------------------------------------------------------------------------

    '标准模块: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

    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-27 10:46:5222楼 得分:0
    用多媒体计数器做的真正的动态秒表。演示窗体下载地址    http://download.csdn.net/source/318216
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    • myjian
    • 等级:
    发表于:2007-12-27 13:53:2823楼 得分:2
    QueryPerformanceFrequency,QueryPerformanceCounter不是要认机器....

    用法没对头

    先用QueryPerformanceFrequency得到一秒内本机可以完成的计数器值,保存;

    以后计数时,就两次调用QueryPerformanceCounter,其差就是两次调用间计数器所完成的计数值;

    再把此值除以QueryPerformanceFrequency得到的值,就可以得到经过的时间.....

    这个可以达到微秒级~~
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-27 15:01:3224楼 得分:0
    老马这么一说,我有兴趣了!
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    • ZW_LM
    • 等级:
    发表于:2007-12-27 21:17:4825楼 得分:2
    个人认为还是使用Gettickcount可能比定时器更精确些。
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    • myjian
    • 等级:
    发表于:2007-12-27 21:22:2626楼 得分:2
    思路搞通了就OK了

    今天好冷,早点睡.......

    明天就有事干了.....新的控制器与马达发过来,我要写控制程序了.....
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-29 11:26:5427楼 得分:2
    写一个精确到毫秒的秒表用这么麻烦吗?秒表只要记时精确到毫秒就可以了,追求显示精确有什么意义呢?
    下面这个秒表直接用Timer函数写的,精确到1/10000秒,连清零过程产生的误差都会被体现出来。

    Private priOnTimer As Double
    Private priAddTimer As Double

    Private Sub Command1_Click()
      If Timer1.Enabled Then
        priAddTimer = priAddTimer + Abs(priOnTimer - Timer)
      End If
      Timer1.Enabled = Not Timer1.Enabled
      priOnTimer = Timer
      ShowTimer
    End Sub

    Private Sub Command2_Click()
      priAddTimer = 0
      priOnTimer = Timer
      ShowTimer
    End Sub

    Private Sub Timer1_Timer()
      ShowTimer
    End Sub

    Sub ShowTimer()
      Text1.Text = TimeStr(Abs(priOnTimer - Timer) + priAddTimer)
    End Sub

    Function TimeStr(ByVal pTimer As Double) As String
      Dim tH As Long
      Dim tM As Long
      Dim tS As Long
      Dim tMS As Long
      Dim tAT As Double
      tAT = pTimer * 10000
      tMS = tAT Mod 10000
      tS = tAT \ 10000 Mod 100
      tM = tAT \ 600000 Mod 100
      tH = tAT \ 36000000 Mod 100
      TimeStr = Format(tH, "00") & ":" & Format(tM, "00") & ":" & Format(tS, "00") & ":" & Format(tMS, "0000")
    End Function

    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-29 11:36:4028楼 得分:2
    印象中timer只能精确到每秒18.2次,也就是硬件的时钟中断次数
    修改 删除 举报 引用 回复
    进入用户个人空间
    加为好友
    发送私信
    在线聊天
    发表于:2007-12-29 12:36:3129楼 得分:4
    VB.NET code
    'Example Name:Performance Counter Private Type LARGE_INTEGER LowPart As Long HighPart As Long End Type Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Private Sub Form_Load() 'KPD-Team 2001 'URL: http://www.allapi.net/ 'E-Mail: KPDTeam@Allapi.net Dim T As Long, liFrequency As LARGE_INTEGER, liStart As LARGE_INTEGER, liStop As LARGE_INTEGER Dim cuFrequency As Currency, cuStart As Currency, cuStop As Currency 'Retrieve the frequency of the performance counter If QueryPerformanceFrequency(liFrequency) = 0 Then MsgBox "Your hardware doesn't support a high-resolution performance counter!", vbInformation Else 'convert the large integer to currency cuFrequency = LargeIntToCurrency(liFrequency) 'retrieve tick count QueryPerformanceCounter liStart 'do something For T = 0 To 100000 DoEvents Next T 'retrieve tick count QueryPerformanceCounter liStop 'convert large integers to currency's cuStart = LargeIntToCurrency(liStart) cuStop = LargeIntToCurrency(liStop) 'calculate how many seconds passed, and show the result MsgBox "Time: " + CStr((cuStop - cuStart) / cuFrequency) + " seconds" End If End Sub Private Function LargeIntToCurrency(liInput As LARGE_INTEGER) As Currency 'copy 8 bytes from the large integer to an ampty currency CopyMemory LargeIntToCurrency, liInput, LenB(liInput) 'adjust it LargeIntToCurrency = LargeIntToCurrency * 10000 End Function

    foxAPI例程
    修改 删除