StopWatch

Option Explicit
Option Compare Text

' Example usage:

'

' Public Sub MySub()

' Dim SW As CStopWatch

' Dim X As Long

' Set SW = New CStopWatch

' SW.StartTimer

' For X = 1 To 100000

' If X Mod 10000 = 0 Then

' Debug.Print " Laptime: " & SW.LapTime & _

' " Elapsed: " & SW.ElapsedMilliseconds

' End If

' Next X

' SW.StopTimer

' Debug.Print "Loop Time: " & SW.ElapsedMilliseconds

' Set SW = Nothing

' End Sub

' Debug output:

' Laptime: 0 Elapsed: 0

' Laptime: 6 Elapsed: 6

' Laptime: 5 Elapsed: 11

' Laptime: 4 Elapsed: 15

' Laptime: 5 Elapsed: 20

' Laptime: 5 Elapsed: 25

' Laptime: 5 Elapsed: 30

' Laptime: 0 Elapsed: 30

' Laptime: 5 Elapsed: 35

' Laptime: 5 Elapsed: 40

' Loop Time: 40

'-- Local Declares


Private Declare Function GetTickCount Lib "kernel32" () As Long
Private m_lStartTime As Long
Private m_lEndTime As Long
Private m_lLastLapTime As Long

Public Sub StopTimer()
On Error Goto StopTimer_Error
m_lEndTime = GetTickCount()
Goto StopTimer_Exit
StopTimer_Error:
Err.Raise Err.Number, "CStopWatch::StopTimer()", _
Err.Description, Err.HelpFile, Err.HelpContext
Resume StopTimer_Exit
Resume 'For debugging purposes
StopTimer_Exit:
End Sub

Public Sub ResetTimer()
On Error Goto ResetTimer_Error
m_lStartTime = 0
m_lEndTime = 0
m_lLastLapTime = 0
Goto ResetTimer_Exit
ResetTimer_Error:
Err.Raise Err.Number, "CStopWatch::ResetTimer()", _
Err.Description, Err.HelpFile, Err.HelpContext
Resume ResetTimer_Exit
Resume 'For debugging purposes
ResetTimer_Exit:
End Sub

Public Sub StartTimer()
On Error Goto StartTimer_Error
Dim lStoppedTime As Long
If m_lEndTime > 0 Then
lStoppedTime = GetTickCount() - m_lEndTime
m_lStartTime = m_lStartTime + lStoppedTime
m_lLastLapTime = m_lLastLapTime + lStoppedTime
Else
m_lStartTime = GetTickCount()
End If

m_lEndTime = 0
Goto StartTimer_Exit
StartTimer_Error:
Err.Raise Err.Number, "CStopWatch::StartTimer()", _
Err.Description, Err.HelpFile, Err.HelpContext
Resume StartTimer_Exit
Resume 'For debugging purposes
StartTimer_Exit:
End Sub

Public Property Get ElapsedMilliseconds() As Long
On Error Goto ElapsedMilliseconds_Error
If m_lStartTime = 0 Then
ElapsedMilliseconds = 0
Goto ElapsedMilliseconds_Exit
End If
If m_lEndTime = 0 Then
ElapsedMilliseconds = GetTickCount() - m_lStartTime
Else
ElapsedMilliseconds = m_lEndTime - m_lStartTime
End If
Goto ElapsedMilliseconds_Exit
ElapsedMilliseconds_Error:
Err.Raise Err.Number, "CStopWatch::ElapsedMilliseconds()", _
Err.Description, Err.HelpFile, Err.HelpContext
Resume ElapsedMilliseconds_Exit
Resume 'For debugging purposes
ElapsedMilliseconds_Exit:
End Property

Public Property Get Laptime() As Long
On Error Goto Laptime_Error
Dim lCurrentLapTime As Long
Dim lRetVal As Long
lCurrentLapTime = Me.ElapsedMilliseconds
If m_lLastLapTime = 0 Then
lRetVal = lCurrentLapTime
Else
lRetVal = lCurrentLapTime - m_lLastLapTime
End If
m_lLastLapTime = lCurrentLapTime
Laptime = lRetVal
Goto Laptime_Exit
Laptime_Error:
Err.Raise Err.Number, "CStopWatch::Laptime()", _
Err.Description, Err.HelpFile, Err.HelpContext
Resume Laptime_Exit
Resume 'For debugging purposes
Laptime_Exit:
End Property
Assumes:Create a new class module and paste the text
into it. Name the class CStopWatch.