VB 精确的定时与计时

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