|
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 （编辑：李大同）
【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!
|
