可替代VB自带的Timer控件的Timer类

 

(声明：魏滔序原创，转贴请注明出处。)
用这个类可以替代VB自带的Timer控件，这样就不用在无窗体的项目中仅为了使用Timer而多加一个窗体了。我一般用在ActiveX exe中用来分离系统控制权，用Timer的好处是避免控制权死锁，这样也就模拟出了多线程(实际上是多进程)，能给用户更好的体验。代码如下：

标准模块(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