CAD

开发平台：

VBA

Timer.cls：源码内容

							VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Timer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
' bEnable变量用于控制定时事件的状态，True表示启动定时事件，False表示停止定时事件
Private bEnable As Boolean      ' 当前定时器是否可用
Private intervalTime As Long    ' 间隔的时间（以毫秒为单位）
' Timer事件是一个每隔固定秒数自动触发的事件，该秒数由Interval属性控制
Public Event Timer()
Private Sub Class_Terminate()
    bEnable = False
End Sub
' 默认情况下，定时器没有被启动，时间间隔为1000毫秒
Private Sub Class_Initialize()
    bEnable = False
    intervalTime = 1000
End Sub
Public Property Get Enabled() As Boolean
    Enabled = bEnable
End Property
Public Property Let Enabled(ByVal vNewValue As Boolean)
    bEnable = vNewValue
    
    ' 用GetTickCount函数返回从系统开始运行经过的毫秒数
    Dim startTime As Long
    startTime = GetTickCount
    If intervalTime < 1 Then
        MsgBox "Interval属性的值必须是1～32767之间的整数", , "错误"
        Exit Property
    End If
    ' 用循环结构重复触发Timer事件
    Do
        ' 如果定时器已经被关闭，退出循环
        If Not bEnable Then Exit Do
        
        If GetTickCount >= startTime + Interval Then
            startTime = GetTickCount
            RaiseEvent Timer
        End If
        ' 在循环过程中，用DoEvents函数将控制权转让给操作系统，这样可以实现后台运行定时事件的效果
        DoEvents
    Loop
End Property
Public Property Get Interval() As Long
    Interval = intervalTime
End Property
Public Property Let Interval(ByVal vNewValue As Long)
    intervalTime = vNewValue
End Property

						