用这个类可以替代VB自带的Timer控件

最新推荐文章于 2024-06-26 16:32:55 发布

ZOU_SEAFARER

最新推荐文章于 2024-06-26 16:32:55 发布

阅读量1.8k

点赞数

分类专栏： VB 文章标签： timer vb function 多线程 user exe

本文链接：https://blog.csdn.net/zou_seafarer/article/details/1389761

版权

VB 专栏收录该内容

67 篇文章 0 订阅

订阅专栏

用这个类可以替代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