(声明:魏滔序原创,转贴请注明出处。)
用这个类可以替代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
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