用这个类可以替代VB自带的Timer控件
2011-04-30 22:11
267 查看
原文地址:http://hi.baidu.com/qqool/blog/item/2bce35fa5488e21aa9d31167.html
用这个类可以替代VB自带的Timer控件,这样就不用在无窗体的项目中仅为了使用Timer而多加一个窗体了。我一般用在ActiveX exe中用来分离系统控制权,用Timer的好处是避免控制权死锁,这样也就模拟出了多线程(实际上是多进程),能给用户更好的体验。代码如下:
想直接使用的请到这里下载:http://www.chenoe.com/developer/library/timer.dll
标准模块(mTimer):
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):
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
用这个类可以替代VB自带的Timer控件,这样就不用在无窗体的项目中仅为了使用Timer而多加一个窗体了。我一般用在ActiveX exe中用来分离系统控制权,用Timer的好处是避免控制权死锁,这样也就模拟出了多线程(实际上是多进程),能给用户更好的体验。代码如下:
想直接使用的请到这里下载:http://www.chenoe.com/developer/library/timer.dll
标准模块(mTimer):
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):
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
相关文章推荐
- 用这个类可以替代VB自带的Timer控件
- 用这个类可以替代VB自带的Timer控件
- 可替代VB自带的Timer控件的Timer类
- 可替代VB自带的Timer控件的Timer类
- 可替代VB自带的Timer控件的Timer类
- 可替代VB自带的Timer控件的Timer类
- HTTP服务端接口模拟工具-HttpServerMockTool 1 工具功能介绍 这个工具可以通过简单的配置达到快速模拟第三方HTTP服务端接口的作用,替代以前要手写servlet代码再放到to
- 笔记本自带网卡坏了可以使用其他的替代
- 利用windows自带的gzip.dll进行压缩(VB版本)可以修改为VC
- [VB.NET]这个语句还可以怎样写????????
- Firebug报错:已阻止交叉源请求:同源策略不允许读取XXX上的远程资源。可以将资源移动到相同的域名上或者启用 CORS 来解决这个问题
- 【推荐】腾讯android镜像(做Android开发的得好好利用下这个网站,国内的大公司还是可以滴……)
- Modify HTML title tag 可以从这个例子得到启发如何修改DOM的元素
- 有什么好的方案可以替代抽屉式导航?
- 大数据早报:微软宣布推出新Azure机器学习工具 这个机器人可以像人类一样自然地行走(9.27)
- 会玩弹珠也可以拿来炫了?是的,这个技能燃爆了!
- FreeOTP可以用作谷歌认证的替代
- 非常奇怪 谁可以帮我下 这个问题怎么不能运行啊
- VB中创建可以输出函数的DLL
- 文章来源:VRAR123网址导航_NEWS 瑞典Gleechi 企业里智能VR专家正在研究一个系统,这个系统主要是增强VR游戏的人机互动开发;也就是说游戏玩家可以通过平台提供的实时页面,通过自