Just paste this source code into a class module called cTimer and include it in your project.
'----------------------------------------------------------------------
'
' Class Name: cTimer
' Written By: C&D Programming Corp.
' Create Date: 6/98
' Copyright: Copyright 1998 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
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 mlCallBackProc As Long ' The address of the call back procedure to use
Private mlInterval As Long ' Interval to use for the timer
Private mlTimerID As Long ' Internal timer id, 0 when timer is disabled
'
' This had to be treated a little different because VB does not seem to
' support passing the AddressOf a function as a property value. So, we
' just "almost" simulate it by creating a subroutine to get the value.
'
Public Sub CallBackProc(lCallBackProc As Long)
mlCallBackProc = lCallBackProc
End Sub
Public Sub CallBackProc(lCallBackProc As Long)
Public Property Let Interval(lInterval As Long)
Public Property Let Interval(lInterval As Long)
On Error GoTo Handler
mlInterval = lInterval
If Enabled Then ' If it currently ticking, update the timer.
Enabled = False ' stop timer
Enabled = True ' restart timer
End If
Exit Property
Handler:
Err.Raise Err.Number, Err.Source, Err.Description
End Property
Public Property Get Interval() As Long
Interval = mlInterval
End Property
Public Property Get Enabled() As Boolean
Enabled = (mlTimerID <> 0)
End Property
Public Property Let Enabled(bEnabled As Boolean)
On Error GoTo Handler
If bEnabled Then ' if we want to turn it on...
If Enabled Then ' if it is already ticking, turn it off
StopTimer mlTimerID
End If
mlTimerID = StartTimer(Interval, mlCallBackProc)
Else ' we want to turn it off
If Enabled Then ' if it is not already ticking, skip the stop
StopTimer mlTimerID
mlTimerID = 0 ' makes this timer disabled (see Enabled Get property)
End If
End If
Exit Property
Handler:
Err.Raise Err.Number, Err.Source, Err.Description
End Property
Private Sub Class_Terminate()
Enabled = False ' make sure we disable this timer on close!
End Sub
'
' This routine starts a system level timer and calls the callback routine
' you pass as TimeCallback. A sample call might look something like this:
'
' StartTimer 1000, MyCallBack
'
' MyCallBack will need to be defined like the SampleTimerProc is shown
' below
'
' The Interval is in milliseconds and can be as large as 2,147,483,647, which
' is many days.
'
'
Private Function StartTimer(ByVal Interval As Long, TimerCallback As Long) As Long
Dim lTimerID As Long
lTimerID = SetTimer(0, 0, Interval, TimerCallback)
If lTimerID = 0 Then
Err.Raise 1, "StartTimer", "Could not start the timer."
Else
StartTimer = lTimerID
End If
End Function
'
' This routine will stop a timer that was started with StartTimer. It is
' very critical that you stop any timer before your program ends. If you
' do not stop the timer, you risk crashing Visual Basic or your application.
'
'
Private Sub StopTimer(TimerID As Long)
Dim lTimerID As Long
lTimerID = KillTimer(0, TimerID)
If lTimerID = 0 Then
Err.Raise 1, "StopTimer", "Could not stop the timer."
End If
End Sub
'
' This is a sample callback procedure
'
Private Sub SampleTimerProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long)
' Do your stuff here
End Sub