怎样用AIP的timeGetTime函数来实现1秒一秒的叠加,到30秒时返回值

Question

如题~因为闹钟控件时间长了会有误差~

Answer 1

Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)Private Sub Command1_Click()
    Dim SaveTime As Double, i As Long
    SaveTime = timeGetTime
    Do While timeGetTime - SaveTime < 3000
        Sleep 10: DoEvents
        If (timeGetTime - SaveTime) Mod 1000 = 0 Then
            i = i + 1
            Debug.Print i
        End If
    Loop
    Debug.Print "Ok"
End Sub

Answer 2

有误差就用系统时钟嘛，timeGetTime虽然没误差，但不是在新线程中运行，也就是不能保证在主进程被阻塞的情况下及时触发。

Answer 3

没必要用 API
Sub Wait(ByVal Seconds As Long)
    Dim fStart As Single, fDiff As Single
    
    fStart = Timer()
    Do
        DoEvents
        fDiff = Timer() - fStart
        If fDiff < -0.5 Then '要避免浮点误差
            fDiff = fDiff + 86400 '跨零点的处理
        End If
    Loop While fDiff < Seconds
End Sub

Answer 4

Private Sub aaa(ZSJ As Long)    Dim fStart As Single, fDiff As Single
    fStart = Timer()
    Do
        DoEvents
        fDiff = Timer() - fStart
        If fDiff < -0.5 Then '要避免浮点误差
            fDiff = fDiff + 86400 '跨零点的处理
        End If
        
        youxi.shij.Caption = Fix(fDiff)
        If fDiff > 40 Then
         youxi.shijan.Caption = ZSJ - CLng(fDiff)
         Else
         youxi.shijan.Caption = 0
        End If
    Loop While fDiff < ZSJ
    aaa 70
End Sub
为什么我放到别的地方,第二次循环就会有误差?

Answer 5

Option ExplicitSub Main()
    Dim i As Long
    
    For i = 1 To 10
        Call Wait(IIf(i = 1, 1, 0))
        Debug.Print Timer()
    Next
End Sub'参数 Seconds 缺省（=0）表示以上次结束时间开始等待相同的间隔
Sub Wait(Optional ByVal Seconds As Long)
    Static fStart As Single
    Static lLastSeconds As Long
    Dim fDiff As Single
    
    If Seconds > 0 Then
        fStart = Timer()
        lLastSeconds = Seconds
    End If
    
    Do
        DoEvents
        fDiff = Timer() - fStart
        If fDiff < -0.5 Then '要避免浮点误差
            fDiff = fDiff + 86400 '跨零点的处理
        End If
    Loop While fDiff < lLastSeconds
    
    fStart = fStart + lLastSeconds
    If fStart > 86400 Then fStart = fStart - 86400
End Sub