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