Option Explicit
'****************************************
'Function：用于精确的定时与计时
'author: QJP
'Date: 20120626
'****************************************

Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As Currency) As Long
Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As Currency) As Long
Private m_StartTime As Currency
Private m_cpuFr As Currency


Public Declare Function timeGetTime Lib "winmm.dll" () As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Function QueryTimerStart(Optional dStartCount As Currency) As Boolean
Dim dResult As Long
If QueryPerformanceFrequency(m_cpuFr) Then
dResult = QueryPerformanceCounter(m_StartTime)
Else
m_cpuFr = 0
m_StartTime = timeGetTime()
End If

dStartCount = m_StartTime
End Function

Public Function QueryTimerStop(dwMilliseconds As Long,Optional dStartCount As Currency = 0) As Boolean

Dim dResult As Long
Dim dStopTime As Currency

If m_cpuFr > 0 Then
dResult = QueryPerformanceCounter(dStopTime)
If dStartCount = 0 Then dStartCount = m_StartTime
dResult = (dStopTime - dStartCount) / m_cpuFr * 1000
Else
If dStartCount = 0 Then dStartCount = m_StartTime
dResult = dStopTime - dStartCount
End If
dwMilliseconds = dResult
End Function

' '延时函数' 毫秒
Public Sub Delay(DelayNum As Long)
Dim Ctr1,Ctr2,Freq As Currency
Dim Start As Long ',Stime2 As Single

If QueryPerformanceFrequency(Freq) Then
'支持高精度时
QueryPerformanceCounter Ctr1
Do
Sleep 1
DoEvents
QueryPerformanceCounter Ctr2
Loop While (Ctr2 - Ctr1) / Freq * 1000 < DelayNum
Else
Start = timeGetTime
Do While timeGetTime < Start + DelayNum
Sleep 1
DoEvents
Loop
End If

End Sub