VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3225
   ClientLeft      =   3255
   ClientTop       =   4065
   ClientWidth     =   4485
   LinkTopic       =   "Form1"
   ScaleHeight     =   3225
   ScaleWidth      =   4485
   Begin VB.CommandButton Command3 
      Caption         =   "Cancel"
      Height          =   1095
      Left            =   2520
      TabIndex        =   3
      Top             =   1680
      Width           =   1695
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Use NewDoEvents (API)"
      Height          =   495
      Left            =   120
      TabIndex        =   2
      Top             =   2280
      Width           =   2175
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Use DoEvents"
      Height          =   495
      Left            =   120
      TabIndex        =   1
      Top             =   1680
      Width           =   2175
   End
   Begin VB.Label lblCounter 
      Height          =   255
      Left            =   120
      TabIndex        =   0
      Top             =   840
      Width           =   4095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
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

Dim bCancel As Boolean

'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


'uses regular DoEvents
Private Sub Command1_Click()
    Dim lCounter As Long, nStart As Double
    nStart = Timer
    bCancel = False
    For lCounter = 1 To 50000
        If bCancel Then Debug.Print "Hey! it got Cancelled": Exit Sub
        lblCounter.Caption = CStr(lCounter)
        DoEvents
    Next
    Debug.Print "Old Doevents : "; Timer - nStart
End Sub

'uses new MyDoEvents (using API)
Private Sub Command2_Click()
    Dim lCounter As Long, nStart As Double
    nStart = Timer
    bCancel = False
    For lCounter = 1 To 50000
        If bCancel Then Debug.Print "Hey! it got Cancelled": Exit Sub
        lblCounter.Caption = CStr(lCounter)
        MyDoEvents
    Next
    Debug.Print "New Doevents : "; Timer - nStart
End Sub

'Signals a cancel
Private Sub Command3_Click()
    Debug.Print "I clicked Cancel"
    bCancel = True
End Sub