devxlogo

PerformanceTimer – A class module for high-resolution time measurement

PerformanceTimer – A class module for high-resolution time measurement

'-------------------------------------------' PerformanceTimer class module'-------------------------------------------' Use this class to profile your code and any other operation' typically with a precision greater than 1 millionth of a second'' As soon as you create an object, the timer starts' but you can also start it explicitly with StartTimer' Stop the timer and retrieve timing with StopTimer, or' get the timing without stopping the timer with ElapsedTime'' The TotalTime property returns the number of seconds the' timer has been active, so you can use it to sum up partial' timings, after swithing the timer on and off' The FormatTime is similar to elapsed time, but returns' the time as a formatted string with desired precision'' Example:'         Dim pc As New PerformanceCounter'         pc.StartTimer'         ' ...'         ' put here the code you want to benchmark'         ' ...'         ' print elapsed time, but don't stop the timer'         Debug.Print pc.ElapsedTime'         ' ...'         ' so something else here'         ' ...'         ' print elapsed time and stop the timer'         Debug.Print pc.StopTimer'         ' ...'         ' prepare another benchmark here'         ' ...'         ' start the benchmark, without resetting total time'         pc.StartTimer'         ' ...'         ' put here the code you want to benchmark'         ' ...'         ' print elapsed as a formatted string'         Debug.Print pc.FormatTime("Second benchmark ### secs.", 4)'         ' print total time'         Debug.Print pc.TotalTime'Option ExplicitPrivate Declare Function QueryPerformanceFrequencyAny Lib "kernel32" Alias _    "QueryPerformanceFrequency" (lpFrequency As Any) As LongPrivate Declare Function QueryPerformanceCounterAny Lib "kernel32" Alias _    "QueryPerformanceCounter" (lpPerformanceCount As Any) As Long' the frequency for this computerDim frequency As CurrencyDim startTime As CurrencyDim endTime As CurrencyDim totTime As Currency' Start the timer'' if argument is True, it also resets the' internal total time counterSub StartTimer(Optional ByVal ResetTotalTime As Boolean)    ' get the current value of the counter    QueryPerformanceCounterAny startTime    ' reset total time counter if requested    If ResetTotalTime Then totTime = 0End Sub' stop the timer'' returns the time elapsed since StartTimerFunction StopTimer() As Double    ' get the elapsed time    StopTimer = ElapsedTime    ' update the total time counter    totTime = totTime + (endTime - startTime)    ' reset starting time    startTime = 0End Function' return the elapsed time in seconds since StartTimer' without stopping the timerProperty Get ElapsedTime() As Double    ' exit if StartTimer hasn't been called since    ' the previous call to StopTimer    If startTime = 0 Then Exit Property        ' get the current value of the counter    QueryPerformanceCounterAny endTime    ' return the elapsed time in seconds    ElapsedTime = (endTime - startTime) / frequencyEnd Property' return the total time in secondsProperty Get TotalTime() As Double    If startTime = 0 Then        ' StopTimer has been called        ' so totTime is correctly updated        TotalTime = totTime / frequency    Else        TotalTime = (totTime + (endTime - startTime)) / frequency    End IfEnd Property' return a time value as a formatted string' if second argument is omitted, it uses ElapsedTime'' return it as a formatted string with' specified number of decimal - use ### in the string' as a placeholder for the elapsed time'   e.g.  Print GetTimeMsg("Elapsed ### secs.", , 4)'' NOTE: this function is slightly less precise than'       GetTime, because arguments are passedProperty Get FormatTime(msg As String, Optional seconds As Double = -1, _    Optional ByVal decDigits As Integer = 7) As String    ' get the elapsed time if not passed as an argument    If seconds ' build the result string    FormatTime = Replace(msg, "###", CStr(Round(seconds, decDigits)))End Property' return the timer precision in secondsProperty Get Precision() As Double    ' frequency must be scaled up by 10E4    Precision = 1 / (frequency * 10000#)End Property' evaluate the frequency once and for all' when this object is createdPrivate Sub Class_Initialize()    ' raise error if API functions aren't supported    If QueryPerformanceFrequencyAny(frequency) = 0 Then        Err.Raise 1001, , "This system doesn't support high-res timing"    End If    ' get start time as well    StartTimerEnd Sub

devx-admin

Share the Post: