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

lyserver 2009-05-27 11:59:10
加精
在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
...全文
641 29 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
29 条回复
切换为时间正序
请发表友善的回复…
发表回复
颖哥儿 2010-06-02
  • 打赏
  • 举报
回复
呵呵,谢谢分享
Www_XSimon_cN 2010-04-10
  • 打赏
  • 举报
回复
强大,我很佩服,到底是怎样做到可以自动重复运行的呢?
dinner620 2010-02-25
  • 打赏
  • 举报
回复
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 2010-02-25
  • 打赏
  • 举报
回复

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


学习一下,呵呵
红叶哥 2009-06-26
  • 打赏
  • 举报
回复
支持開源
VIVI0622 2009-06-23
  • 打赏
  • 举报
回复
您知道在VB中怎么把采集到的数据实时绘制成曲线么?我看了很多程序,都不知道怎么把里面的函数变成信号发生器发出来的数据
jfj4634 2009-05-28
  • 打赏
  • 举报
回复
学习了
simon__sun 2009-05-28
  • 打赏
  • 举报
回复
路过,顶一下
dengnansky 2009-05-28
  • 打赏
  • 举报
回复
顶起!
zhuhuofong 2009-05-28
  • 打赏
  • 举报
回复
顶起
gentlebrother 2009-05-28
  • 打赏
  • 举报
回复
mark
tongnaifu 2009-05-28
  • 打赏
  • 举报
回复
学习
vbman2003 2009-05-27
  • 打赏
  • 举报
回复
顶...
SYSSZ 2009-05-27
  • 打赏
  • 举报
回复
学习了!
陌上花花 2009-05-27
  • 打赏
  • 举报
回复
感谢楼主分享
m60a1 2009-05-27
  • 打赏
  • 举报
回复
make!!!
神马都能聊 2009-05-27
  • 打赏
  • 举报
回复
呵呵,类的AddressOf啊,顶
supergreenbean 2009-05-27
  • 打赏
  • 举报
回复
顶起了
crskyp 2009-05-27
  • 打赏
  • 举报
回复
mark
lyserver 2009-05-27
  • 打赏
  • 举报
回复
[Quote=引用 15 楼 myjian 的回复:]
顶起.

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

http://www.cnblogs.com/pctgl/articles/1352916.html
[/Quote]
向PctGL学习!
加载更多回复(9)

743

社区成员

发帖
与我相关
我的任务
社区描述
VB 版八卦、闲侃,联络感情地盘,禁广告帖、作业帖
社区管理员
  • 非技术类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧