New Sleep Method
When you are writing a sub or a function you maybe want to implement a delay.
The most common way is to use a DoEvents loop.
But then the CPU will be 100% busy.
Another way is to use the Sleep API.
But then your app won't respond to any events while waiting.
Way 3 sets a timer and exit the function.
The timer will start the function again.
But then you have to implement a state machine into every delayed function.
The following code won't stress the CPU, keeps your app responsive and it is easily to implement.
The only requirement is that you insert it into the code of a window with a hWnd.
Original Author: Robert Kaltenbach
API Declarations
Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private Const WM_TIMER = &H113
Private Const PM_NOREMOVE = &H0
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MSG
hWnd As Long
Message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Code
Private Sub Sleep(ByVal MilliSeconds As Long)
Dim Message As MSG, TimerID As Long
TimerID = Int(Rnd * 2 ^ 32 - 2 ^ 31)
TimerID = SetTimer(hWnd, TimerID, MilliSeconds, 0)
If TimerID = 0 Then Exit Sub
Do
DoEvents
WaitMessage
If PeekMessage(Message, hWnd, WM_TIMER, WM_TIMER, PM_NOREMOVE) Then
If Message.wParam = TimerID Then Exit Do
End If
Loop
KillTimer hWnd, TimerID
End Sub
Loading Comments ...
Comments
No comments have been added for this post.
You must be logged in to make a comment.