Source code for Issue Number 36

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Just paste this code into a new module and change the name of the module to basWait.

'----------------------------------------------------------------------
'
'   Module Name:    basWait
'   Written By:     C&D Programming Corp.
'   Create Date:    5/98
'   Copyright:      Copyright 1998 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit

' GetTickCount returns the number of milliseconds that Windows
' since Windows has started.
'
' The internal timer will wrap around to zero if Windows is
' run continuously for approximately 49 days.
'
Private Declare Function GetTickCount Lib "kernel32" () As Long

Public Function Wait(ByVal lSeconds As Long, _
                     Optional ByRef bAbortFlag As Boolean = False, _
                     Optional ByRef lElapsed As Long) As Boolean

    Dim lStartTime As Long

    lStartTime = GetTickCount
    lElapsed = 0
    While (lElapsed < lSeconds) And (Not bAbortFlag)
        ' Convert to seconds (use integer math for extra speed
        lElapsed = (GetTickCount - lStartTime) \ 1000
        DoEvents
    Wend
    Wait = Not bAbortFlag
End Function