VBA高精度延时函数,精度1毫秒,VB6不占用CPU不卡顿

逍遥爱迪生

VBA高精度延时函数,精度1毫秒,VB6不占用CPU不卡顿


电脑默认计时精度是15毫秒左右，使用之前执行一次timeBeginPeriod 1，让计时器精度达到1毫秒

然后就可以多次使用延时：
Puase 1000
Puase 3500


Declare Function timeBeginPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long '提高计时器精度

Declare Function CreateWaitableTimerW Lib "kernel32.dll" (Optional ByVal lpTimerAttributes As Long, Optional ByVal bManualReset As Long, Optional ByVal lpTimerName As Long) As Long
Declare Function SetWaitableTimer Lib "kernel32.dll" (ByVal hTimer As Long, ByRef pDueTime As Currency, Optional ByVal lPeriod As Long, Optional ByVal pfnCompletionRoutine As Long, Optional ByVal lpArgToCompletionRoutine As Long, Optional ByVal fResume As Long) As Long
Declare Function MsgWaitForMultipleObjects Lib "user32.dll" (ByVal nCount As Long, ByRef pHandles As Long, ByVal bWaitAll As Long, ByVal dwMilliseconds As Long, ByVal dwWakeMask As Long) As Long
Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Public Const INFINITE As Long = -1&, QS_ALLINPUT As Long = &H4FF&

Sub Puase(ByVal MilliSeconds As Currency) '延时N毫秒
'版权所有，请保留作者信息
'逍遥爱迪生 QQ:527524938
'你可以免费使用，转发
Dim hTimer As Long
hTimer = CreateWaitableTimerW
Call SetWaitableTimer(hTimer, -MilliSeconds)
Do While MsgWaitForMultipleObjects(1&, hTimer, 0&, INFINITE, QS_ALLINPUT)
DoEvents
Loop
CloseHandle hTimer
End Sub

逍遥爱迪生

延时2秒，采用SetWaitableTimer,设定延时1998毫秒,剩下多少毫秒通过计算出来是1.023毫秒，再用死循环给他执行,相当于sleep 1.023毫秒。
就可以得到一个100%准确的延时函数。误差可能只有一微秒。
不占用cpu无卡顿的延时

为了提高计时器精度所以用了不少API。实际上这种只有在精准控制游戏帧率，工厂机器上位机准确发送指令所用，也用不了这么高精度。

计时器间隔为1秒，每次计时器触发，修改延时毫秒数，修正误差（比如延时995毫秒，延时1002毫秒),最终100次，1000次的计时器触发，（不限次数运行）累计误差也只有0.5毫秒左右(由最后一次延时产生)