[VB6] Function Wait (non-freezing & non-CPU-intensive)

[Bonnie West]

This routine waits for the specified amount of time without blocking other events or increasing the CPU usage. Fully tested only on XP. Using PeekMessage with a value of -1 for the hWnd parameter seems to be unreliable under Vista and Windows 7, but the documentation makes no mention of this.

Private Type MSG
    hWnd    As Long
    Message As Long
    wParam  As Long
    lParam  As Long
    Time    As Long
    Pt_X    As Long
    Pt_Y    As Long
End Type

Private Declare Function KillTimer Lib "user32.dll" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function PeekMessage Lib "user32.dll" Alias "PeekMessageW" (ByRef lpMsg As MSG, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function SetTimer Lib "user32.dll" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, Optional ByVal lpTimerFunc As Long) As Long
Private Declare Function WaitMessage Lib "user32.dll" () As Long

'This routine waits for the specified amount of time before resuming with the next line of code
Public Function Wait(ByVal Milliseconds As Long) As Boolean
    Const PM_QS_POSTMESSAGE = &H980000, WM_TIMER = &H113&
    Dim TimerID As Long, M As MSG

    TimerID = SetTimer(0&, App.ThreadID, Milliseconds)
    If TimerID Then
        Do:  Wait = WaitMessage
             If PeekMessage(M, -1&, WM_TIMER, WM_TIMER, PM_QS_POSTMESSAGE) Then If M.wParam = TimerID Then Exit Do
        Loop Until DoEvents < 0
        TimerID = KillTimer(0&, TimerID):     Debug.Assert TimerID
    End If
End Function

The attached Form demonstrates usage of this simple function.

UPDATE

Version 2 of the code now works more reliably under Vista and Windows 7.



Check out the related code: Shell & Wait