VB 纯代码实现Timer控件的功能

本博客有一篇类似的文章《VB 中运用 TimeSetEvent 代替 Timer 控件》与这篇不同。
本篇展示了另外两种方法，具体如下文所示。

方法1：
　　用这个类可以替代VB自带的Timer控件，这样就不用在无窗体的项目中仅为了使用Timer而多加一个窗体了。我一般用在ActiveX exe中用来分离系统控制权，用Timer的好处是避免控制权死锁，这样也就模拟出了多线程(实际上是多进程)，能给用户更好的体验。代码如下：
标准模块(mTimer.bas)

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.bas)

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

方法2：
用SetTimer函数定义一个ID,并标志一个触发时间(以MS为单位)和回调函数地址.
当指定的触发时间到了,系统就会调用那个指定的回调函数,并以你在SetTimer时定义的ID为参数,这样就可以区别多个定时器了.
当不需要使用某个定时器时,就使用KillTimer函数把指定ID的定时器干掉就可以了.
窗体代码：

Option Explicit

Const GWL_WNDPROC = (- 4 )

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( ByVal hWnd As Long , ByVal nIndex As Long , ByVal dwNewLong As Long ) As Long

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 Sub Form_Load()
glngFuncAdd = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc_TimerTest)
Call SetTimer(hWnd, TIMERID, 500 , 0 &)
End Sub

Private Sub Form_QueryUnload(Cancel As Integer , UnloadMode As Integer )
If glngFuncAdd > 0 Then Call SetWindowLong(hWnd, GWL_WNDPROC, glngFuncAdd)
Call KillTimer(hWnd, TIMERID)
End Sub

模块代码：

Option Explicit

Const WM_TIMER = &H113

Public Const TIMERID = &H100 '自定义Timer的ID号

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( ByVal lpPrevWndFunc As Long , ByVal hWnd As Long , ByVal Msg As Long , ByVal wParam As Long , ByVal lParam As Long ) As Long

Public glngFuncAdd As Long

Public Function WndProc_TimerTest( ByVal hWnd As Long , ByVal wMsg As Long , ByVal wParam As Long , ByVal lParam As Long ) As Long
If wMsg = WM_TIMER Then
If wParam = TIMERID Then
Debug.Print Timer
End If
End If

WndProc_TimerTest = CallWindowProc(glngFuncAdd, hWnd, wMsg, wParam, lParam)
End Function