|
-
Mar 27th, 2000, 04:19 AM
#1
Member
Here is some code that I have that creates an extremely accurate timer down to 1ms resolution.
Put this at the top of the code:
Dim Time as HighResTimer
Set Time = New HighResTimer
Wherever you want your delay, just put the following code:
Time.EnterBlock
While Time.ElapsedTime <= 700
DoEvents
Time.ExitBlock
Wend
Put this code into a class module called HighResTimer:
'The number is codified as HighPart*2^32+LowPart
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 m_TicksPerSecond As Double
Private m_LI0 As LARGE_INTEGER
Private m_LI1 As LARGE_INTEGER
Public Sub Class_Initialize()
Dim LI As LARGE_INTEGER
If QueryPerformanceFrequency(LI) <> 0 Then
m_TicksPerSecond = LI2Double(LI)
Else
m_TicksPerSecond = -1
End If
End Sub
Public Property Get Resolution() As Double
Resolution = 1# / m_TicksPerSecond
End Property
Public Sub EnterBlock()
QueryPerformanceCounter m_LI0
End Sub
Public Sub ExitBlock()
QueryPerformanceCounter m_LI1
End Sub
Public Property Get ElapsedTime() As Double
Dim EnterTime As Double, ExitTime As Double
EnterTime = LI2Double(m_LI0) / m_TicksPerSecond
ExitTime = LI2Double(m_LI1) / m_TicksPerSecond
ElapsedTime = ExitTime - EnterTime
End Property
Private Function LI2Double(LI As LARGE_INTEGER) As Double
Dim Low As Double
Const TWO_32 = 4# * 1024# * 1024# * 1024#
Low = LI.LowPart
If Low < 0 Then Low = Low + TWO_32
'Now Low is in the range 0...2^32-1
LI2Double = LI.HighPart * TWO_32 + Low
End Function
Let me know if you need more help
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|