7,785
社区成员




Private Sub Command1_Click()
Dim i As Long, t As Double, t2 As Double, x As Boolean
Dim ts(19) As Double
While i < 20
x = True
t = Timer
Do While x
t2 = Timer
If t2 > t Then
ts(i) = t2 - t
t = t2
x = False
End If
Loop
i = i + 1
Wend
For i = 0 To 19
Debug.Print ts(i) * 1000000
Next
End Sub
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Sub Command1_Click()
Dim i As Long, t As Double, t2 As Double, x As Boolean
While i < 20
x = True
t = GetTickCount
Do While x
t2 = GetTickCount
If t2 > t Then
Debug.Print t
t = t2
x = False
End If
Loop
i = i + 1
Wend
End Sub
Private Type LARGE_INTEGER
lowpart As Long
highpart As Long
End Type
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long
Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long
Private Sub Command1_Click()
Dim i As Long, t As LARGE_INTEGER, t2 As LARGE_INTEGER, x As Boolean, tc As LARGE_INTEGER
Dim ts(19) As Double
QueryPerformanceFrequency tc
Debug.Print tc.highpart, tc.lowpart
While i < 20
QueryPerformanceCounter t
x = True
Do While x
QueryPerformanceCounter t2
If (t2.lowpart <> t.lowpart) Then
ts(i) = (t2.lowpart - t.lowpart)
t = t2
x = False
End If
Loop
i = i + 1
Wend
For i = 0 To 19
Debug.Print ts(i) / tc.lowpart * 1000000 '转化成微秒单位
Next
End Sub
'Example Name:Performance Counter
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 Sub Form_Load()
'KPD-Team 2001
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
Dim T As Long, liFrequency As LARGE_INTEGER, liStart As LARGE_INTEGER, liStop As LARGE_INTEGER
Dim cuFrequency As Currency, cuStart As Currency, cuStop As Currency
'Retrieve the frequency of the performance counter
If QueryPerformanceFrequency(liFrequency) = 0 Then
MsgBox "Your hardware doesn't support a high-resolution performance counter!", vbInformation
Else
'convert the large integer to currency
cuFrequency = LargeIntToCurrency(liFrequency)
'retrieve tick count
QueryPerformanceCounter liStart
'do something
For T = 0 To 100000
DoEvents
Next T
'retrieve tick count
QueryPerformanceCounter liStop
'convert large integers to currency's
cuStart = LargeIntToCurrency(liStart)
cuStop = LargeIntToCurrency(liStop)
'calculate how many seconds passed, and show the result
MsgBox "Time: " + CStr((cuStop - cuStart) / cuFrequency) + " seconds"
End If
End Sub
Private Function LargeIntToCurrency(liInput As LARGE_INTEGER) As Currency
'copy 8 bytes from the large integer to an ampty currency
CopyMemory LargeIntToCurrency, liInput, LenB(liInput)
'adjust it
LargeIntToCurrency = LargeIntToCurrency * 10000
End Function