Option Explicit
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' System declarations
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Declare Function QueryPerformanceCounter Lib "Kernel32" (x As Currency) As Boolean
Private Declare Function QueryPerformanceFrequency Lib "Kernel32" (x As Currency) As Boolean
Private Declare Function GetTickCount& Lib "Kernel32" ()
Dim cHft@, cHftBeg@, cHftEnd@, cHftFrq@, cHftOhd@, cHftTmp@ 'As Currency
Dim i&, j&, lCycQty&, lTotal&, lGtcBeg&, lGtcEnd&, lGtc&, lHft&
Dim bMore As Boolean
Dim sGtc$, sHft$
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Test declarations
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim lTest&
Public Sub sb_SpeedTest()
i = 0: j = 0
lCycQty = 1
bMore = True
lTotal = 8
Do While bMore
'If bMore Then lCycQty = lCycQty * 10
lCycQty = lCycQty * 10
j = j + 1
'' *** Test code setup
'' *** Test code setup end
i = 0
QueryPerformanceFrequency cHftFrq
QueryPerformanceCounter cHftBeg
QueryPerformanceCounter cHftEnd
cHftOhd = cHftEnd - cHftBeg
QueryPerformanceCounter cHftBeg
lGtcBeg = GetTickCount
Do ' *** LOOP
'DoEvents
i = i + 1
'' *** Test code begin
'lTest = GetTickCount * CLng(bMore)
lTest = GetTickCount * bMore
'' *** Test code end
Loop Until i = lCycQty ' *** LOOP
lGtcEnd = GetTickCount
QueryPerformanceCounter cHftEnd
lGtc = lGtcEnd - lGtcBeg
cHftTmp = cHftEnd - cHftBeg
QueryPerformanceCounter cHftBeg
QueryPerformanceCounter cHftEnd
cHftOhd = (cHftOhd + cHftEnd - cHftBeg) / 2
lHft = CLng(1000000 * (cHftTmp - cHftOhd) / cHftFrq)
'bMore = (lGtc < 10000)
bMore = (j < lTotal)
sGtc = Format(lGtc, "#,##0")
sHft = Format(lHft, "#,##0")
Debug.Print j; "; Cycles: " & "10^" & j & "; Time: "; sGtc & vbTab & vbTab & sHft
Loop
Debug.Print "*** *** ***" & vbLf
End Sub
|
