Saat Kodu'na QueryPerformanceCounter nasýl kullanýlýr?

Function                 Units                      Resolution
---------------------------------------------------------------------------
Now, Time, Timer         seconds                    1 second
GetTickCount             milliseconds               approx. 10 ms
TimeGetTime              milliseconds               approx. 10 ms
QueryPerformanceCounter  QueryPerformanceFrequency  same
				

Üste

Adým adým yordamlar

1. Aþaðýdaki kod, modül girin. Bir sýnýf, form veya rapor modülüne girin, bildirimlerinde özel olun.

          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
   						

2. Iþlev Debug/hemen penceresinden çalýþtýrýn. Çýkýþýnýz aþaðýdakine benzer görünmelidir:
   Deðer'ný baþlatýn: 3516284.3498
   Deðer son: 3516284.3521
   En düþük çözünürlüðü QueryPerformanceCounter: 1 1193182/sn
   API genel gider: 1.92761875388667E - 05 saniye
   
   GetTickCount en düþük çözünürlük: 10 ms
   650 Döngüleri sürdü
   
   en düþük çözünürlüðü timeGetTime: 10 ms
   1565 Döngüleri sürdü

   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
				

Üste