DoEvents alternative function

The following code snippet shows you how to create an alternative DoEvents function by using Win32 API calls.
Be aware that accelerator keys won't work properly with this alternative function.

'DoEvents alternative function.
'Written by Nir Sofer
'Web site: http://nirsoft.mirrorz.com

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

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 TranslateMessage Lib "user32" _
(lpMsg As MSG) As Long
Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" _
(lpMsg As MSG) As Long

Private Const PM_REMOVE = &H1

'The alternative function for DoEvents:
Private Sub MyDoEvents()
    Dim CurrMsg         As MSG
    
    'The following loop extract all messages from the queue and dispatch them
    'to the appropriate window.
    Do While PeekMessage(CurrMsg, 0, 0, 0, PM_REMOVE) <> 0
        TranslateMessage CurrMsg
        DispatchMessage CurrMsg
    Loop
End Sub

Private Sub cmdStart_Click()
    Dim lCounter            As Long
    
    For lCounter = 1 To 20000
        lblCounter.Caption = CStr(lCounter)
        MyDoEvents
    Next
End Sub


Download this sample project