Article ID: 172338
Article Last Modified on 1/20/2007
Function Units Resolution --------------------------------------------------------------------------- Now, Time, Timer seconds 1 second GetTickCount milliseconds approx. 10 ms TimeGetTime milliseconds approx. 10 ms QueryPerformanceCounter QueryPerformanceFrequency sameIf your system supports a high-resolution counter, you can use QueryPerformanceCounter and QueryPerformanceFrequency to do high-resolution timings.
Option Explicit
Declare Function QueryPerformanceCounter Lib "Kernel32" _
(X As Currency) As Boolean
Declare Function QueryPerformanceFrequency Lib "Kernel32" _
(X As Currency) As Boolean
Declare Function GetTickCount Lib "Kernel32" () As Long
Declare Function timeGetTime Lib "winmm.dll" () As Long
Sub Test_Timers()
Dim Ctr1 As Currency, Ctr2 As Currency, Freq As Currency
Dim Count1 As Long, Count2 As Long, Loops As Long
'
' Time QueryPerformanceCounter
'
If QueryPerformanceCounter(Ctr1) Then
QueryPerformanceCounter Ctr2
Debug.Print "Start Value: "; Format$(Ctr1, "0.0000")
Debug.Print "End Value: "; Format$(Ctr2, "0.0000")
QueryPerformanceFrequency Freq
Debug.Print "QueryPerformanceCounter minimum resolution: 1/" & _
Freq * 10000; " sec"
Debug.Print "API Overhead: "; (Ctr2 - Ctr1) / Freq; "seconds"
Else
Debug.Print "High-resolution counter not supported."
End If
'
' Time GetTickCount
'
Debug.Print
Loops = 0
Count1 = GetTickCount()
Do
Count2 = GetTickCount()
Loops = Loops + 1
Loop Until Count1 <> Count2
Debug.Print "GetTickCount minimum resolution: "; _
(Count2 - Count1); "ms"
Debug.Print "Took"; Loops; "loops"
'
' Time timeGetTime
'
Debug.Print
Loops = 0
Count1 = timeGetTime()
Do
Count2 = timeGetTime()
Loops = Loops + 1
Loop Until Count1 <> Count2
Debug.Print "timeGetTime minimum resolution: "; _
(Count2 - Count1); "ms"
Debug.Print "Took"; Loops; "loops"
End Sub
Start Value: 3516284.3498
End Value: 3516284.3521
QueryPerformanceCounter minimum resolution: 1/1193182 sec
API Overhead: 1.92761875388667E-05 seconds
GetTickCount minimum resolution: 10 ms
Took 650 loops
timeGetTime minimum resolution: 10 ms
Took 1565 loops
Private Sub Time_Addition()
Dim Ctr1 As Currency, Ctr2 As Currency, Freq As Currency
Dim Overhead As Currency, A As Long, I As Long
QueryPerformanceFrequency Freq
QueryPerformanceCounter Ctr1
QueryPerformanceCounter Ctr2
Overhead = Ctr2 - Ctr1 ' determine API overhead
QueryPerformanceCounter Ctr1 ' time loop
For I = 1 To 100
A = A + I
Next I
QueryPerformanceCounter Ctr2
Debug.Print "("; Ctr1; "-"; Ctr2; "-"; Overhead; ") /"; Freq
Debug.Print "100 additions took";
Debug.Print (Ctr2 - Ctr1 - Overhead) / Freq; "seconds"
End Sub
Sample output:
( 3630876.6256 - 3630876.6388 - 0.0013 ) / 119.3182
100 additions took 9.97333181358753E-05 seconds
Keywords: kbhowto kbprogramming KB172338