VB 版 (精华区)

发信人: hemanzi (黑冷之夜), 信区: VB
标  题: 关于三中定时器
发信站: 哈工大紫丁香 (2003年04月06日11:03:10 星期天), 站内信件

窗体中有三个command控件:
command1.caption="开始"
command2.caption="停止"
command3.caption="关闭"
一个时钟控件:用代码设置.
三个label:
label1.caption="时钟",对应 :text1控件
label2.caption="多媒体",对应 :text2控件 
label3.caption="频率法",对应 :text3控件 

窗体代码:
Option Explicit

Private Sub Command1_Click()
 Dim lagTick1 As LARGE_INTEGER
 Dim lagTick2 As LARGE_INTEGER
 Dim lTen As Long
   
   Command2.Enabled = True
   Command1.Enabled = False
   iCountStart = 10 '60
   lmmCount = 10 '60
   TimerCount = 10 '60
   actTime1 = GetTickCount
   lTimeID = timeSetEvent(10, 0, AddressOf TimeProc, 1, 1)
   Timer1.Enabled = True
   
   lTen = 10 * lMSFreq
   Call QueryPerformanceCounter(lagTick1)
   While iCountStart > 0
       Call QueryPerformanceCounter(lagTick2)
       '如果时钟震动次数超过10毫秒的次数则刷新Text1的显示
       If lagTick2.lowpart - lagTick1.lowpart > lTen Then
           lagTick1 = lagTick2
           iCountStart = iCountStart - 0.01
           Text1.Text = Format$(iCountStart, "00.00")
       End If
       DoEvents
   Wend
End Sub

Private Sub Command2_Click()
    EndCount
    Me.Command3.Enabled = True
End Sub

Private Sub Command3_Click()
End
End Sub

Private Sub Form_Load()
Dim lim As LARGE_INTEGER
   
   Text1.Text = "60.00"
   Text2.Text = "60.00"
   Text3.Text = "60.00"
   Command1.Caption = "开始倒记时"
   Command2.Caption = "停止记时"
   Command2.Enabled = False
   
   '获得系统板上时钟频率
   QueryPerformanceFrequency lim
   
   '将频率除以1000就的出时钟1毫秒震动的次数
   lMSFreq = (lim.highpart * 2 ^ 16) \ 1000 + lim.lowpart \ 1000
   Timer1.Interval = 10
   Timer1.Enabled = False

End Sub
Private Sub Timer1_Timer()
   TimerCount = TimerCount - 0.01
   Text3.Text = Format$(TimerCount, "00.00")
   If TimerCount <= 0 Then
       Timer1.Enabled = False
   End If
End Sub
模块代码:
Option Explicit
'频率法的类
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
'多媒体
Public Declare Function timeSetEvent Lib "winmm.dll" (ByVal uDelay As Long, By
Val _
       uResolution As Long, ByVal lpFunction As Long, ByVal dwUser As Long, _
       ByVal uFlags As Long) As Long
Public Declare Function timeKillEvent Lib "winmm.dll" (ByVal uID As Long) As L
ong
'得到实际时间
Public Declare Function GetTickCount Lib "kernel32" () As Long
Public lMSFreq As Long '每秒频率
Public TimerCount As Single '时间控件计时
Public lmmCount As Single '多媒体计时
Public lTimeID As Long '多媒体定时器的id号
Public actTime1 As Long '实际开始运行时间
Public actTime2 As Long '实际结束运行时间
Public iCountStart As Single '频率法计时
Dim iCount As Single
'timeSetEvent的回调函数
Sub TimeProc(ByVal uID As Long, ByVal uMsg As Long, ByVal dwUser As Long, _
   ByVal dw1 As Long, ByVal dw2 As Long)
   
   Form1.Text2.Text = Format$(lmmCount, "00.00")
   lmmCount = lmmCount - 0.01
   If lmmCount <= 0 Then
       EndCount
   End If
End Sub
Sub EndCount()
   iCount = iCountStart
   iCountStart = 0
   timeKillEvent lTimeID
   actTime2 = GetTickCount - actTime1
   With Form1
       .Command1.Enabled = True
       .Command2.Enabled = False
       .Timer1.Enabled = False
       
       .Text1 = "计数器记时" + Format$((10 - iCount), "00.00") + "  " _
               + "实际经过时间" + Format$((actTime2 / 1000), "00.00")
       .Text2 = "计数器记时" + Format$((10 - lmmCount), "00.00") + "  " _
               + "实际经过时间" + Format$((actTime2 / 1000), "00.00")
       .Text3 = "计数器记时" + Format$((10 - TimerCount), "00.00") + "  " _
               + "实际经过时间" + Format$((actTime2 / 1000), "00.00")
   End With
  
End Sub
需要说明的是:
程序表明:timer控件是不准确的,超过52毫秒(可能不准),就计不准时.
频率法:他是用机理是:如果时间到就执行(指所要定时执行的代码),
时间不到就空循环(不
计数),这样就要求执行的代码时间要小于定的时间,否则执行时间大于定时,那下一
个循环必执行代码,这就没得到定时.
多媒体:是最准的,但也是最耗cpu的,如执行的代码时间超过定时时间,就会出现鼠标移动缓
慢,死机现象.

代码不做一一解释,回调函数是固定的,有严格的定义,不可乱改.doevents函数可能带来一
些不可知的现象.
doevents函数:用于转让cpu,可用于中断do---loop等循环. 
说到这里:指出一个较好的中断do---loop的方法:
Option Explicit
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As 
Integer
Private Const VK_LBUTTON = &H1 '鼠标左键
Private Sub Command1_Click()
Dim flag As Boolean
flag = True
Do While flag
   If GetAsyncKeyState(VK_LBUTTON) < 0 Then
      Exit Do
   End If
Debug.Print Time
Loop
Me.Text1.Text = "中断"
End Sub
VK_LBUTTON可换成键盘(如esc), 到api浏览器,win32api.txt中的找(api类型选常数)
--

生涯懒立身,腾腾任我真.囊中三斤米,炉边一束薪.
谁问迷悟迹,可知名利尘.夜雨草奄门,双脚等闲伸.

※ 来源:·哈工大紫丁香 bbs.hit.edu.cn·[FROM: 202.118.235.70]