Delay or Pause Execution: Enhanced V.2

Category:

Miscellaneous

Type:

Snippets

Difficulty:

Intermediate

Author:

Anonymous

Version Compatibility: Visual Basic 6

More information:

I Found 2 errors in the code for "Delay or Pause Execution: Enhanced." located at http://www.freevbcode.com/ShowCode.asp?ID=7880 Here is an updated version of the code.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Code:

'Name:      DELAY FOR AWHILE - ENHANCED
'Purpose:      This sub loops for a passed number of seconds.
'Inputs:       sngDelay    The quantity of time to elapse.
'Note:         fractional parts of a second work!
'Assumptions:  The sub assumes that sngDelay is never greater
'              than 86400. I.e. the sub is not designed to delay 
'              for longer than a day.
'
'Effects:      The calling routine's processing is 
'              effectively delayed
'              by the # of seconds in the argument, sngDelay. 
'
'Returns:      Nothing.
'
Public Sub subDelay(sngDelay As Single)
Const cSecondsInDay = 86400        ' # of seconds in a day.

Dim sngStart As Single             ' Start time.
Dim sngStop  As Single             ' Stop time.
Dim sngNow   As Single             ' Current time.

sngStart = Timer                   ' Get current timer.
sngStop = sngStart + sngDelay      ' Set up stop time based on
                                   ' delay.

Do
    sngNow = Timer                 ' Get current timer again.
    If sngNow < sngStart Then      ' Has midnight passed?
        sngStop = sngStop - cSecondsInDay  ' If yes, reset end.
        sngStart = -1              ' adjust one time only
    End If
    DoEvents                       ' Let OS process other events.
    Sleep 200                      ' Small delay to prevent 100% CPU usage
Loop While sngNow < sngStop        ' Has time elapsed?

End Sub

'
' TEST IT:    subTestDelay 0.5    IN IMMEDIATE WINDOW
'
Public Sub subTestDelay(sngDelay As Single)
Dim intIndex As Integer     ' For counter.

For intIndex = 0 To 9            ' Loop 10 times.
    Debug.Print "Mark " & Timer  ' Mark time.
    subDelay sngDelay            ' Delay.
Next intIndex                    ' Do it again.

End Sub