Cara menggunakan QueryPerformanceCounter untuk waktu kode

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

Kembali ke atas

Langkah demi langkah prosedur

1. Masukkan kode berikut ke dalam modul. Jika Anda masuk ke dalam kelas, bentuk, atau laporan modul, membuat deklarasi swasta.

          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. Menjalankan fungsi dari jendela Debug/segera. Keluaran Anda harus tampak mirip dengan berikut ini:
   Mulai nilai: 3516284.3498
   Mengakhiri nilai: 3516284.3521
   QueryPerformanceCounter resolusi minimum: 1/1193182 sec
   API Overhead: 1.92761875388667E-05 detik
   
   GetTickCount resolusi minimum: 10 ms
   Mengambil loop 650
   
   timeGetTime resolusi minimum: 10 ms
   Mengambil loop 1565

   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
				

Kembali ke atas