High Speed Timer Function. (1 Viewer)

[ChrisO]

High Speed Timer Function.

Timing code originally from:-
http://allapi.mentalis.org/apilist/QueryPerformanceCounter.shtml

Option Explicit
Option Compare Text
                       
[color=green]'----------------------------
'KPD-Team 2001
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net[/color]
Private Type LARGE_INTEGER
    LowPart  As Long
    HighPart As Long
End Type

Private Declare Function QueryPerformanceCounter _
        Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long

Private Declare Function QueryPerformanceFrequency _
        Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long

Private Declare Sub CopyMemory _
        Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, _
                                                  Source As Any, _
                                                  ByVal Length As Long)

Private Declare Sub Sleep _
        Lib "kernel32" (ByVal lngMilliSeconds As Long)


Private Function LargeIntToCurrency(liInput As LARGE_INTEGER) As Currency
    [color=green]'KPD-Team 2001
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    
    'copy 8 bytes from the large integer to an ampty currency[/color]
    CopyMemory LargeIntToCurrency, liInput, LenB(liInput)
    
    [color=green]'adjust it[/color]
    LargeIntToCurrency = LargeIntToCurrency * 10000

End Function
'----------------------------

A general High Speed Timing function:-

Public Function HSTimer(Optional ByRef vntArg As Variant) As Currency
    Dim liFrequency     As LARGE_INTEGER
    Dim liStart         As LARGE_INTEGER
    Dim liEnd           As LARGE_INTEGER
    Dim curEnd          As Currency
    Static curFrequency As Currency
    Static curStart     As Currency
    
    If IsMissing(vntArg) Then
        [color=green]' initialise the Statics.[/color]
        QueryPerformanceFrequency liFrequency
        curFrequency = LargeIntToCurrency(liFrequency)
        
        QueryPerformanceCounter liStart
        curStart = LargeIntToCurrency(liStart)
    Else
        [color=green]' return the current offset from start.[/color]
        QueryPerformanceCounter liEnd
        curEnd = LargeIntToCurrency(liEnd)
        
        HSTimer = (curEnd - curStart) / curFrequency
    End If
    
End Function

Some of the ways to call the above HSTimer function:-

Sub TestEmptyLoop()
    Dim vntGetCurrent As Variant
    Dim lngCount      As Long

    Const conLoopCount As Long = 1000000
    
    [color=green]' Start the timer.[/color]
    HSTimer
   
    For lngCount = 1 To conLoopCount
        [color=green]' Do nothing.[/color]
    Next lngCount

    [color=green]' Display the elapsed time from Start.[/color]
    Debug.Print HSTimer(vntGetCurrent)

End Sub


Sub TestSingleProcess()
    Dim vntGetCurrent As Variant

    [color=green]' Start the timer.[/color]
    HSTimer
    
    [color=green]' Some process delay.[/color]
    Sleep 10    [color=green]' Sleep can cause a DoEvents.[/color]
    
    [color=green]' Display the elapsed time from Start.[/color]
    Debug.Print HSTimer(vntGetCurrent)
    
End Sub


Sub TestAverage()
    Dim vntGetCurrent As Variant
    Dim curTotal      As Currency
    Dim lngCount      As Long

    Const conLoopCount As Long = 100
    
    For lngCount = 1 To conLoopCount
        [color=green]' Start the timer.[/color]
        HSTimer
        
        [color=green]' Some process delay.[/color]
        Sleep 10    [color=green]' Sleep can cause a DoEvents.[/color]
        curTotal = curTotal + HSTimer(vntGetCurrent)
    Next lngCount
    
    [color=green]' Display the elapsed time from Start.[/color]
    Debug.Print curTotal / conLoopCount

End Sub


Sub TestAccumulative()
    Dim vntGetCurrent As Variant

    [color=green]' Start the timer.[/color]
    HSTimer
    
    [color=green]' Some process delay.[/color]
    Sleep 10    [color=green]' Sleep can cause a DoEvents.[/color]
    
    [color=green]' Display the elapsed time from Start.[/color]
    Debug.Print HSTimer(vntGetCurrent)
    
    [color=green]' Some process delay.[/color]
    Sleep 10    [color=green]' Sleep can cause a DoEvents.[/color]
    
    [color=green]' Display the elapsed time from Start.[/color]
    Debug.Print HSTimer(vntGetCurrent)

End Sub

The above times run to about 100 microsecond resolution but that resolution does not mean accuracy. Accuracy comes from the average of many iterations. Those iterations need to be spread over some extended time period to allow for other system events to take place.

The problem is, therefore, not the resolution of the timer but how the timer is applied.

In any case, that is one method to time a process to about 100 microsecond resolution.

Chris.