DoEvents alternative function

Submitted by:Tim Kelly

Date added:22 October, 2012

Category:Visual Basic

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.

Tags: alternative function

Code Snippet:

'DoEvents alternative function.
'Written by Nir Sofer

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
 
 

Comments