|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
本帖最后由 逍遥爱迪生 于 2024-5-26 21:31 编辑
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 |
评分
-
1
查看全部评分
-
|