【分享】在VB的类模块中使用计时器

[lyserver]

在CSDN的VB论坛里呆了一年，交了不少朋友，受到了不少启发，非常感谢大家，同时也为自己在答问时错误的解答而向大家致歉。俺原本想在VB版里混上两颗星就算了，现在看来离目标不远了，所以散分，并把自己写的一个在VB的类模块中使用计时器的代码贴出来，谈不上分享，只供大家指正：

一、类模块代码如下：

Option Explicit
'* ******************************************** *
'*  模块名称：Timer.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 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
Private Sub Class_Initialize()
    m_Interval = 0
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, GetFuncAddr(8))
    End If
End Property

Private Function GetFuncAddr(ByVal IndexOfFunc As Long) As Long
    Static AsmCode(33) As Byte
    Dim pThis As Long, pVtbl As Long, pFunc As Long
    
    pThis = ObjPtr(Me)
    CopyMemory pVtbl, ByVal pThis, 4
    CopyMemory pFunc, ByVal pVtbl + (6 + IndexOfFunc) * 4, 4
    AsmCode(0) = &H55
    AsmCode(1) = &H8B: AsmCode(2) = &HEC
    CopyMemory AsmCode(3), &H1475FF, 3
    CopyMemory AsmCode(6), &H1075FF, 3
    CopyMemory AsmCode(9), &HC75FF, 3
    CopyMemory AsmCode(12), &H875FF, 3
    AsmCode(15) = &HB9
    CopyMemory AsmCode(16), pThis, 4
    AsmCode(20) = &H51
    AsmCode(21) = &HE8
    CopyMemory AsmCode(22), pFunc - VarPtr(AsmCode(21)) - 5, 4
    AsmCode(26) = &H8B: AsmCode(27) = &HE5
    AsmCode(28) = &H5D
    AsmCode(29) = &HC2
    CopyMemory AsmCode(30), 16, 4
    GetFuncAddr = VarPtr(AsmCode(0))
End Function

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

二、调用代码如下：

Dim m_tm As Timer

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

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

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

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

[lyserver]

[Quote=引用 15 楼 myjian 的回复:]
顶起.

我来转一下PctGL的另一种取类函数地址的方法:

http://www.cnblogs.com/pctgl/articles/1352916.html
[/Quote]
向PctGL学习!

[crskyp]

mark

[supergreenbean]

顶起了

[神马都能聊]

呵呵,类的AddressOf啊,顶

[m60a1]

make!!!

[陌上花花]

感谢楼主分享

[SYSSZ]

学习了!

[vbman2003]

顶...

[tongnaifu]

学习

[gentlebrother]

mark

[zhuhuofong]

顶起

[dengnansky]

顶起!

[simon__sun]

路过，顶一下

[jfj4634]

学习了

[VIVI0622]

您知道在VB中怎么把采集到的数据实时绘制成曲线么？我看了很多程序，都不知道怎么把里面的函数变成信号发生器发出来的数据

[红叶哥]

支持開源

[dinner620]

Dim m_tm As Timer

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

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

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

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


学习一下,呵呵

[dinner620]

Dim m_tm As Timer

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

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

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

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

[Www_XSimon_cN]

强大,我很佩服,到底是怎样做到可以自动重复运行的呢?

[颖哥儿]

呵呵，谢谢分享