' Class       : CMMTimer
' Description : Track elapsed time
' Source      : Total Visual SourceBook 2002
'
' 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()
  ' Set initial values to defaults which may be overridden
  ' with property settings
  ' Source: Total Visual SourceBook 2002
 
  ' 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 2002
 
  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
  ' Parameters: None
  ' Returns   : Current Elapsed Time
  ' Source    : Total Visual SourceBook 2002
  '
  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.
  ' Parameters: None
  ' Returns   : Nothing
  ' Source    : Total Visual SourceBook 2002
  '
  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 2002
  
  ScaleFactor = m_lngScaleFactor
 
End Property
 
Public Property Let ScaleFactor(ByVal lngValue As Long)
  ' lngValue: Set the scaling factor. 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
  ' Parameters: None
  ' Returns   : Nothing
  ' Source    : Total Visual SourceBook 2002
  '
  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.
  ' Parameters: None
  ' Returns   : Nothing
  ' Source    : Total Visual SourceBook 2002
  '
  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