用这个类可以替代VB自带的Timer控件

导读：
　　用这个类可以替代VB自带的Timer控件，这样就不用在无窗体的项目中仅为了使用Timer而多加一个窗体了。我一般用在ActiveX exe中用来分离系统控制权，用Timer的好处是避免控制权死锁，这样也就模拟出了多线程(实际上是多进程)，能给用户更好的体验。代码如下：
　　想直接使用的请到这里下载：http://www.chenoe.com/developer/library/timer.dll
　　 标准模块(mTimer):
　　Option Explicit
　　Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
　　Public TimerColl As New VBA.Collection
　　Public Sub TimeProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
　　Dim Timer As Timer, lpTimer As Long
　　lpTimer = TimerColl("ID:" &idEvent)
　　CopyMemory Timer, lpTimer, 4&
　　Timer.PulseTimer
　　CopyMemory Timer, 0&, 4&
　　End Sub
　　 类模块(Timer):
　　Option Explicit
　　Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
　　Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
　　Private m_TimerID As Long
　　Private m_Interval As Long
　　Private m_Enabled As Boolean
　　Public Tag As Variant
　　Public Event Timer()
　　Public Property Get Interval() As Long
　　Interval = m_Interval
　　End Property
　　Public Property Let Interval(ByVal Value As Long)
　　m_Interval = Value
　　Enabled = m_Enabled
　　End Property
　　Public Property Get Enabled() As Boolean
　　Interval = m_Enabled
　　End Property
　　Public Property Let Enabled(ByVal Value As Boolean)
　　If Value Then
　　m_Enabled = StartTimer
　　Else
　　Call StopTimer
　　End If
　　End Property
　　Private Function StartTimer() As Boolean
　　If m_TimerID = 0 Then
　　If m_Interval >0 Then
　　m_TimerID = SetTimer(0, 0, m_Interval, AddressOf TimeProc)
　　If m_TimerID <>0 Then
　　TimerColl.Add ObjPtr(Me), "ID:" &m_TimerID
　　StartTimer = True
　　End If
　　Else
　　m_Enabled = True
　　End If
　　End If
　　End Function
　　Friend Sub PulseTimer()
　　RaiseEvent Timer
　　End Sub
　　Private Sub StopTimer()
　　If m_TimerID <>0 Then
　　KillTimer 0, m_TimerID
　　TimerColl.Remove "ID:" &m_TimerID
　　m_TimerID = 0
　　m_Enabled = False
　　End If
　　End Sub
　　Private Sub Class_Terminate()
　　Call StopTimer
　　End Sub
　　 使用方法：
　　Private WithEvents Timer1 As Timer
　　Private Sub Form_Load()
　　Set Timer1 = New TimerLib.Timer
　　Timer1.Interval = 1000
　　Timer1.Enabled = True
　　End Sub
　　Private Sub Timer1_Timer()
　　Debug.Print Now
　　End Sub
　　
　　Trackback: http://tb.blog.csdn.net/TrackBack.aspx?PostId=1389761

本文转自
http://blog.csdn.net/zou_seafarer/archive/2006/11/17/1389761.aspx