High Resolution Timers in Visual Basic

Provided by Dan Haught, FMS Executive Vice President

The built-in Visual Basic timer object does not have very high resolution. This can make it difficult to perform accurate timings. The following code, from the our award-winning Total Visual SourceBook product, shows how to use a high-resolution multi-media timer to track elapsed time. This class is useful for timing user operations, or for bench-marking your applications. Because it uses the Windows multi-media timer it uses much higher resolution than the built-in VB Timer function.

Sample Code

' Class       : CMMTimer
' Description : Track elapsed time
' Source      : Total Visual SourceBook 
'
' Declarations for Windows API calls
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
 
' Local variables to hold Public Property values
Private m_lngScaleFactor As Long
 
' Private class-specific variables
Private mlngElapsedTime As Long
Private mlngStarted As Long
Private mfStopped As Boolean
 
Private Sub Class_Initialize()
  ' Comments: Set initial values to defaults which may be overridden with property settings
  ' Source  : Total Visual SourceBook
 
  ' Scales value from milliseconds to seconds
  m_lngScaleFactor = 1000
  
End Sub
 
Public Property Get ElapsedTime() As Double
  ' Returns: the current Elapsed Time value, scaled by the value of the ScaleFactor property
  ' Source : Total Visual SourceBook 
 
  On Error GoTo PROC_ERR
    
  ElapsedTime = CDbl((mlngElapsedTime + GetCurrentElapsedTime()) / m_lngScaleFactor)
 
PROC_EXIT:
  Exit Property
 
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , "ElapsedTime"
  Resume PROC_EXIT
End Property
 
Private Function GetCurrentElapsedTime() As Long
  ' Comments: Returns the elapsed time since the timer was last started
  ' Returns : Current Elapsed Time
  ' Source  : Total Visual SourceBook 
  
  On Error GoTo PROC_ERR
 
  If mlngStarted <> 0 And mfStopped = False Then
    GetCurrentElapsedTime = (timeGetTime - mlngStarted)
  End If
 
PROC_EXIT:
  Exit Function
 
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , "GetCurrentElapsedTime"
  Resume PROC_EXIT
End Function
 
Public Sub ResumeTimer()
  ' Comments: Resumes a timing operation which was paused with the StopTimer method. If the timer was not started already, it is started automatically.
  ' Source  : Total Visual SourceBook
  '
  On Error GoTo PROC_ERR
 
  mlngStarted = timeGetTime
  mfStopped = False
 
PROC_EXIT:
  Exit Sub
 
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , "ResumeTimer"
  Resume PROC_EXIT
End Sub
 
Public Property Get ScaleFactor() As Long
  ' Returns: the current value of ScaleFactor
  ' Source : Total Visual SourceBook 
  
  ScaleFactor = m_lngScaleFactor
 
End Property
 
Public Property Let ScaleFactor(ByVal lngValue As Long)
  ' Comments: Set the scaling factor. 
  ' Params  : lngValue   A value of 1000 returns results in portions of seconds; a value of 60000 returns results in portions of minutes
  ' Source: Total Visual SourceBook 2002
  
  If lngValue > 0 Then
    m_lngScaleFactor = lngValue
  End If
 
End Property
 
Public Sub StartTimer()
  ' Comments: Starts a timing operation. The value of ElapsedTime is reset before beginning
  ' Source  : Total Visual SourceBook 

  On Error GoTo PROC_ERR
 
  mlngStarted = timeGetTime
  mfStopped = False
  mlngElapsedTime = 0
 
PROC_EXIT:
  Exit Sub
 
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , "StartTimer"
  Resume PROC_EXIT
 
End Sub
 
Public Sub StopTimer()
  ' Comments: Stops the timer. Current elapsed time value is not reset.
  ' Source  : Total Visual SourceBook 
  '
  On Error GoTo PROC_ERR
 
  ' Set Elapsed Time value to the previous elapsed time
  ' value, plus any increment since the timer was last started
  mlngElapsedTime = mlngElapsedTime + GetCurrentElapsedTime()
  
  mlngStarted = 0
  mfStopped = True
 
PROC_EXIT:
  Exit Sub
 
PROC_ERR:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , "StopTimer"
  Resume PROC_EXIT 
End Sub

Additional Resources

 

 

Thank you! Thank you! I just finished reading this document, which was part of a link in the recent Buzz newsletter. I have printed it for others to read, especially those skeptical on the powers of Access and its capabilities.

Darren D.


View all FMS products for Microsoft Access All Our Microsoft Access Products

 

 

Free Product Catalog from FMS