首页 > VBA > 完整功能的VBA Timer类

完整功能的VBA Timer类

2010年7月2日
评论 发表评论

VB中的Timer控件提供了很好的计时器功能，VBA的原始功能中没有包括Timer控件，取而代之的是Application.OnTime方法，但是在定时重复运行某个过程的情况下OnTime方法使用并不太方便。

简单的API Timer函数

使用API函数同样可以实现类似的OnTime功能，并且可以方便的循环运行指定的程序。只需要两个简单的API函数SetTimer和KillTimer。

Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, _
                        ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
 
Public lTimerID As Long
 
Sub StartTimer(lDuration As Long)
    If lTimerID = 0 Then
        lTimerID = SetTimer(0&, 0&, lDuration, AddressOf OnTime)
    Else
        Call StopTimer
        lTimerID = SetTimer(0&, 0&, lDuration, AddressOf OnTime)
    End If
End Sub
Sub StopTimer()
    KillTimer 0&, lTimerID
End Sub
Sub OnTime()
    ' 计时器触发后运行的代码放在这
    ' ...
    Cells(1, 1) = Now
End Sub

示例下载：Box | SkyDrive

单个事件的Timer类

我们也可以用这两个API函数创建一个类来完全模拟VB中Timer控件的方法，同时实现事件触发。这样做有一个困难，在类模块中不能使用AddressOf函数。一种方法是利用标准模块来获取回调函数的地址然后再类模块中调用。
创建一个名称为clsTimer的类模块，代码如下：

Option Explicit
 
Private Declare Function SetTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long, _
                        ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
 
Private bEnable As Boolean
Private lDuration As Long
Private lTimerId As Long
 
Public Event Timer()
 
Public Property Let Enabled(ByVal vData As Boolean)
    bEnable = vData
    If bEnable = True Then
        StartTimer
    Else
        EndTimer
    End If
End Property
 
Public Property Get Enabled() As Boolean
    Enabled = bEnable
End Property
 
Public Property Let Interval(ByVal vData As Long)
    If vData < 0 Then vData = 0
    lDuration = vData
    If lDuration > 0 And bEnable = True Then
        EndTimer
        StartTimer
    End If
End Property
 
Public Property Get Interval() As Long
    Interval = lDuration
End Property
 
Private Sub Class_Initialize()
    bEnable = False
    lDuration = 0
    lTimerId = 0
End Sub
 
Private Sub Class_Terminate()
    EndTimer
    bEnable = False
    lDuration = 0
    lTimerId = 0
End Sub
 
Friend Sub cRaiseEvent(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lEventID As Long, ByVal dwTime As Long)
    If lEventID = lTimerId Then
        RaiseEvent Timer
    End If
End Sub
 
Private Sub StartTimer()
    If bEnable = True And lDuration > 0 Then
        lTimerId = SetTimer(0&, 0&, lDuration, GetAddressof(Me))
    End If
End Sub
 
Private Sub EndTimer()
    If lTimerId Then
        KillTimer 0&, lTimerId
        lTimerId = 0
    End If
End Sub

然后创建一个标准模块，代码如下：

Public modTimer As clsTimer
 
' 获取Timer Callback函数的地址
Public Function ReturnAddress(lpAddress As Long) As Long
    ReturnAddress = lpAddress
End Function
 
' Timer callback函数
Public Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    Call modTimer.cRaiseEvent(hwnd, uMsg, idEvent, dwTime)
End Sub
 
Public Function GetAddressof(myTimer As clsTimer) As Long
    Set modTimer = myTimer
    GetAddressof = ReturnAddress(AddressOf TimerProc)
End Function

要使用类模块的事件，只能在工作表或窗体这些类模块中调用clsTimer类。声明时需要使用WithEvents。

Private WithEvents cTimer1 As clsTimer

这个方法在只有一个clsTimer类实例时能很好的运行，但是当创建两个实例时，只有第二个实例的事件可以触发（不知道是不是类模块的代码写得不对或者还是其它原因，应该和标准模块中的回调函数TimerProc的地址有关，不同的类实例对应的这个回调函数的地址是一样的，这样可能导致始终只有最后一个声明的类实例能触发事件）。
示例下载：Box | SkyDrive

完整功能的Timer类

EH的Joforn发了一个挖雷的游戏，完全模拟Windows自带挖雷游戏的功能，里面使用了Paul Caton的类模块Call Back函数。使用这个类模块CallBack函数，可以在类模块中实现AddressOf函数的功能，因此可以实现多个clsTimer类实例的事件触发。

新的clsTimer类实现了和VB中Timer控件完全一样的功能。
属性：
Enabled：Boolean类型；设为True，启动计时器；设为False，则关闭计时器，默认为False。
Interval：Long类型；计时器间隔时间，单位为毫秒，默认为0。
事件：
Timer

示例下载：Box | SkyDrive

注意：使用以上的类模块，切记在退出Excel工作簿之前关闭clsTimer类，否则会导致Excel崩溃。

No related posts.

以上关联文章由 Yet Another Related Posts Plugin 提供支持。

VBA , ,

  1. 向東
    2010年7月2日17:40 | #1
    回复 | 引用

    很详细，学习。

  1. 目前还没有任何 trackbacks 和 pingbacks.

使用腾讯微博登陆

使用新浪微博登陆