VB时钟

VB的时钟精度不高,而且在系统负荷很大的情况下延迟更大.为了减少时钟的延迟以及提高时钟的精度,笔者搜集到以下方法: 1:利用其他控件的事件去替代主时钟工作 如利用一个文本框的change事件去工作,主时钟的代码为: Private Sub Tmr_Main_Timer() Txt_Helper.Text = IIf(Timer1Helper.Text = ""," ","") End Sub 文本框change事件的代码为: Private Sub Txt_Helper_Change() 'Do Something You Want End Sub 2:利用两个API函数QueryPerformanceFrequency和QueryPerformanceCounter实现 使用方法如下: Type LARGE_INTEGER lowpart As Long highpart As Long End Type Public Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long Public Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long Private PlayFlag As Boolean Private MillSecond As Long Public Sub StartTimer() Dim lagTick1 As LARGE_INTEGER Dim lagTick2 As LARGE_INTEGER PlayFlag = True Call QueryPerformanceCounter(lagTick1) lagTick2 = lagTick1 While PlayFlag Call QueryPerformanceCounter(lagTick2) If lagTick2.lowpart - lagTick1.lowpart > lTen Then lagTick1 = lagTick2 'Do Something You Want End If DoEvents Wend End Sub Public Sub EndTimer() PlayFlag = False End Sub Public Sub SetSecond(newSecond As Long) MillSecond = newSecond End Sub 3:利用timeSetEvent实现(在独立线程中运行,精度很高,效果很好) Private Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As Long Private Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long,ByVal uResolution As Long,ByVal lpFunction As Long,ByVal dwUser As Long,ByVal uFlags As Long) As Long Private EventHandler As Long Private MillSecond As Long Public Sub StopEvent() timeKillEvent EventHandler EventHandler = 0 End Sub Public Sub Start() EventHandler = timeSetEvent(MillSecond,10,AddressOf TimeProc,1,1) End Sub Public Sub ChangeSecond(newSecond As Long) MillSecond = newSecond Call StopEvent Call Start End Sub Private Sub TimeProc(ByVal uID As Long,ByVal uMsg As Long,ByVal dw1 As Long,ByVal dw2 As Long) 'Do Something You Want End Sub