I have just done a source code comparison between the forum link inc and the inc on my drive as used above. They are different designs, so dropping what I use now onto the forum will break that thread. We have an analogy to dll hell.
I cannot remember when I redesigned the inc, but it looks like it didn't get published (for my use only).
Here is MacroTimersQPC.inc as used above. It does not have the macro above, but does have nTimeTaken.
Code: Select all
#Include Once "windows.bi"
#Include Once "string.bi"
#Include Once "win\mmsystem.bi"
Dim Shared As ULongInt liFreq
Dim Shared As ULongInt liStart(0 To 15), liStop(0 To 15)
Dim Shared As ULongInt liTotalTime( 0 To 15 )
Dim Shared As ULongInt liFastestTime( 0 To 15)
Dim Shared As ULongInt liSlowestTime( 0 To 15)
Dim Shared As ULongInt liTimerCallCount( 0 To 15 )
Dim Shared As String sFuncName( 0 To 15 )
QueryPerformanceFrequency Cast( Large_Integer Ptr, @liFreq)
#Define sPerformanceCounterFrequency LTrim(Format(liFreq, "###,###,###,###"))
#Macro StartHiResClock
Scope
Dim As TIMECAPS tc
TimeGetDevCaps( @tc, SizeOf(tc) )
TimeBeginPeriod(tc.wPeriodMin)
End Scope
Sleep (16,1) ' Tests have shown that the new resolution will not 'bite' until next 'old' tick
#EndMacro
#Macro StopHiResClock
Scope
Dim As TIMECAPS tc
TimeGetDevCaps( @tc, SizeOf(tc) )
TimeEndPeriod(tc.wPeriodMin)
End Scope
Sleep (2,1) ' Tests have shown that the new resolution will not 'bite' until next 'old' tick
#EndMacro
#Macro StartTimer(i)
sFuncName(i) = __FUNCTION__
QueryPerformanceCounter Cast( Large_Integer Ptr, @liStart(i) )
#EndMacro
#Define StopTimer(i) QueryPerformanceCounter Cast( Large_Integer Ptr, @liStop(i) )
#Macro StopTimer_UpdateTotalTime(i)
QueryPerformanceCounter Cast( Large_Integer Ptr, @liStop(i) )
liTotalTime(i) += ( liStop(i) - liStart(i) )
liTimerCallCount(i) += 1
#EndMacro
#Macro StopTimer_UpdateFastestTime(i)
QueryPerformanceCounter Cast( Large_Integer Ptr, @liStop(i) )
If liTimerCallCount(i) = 0 Then
liFastestTime(i) = liStop(i) - liStart(i)
Else
liFastestTime(i) = Min( liFastestTime(i), liStop(i) - liStart(i) )
End If
liTimerCallCount(i) += 1
#EndMacro
#Macro StopTimer_UpdateSlowestTime(i)
QueryPerformanceCounter Cast( Large_Integer Ptr, @liStop(i) )
liSlowestTime(i) = Max( liSlowestTime(i), liStop(i) - liStart(i) )
liTimerCallCount(i) += 1
#EndMacro
#Macro StopTimer_UpdateFastSlowTime(i)
Scope
Dim As ULongInt liDummy
QueryPerformanceCounter Cast( Large_Integer Ptr, @liStop(i) )
liDummy = liStop(i) - liStart(i)
If liTimerCallCount(i) = 0 Then
liFastestTime(i) = liDummy
liSlowestTime(i) = liDummy
Else
liFastestTime(i) = Min( liFastestTime(i), liDummy )
liSlowestTime(i) = Max( liSlowestTime(i), liDummy )
End If
End Scope
liTimerCallCount(i) += 1
#EndMacro
#Macro SetDecimalPlaces( a )
Select Case a+4*(a>3)+1
Case 1
s = "######"
Case 2
s = "######.#"
Case 3
s = "######.##"
Case 4
s = "######.###"
End Select
#Endmacro
Declare Function nTimeTaken( As Ubyte ) As Double
Declare Function sTimeTaken( As Long, As Long, As Long ) As String
Declare Function sTotalTimeTaken( As Long, As Long, As Long ) As String
Declare Function sFastestTimeTaken( As Long, As Long, As Long ) As String
Declare Function sSlowestTimeTaken( As Long, As Long, As Long ) As String
Declare Function sFastSlowTimeTaken( As Long, As Long, As Long ) As String
Declare Function sAverageTimeTaken( As Long, As Long, As Long ) As String
Declare Function FormatOutput( As Long, As ULongInt, As String, As String, As ULongInt, As Long, flag As Long ) As String
' ~~~~~~~~~~
Private Function nTimeTaken(Byval i As Ubyte) As Double
Dim n As Double
n = (liStop(i) - liStart(i))*1000/liFreq
liStart(i) = 0
Return n
End Function
Private Function sTimeTaken( i As Long, j As Long, flag As Long) As String
Dim s As String
Dim k As Long
If j>= 0 Then
k = Min(j,7)
SetDecimalPlaces( k )
s = " " + Format( (liStop(i) - liStart(i)) * _
IIf(k<4, 1000, 1000000)/liFreq, s) + IIf(k<4, "ms", "us")
Else
s = str( (liStop(i) - liStart(i)) * 1000/liFreq ) + "ms"
EndIf
If flag = True Then
s = "[" + LTrim(Str(i)) + "] in " + sFuncName(i) + " Single:" + s
EndIf
liStart(i) = 0
Return s
End Function
' ~~~~~~~~~~
Private Function sFastestTimeTaken( i As Long, j As Long, flag As Long ) As String
Dim s As String
s = FormatOutPut( i, liFastestTime(i), " Fastest(", sFuncName(i), liTimerCallCount(i), j, flag )
liStart(i) = 0
liTimerCallCount(i) = 0
liFastestTime(i) = 0
Return s
End Function
' ~~~~~~~~~~
Private Function sSlowestTimeTaken( i As Long, j As Long, flag As Long ) As String
Dim s As String
s = FormatOutput( i, liSlowestTime(i), " Slowest(", sFuncName(i), liTimerCallCount(i), j, flag )
liStart(i) = 0
liTimerCallCount(i) = 0
liSlowestTime(i) = 0
Return s
End Function
' ~~~~~~~~~~
Private Function sFastSlowTimeTaken( i As Long, j As Long, flag As Long ) As String
Dim s As String
Dim k As Long
If j >= 0 Then
k = Min(j,7)
SetDecimalPlaces(k)
s = " " + Format( liFastestTime(i) * IIf(k<4, 1000, 1000000)/liFreq, s ) + "~" + _
Format( liSlowestTime(i)* IIf(k<4, 1000, 1000000)/liFreq, s) + IIf(k<4, "ms", "us")
Else
s = Str( liFastestTime(i)*1000/liFreq ) + "~" + LTrim(Str( liSlowestTime(i)*1000/liFreq )) + "ms"
End If
If flag = True Then
s = "[" + LTrim(Str(i)) + "] in " + sFuncName(i) + " FastSlow(" + LTrim(Str(liTimerCallCount(i))) + "):" + s
End If
liStart(i) = 0
liTimerCallCount(i) = 0
liFastestTime(i) = 0
liSlowestTime(i) = 0
Return s
End Function
' ~~~~~~~~~~
Private Function sTotalTimeTaken( i As Long, j As Long, flag As Long ) As String
Dim s As String
s = FormatOutput( i, liTotalTime(i), " Total(", sFuncName(i), liTimerCallCount(i), j, flag )
liStart(i) = 0
liTotalTime(i) = 0
liTimerCallCount(i) = 0
Return s
End Function
' ~~~~~~~~~~
Private Function sAverageTimeTaken( i As Long, j As Long, flag As Long ) As String
Dim s As String
Dim k As Long
If j >= 0 Then
k = Min(j,7)
SetDecimalPlaces(k)
s = " " + Format( liTotalTime(i) * IIf(k<4, 1000, 1000000)/(liFreq * liTimerCallCount(i)), s) + IIf(k<4, "ms", "us")
Else
s = Str(liTotalTime(i)*1000/(liFreq * liTimerCallCount(i))) + "ms"
End If
If flag = True Then
s = "[" + LTrim(Str(i)) + "] in " + sFuncName(i) + " Average(" + LTrim(Str(liTimerCallCount(i))) + "):" + s
End If
liStart(i) = 0
liTotalTime(i) = 0
liTimerCallCount(i) = 0
Return s
End Function
' ~~~~~~~~~~
Private Function FormatOutput( ourTimer As Long, Scheme as ULongInt, sScheme As String, _
FuncName As String, Counter as ULongInt , j As Long, flag As Long ) As String
Dim k As Long
Dim s As String
If j >= 0 Then
k = Min( j, 7 )
SetDecimalPlaces( k )
s = " " + Format(Scheme * IIf(k<4, 1000, 1000000)/liFreq, s) + IIf(k<4, "ms", "us")
Else
s = Str(Scheme*1000/liFreq) + "ms"
End If
If flag = True Then
s = "[" + LTrim(Str(ourTimer)) + "] in " + FuncName + sScheme + LTrim(Str(Counter)) + "):" + s
End If
Return s
End Function
' ~~~~~~~~~~