在VB的类模块中使用定时器

    长久以来，由于不能直接获得VB类成员函数指针，因为无法在VB的类模块中直接使用定时器控件或定时器API，基于俺编写的获得类成员函数指针的函数，俺编写了这个带定时器功能的类，希望给朋友们一些启发。

    一、新建一个类，类名称为clsTimer，类代码如下：

Option Explicit'* ******************************************** *'* 模块名称：clsTimer.cls'* 功能：在VB类模块中使用计时器'* 作者：lyserver'* ******************************************** *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 LongPrivate Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As LongDim m_idTimer As LongDim m_Enabled As BooleanDim m_Interval As LongDim m_lTimerProc As LongPrivate Sub Class_Initialize() m_Interval = 0 m_lTimerProc = GetClassProcAddr(8)End SubPrivate Sub Class_Terminate() If m_idTimer <> 0 Then KillTimer 0, m_idTimerEnd SubPublic Property Get Interval() As Long Interval = m_IntervalEnd PropertyPublic Property Let Interval(ByVal New_Value As Long) If New_Value >= 0 Then m_Interval = New_ValueEnd PropertyPublic Property Get Enabled() As Boolean Enabled = m_EnabledEnd PropertyPublic 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 IfEnd PropertyPrivate 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))End FunctionPrivate Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long) Debug.Print "类模板中的计时器：", uMsg, idEvent, dwTimeEnd Sub

    二、测试代码如下：

Dim m_tm As clsTimerPrivate Sub Form_Load() Set m_tm = New clsTimerEnd SubPrivate Sub Form_Unload(Cancel As Integer) Set m_tm = NothingEnd SubPrivate Sub Command1_Click() m_tm.Interval = 1000 m_tm.Enabled = TrueEnd SubPrivate Sub Command2_Click() m_tm.Enabled = FalseEnd Sub