在VB类模块中使用计时器

Option Explicit
'* ******************************************** *
'* 模块名称：clsTimer.cls
'* 功能：在VB类模块中使用计时器
'* ******************************************** *

Private Declare Sub CopyMemory Lib “kernel32” Alias “RtlMoveMemory” (Destination As Any, _
Source As Any, ByVal Length 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

Dim m_idTimer As Long
Dim m_Enabled As Boolean
Dim m_Interval As Long
Dim m_lTimerProc As Long

Public Event Timer()

Private Sub Class_Initialize()
m_Interval = 0
m_lTimerProc = GetClassProcAddr(8)
End Sub

Private Sub Class_Terminate()
If m_idTimer <> 0 Then KillTimer 0, m_idTimer
End Sub

Public Property Get Interval() As Long
Interval = m_Interval
End Property
Public Property Let Interval(ByVal New_Value As Long)
If New_Value >= 0 Then m_Interval = New_Value
End Property

Public Property Get Enabled() As Boolean
Enabled = m_Enabled
End Property
Public Property Let Enabled(ByVal New_Value As Boolean)
m_Enabled = New_Value
If m_idTimer <> 0 Then KillTimer 0, m_idTimer
If New_Value And m_Interval > 0 Then
m_idTimer = SetTimer(0, 0, m_Interval, m_lTimerProc)
End If
End Property

Private Function GetClassProcAddr(ByVal Index As Long, Optional ParamCount As Long = 4, Optional HasReturnValue As Boolean) As Long
Static lReturn As Long, pReturn As Long
Static AsmCode(50) As Byte
Dim i As Long, pThis As Long, pVtbl As Long, pFunc As Long

pThis = ObjPtr(Me)
CopyMemory pVtbl, ByVal pThis, 4
CopyMemory pFunc, ByVal pVtbl + (6 + Index) * 4, 4
pReturn = VarPtr(lReturn)

For i = 0 To UBound(AsmCode)
    AsmCode(i) = &H90
Next
AsmCode(0) = &H55
AsmCode(1) = &H8B: AsmCode(2) = &HEC
AsmCode(3) = &H53
AsmCode(4) = &H56
AsmCode(5) = &H57
If HasReturnValue Then
    AsmCode(6) = &HB8
    CopyMemory AsmCode(7), pReturn, 4
    AsmCode(11) = &H50
End If
For i = 0 To ParamCount - 1
    AsmCode(12 + i * 3) = &HFF
    AsmCode(13 + i * 3) = &H75
    AsmCode(14 + i * 3) = (ParamCount - i) * 4 + 4
Next
i = i * 3 + 12
AsmCode(i) = &HB9
CopyMemory AsmCode(i + 1), pThis, 4
AsmCode(i + 5) = &H51
AsmCode(i + 6) = &HE8
CopyMemory AsmCode(i + 7), pFunc - VarPtr(AsmCode(i + 6)) - 5, 4
If HasReturnValue Then
    AsmCode(i + 11) = &HB8
    CopyMemory AsmCode(i + 12), pReturn, 4
    AsmCode(i + 16) = &H8B
    AsmCode(i + 17) = &H0
End If
AsmCode(i + 18) = &H5F
AsmCode(i + 19) = &H5E
AsmCode(i + 20) = &H5B
AsmCode(i + 21) = &H8B: AsmCode(i + 22) = &HE5
AsmCode(i + 23) = &H5D
AsmCode(i + 24) = &HC3
GetClassProcAddr = VarPtr(AsmCode(0))
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

End Function

Private Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
RaiseEvent Timer
'Debug.Print “类模板中的计时器：”, uMsg, idEvent, dwTime
End Sub

'使用

Option Explicit
Public WithEvents Timer As clsTimer

Private Sub Form_Load()
Set Timer = New clsTimer
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set Timer = Nothing
End Sub

Private Sub Command1_Click()
Timer.Interval = 1000
Timer.Enabled = True
End Sub

Private Sub Command2_Click()
Timer.Enabled = False
End Sub

Private Sub Timer_Timer()
Debug.Print “Timer 事件”
End Sub