TimerX control (Timer eXtender)

Have you tried to set Interval property for a timer control with more than 65535? Have you needed to raise a timer event after more than 1 minute?

The maximun value for interval of timer control is about 65 seconds. In many programs this is a decent value, but it's possible to want a larger interval. How do you work-around this?

Of course, a solution is to use a counter in Timer event and execute your code after the n appearance of the event and to use the n-th part of the real interval as value for Interval property, like below (for n = 10 times):

Private Sub Timer1_Timer()
Static nTimes As Long
If nTimes = 10 Then
' Execute
nTimes = 0
End If
End Sub

What the pitfalls are? Let say we have a time consuming operation and the programs receive a few WM_TIMER messages. All these messages will be grouped together and the window procedure of the program receive only one. Let say this message is processed after double interval we expect. Then will raise the Timer event. Even we'd like to execute the code is only the first time when Timer event show up, although it was a few WM_TIMER messages. In an intense use of CPU we will wait n times more. It could be more simply to execute the code for the first appearance of the event whenever it happen.

The best way is to use API Windows to create and destroy a timer in an UserControl which will raise a Timer event. Similar with timer control but you can use a larger interval for raising the event.

First, create a new project (EXE) and add a module and a user control (TimerX from Timer eXtender).

We have 2 problems. For timer created by API we need a callback function which sould be in a module. Being in a module, we need a work-around to raise an event from that callback function in the user control.

Let create the TimerX (UserControl) properties and form. Mainly, we need 2 properties (as timer control): Enable and Interval (read/write both). For this we have:

Public Property Get Enable() As Boolean
'...
End Property

Public Property Let Enable(bValue As Boolean)
' ...
End Property

Public Property Get Interval() As Long
' ...
End Property

Public Property Let Interval(i As Long)
' ...
End Property

For UserControl form we put (at design time) an Image control (Image1) with Picture property to TimerX.bmp (save the following picture as TimerX.bmp

), Stretch = True and ToolboxBitmap to TimerX.bmp, too. Also for UserControl, we have BorderStyle = 1 - Fixed Single and InvisibleAtRuntime will be true to hide the control at runtime on the parent form (like Timer control).
Then, we add declaration for SetTimer and KillTimer function with API Viewer Add-in.

Let see the code for UserControl:

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

Public Event Timer()

Private bEnable As Boolean	'Enable/disable the TimerX
Private nInterval As Long	'Time interval for raise the event
Private nID As Long		'Timer ID

Public Property Get Interval() As Long
Interval = nInterval
End Property

Public Property Let Interval(i As Long)
If Ambient.UserMode Then
'Run
    If bEnable Then
        If nID <> 0 Then
            If i <= 0 Then
		'setting the interval at 0 will destroy the timer
                KillTimer 0, nID
                Set xT = Nothing
                nID = 0
            Else
		'delete the old timer and create a new one
                KillTimer 0, nID
                nID = SetTimer(0, 0, i, AddressOf fTimerCallBack)
            End If
        End If
    Else
        'simply change the interval if not exist any timer
	nInterval = IIf(i > 0, i, 0)
    End If
Else
'Design
'isn't any timer running
nInterval = IIf(i > 0, i, 0)
End If
End Property

Public Property Get Enable() As Boolean
Enable = bEnable
End Property

Public Property Let Enable(bValue As Boolean)
If bValue Then
    If nID = 0 And nInterval > 0 Then
	'create a new timer
        nID = SetTimer(0, 0, nInterval, AddressOf fTimerCallBack)
        Set xT = Me
    End If
Else
    If nID <> 0 Then
	'delete the timer
        KillTimer 0, nID
        Set xT = Nothing
        nID = 0
    End If
End If
bEnable = bValue
End Property


Private Sub UserControl_InitProperties()
bEnable = False
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
bEnable = PropBag.ReadProperty("Enable", False)
nInterval = PropBag.ReadProperty("Interval", 0)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("Enable", bEnable, False)
Call PropBag.WriteProperty("Interval", nInterval, 0)
End Sub

Private Sub UserControl_Resize()
'all the time resize TimerX control at these values (28 x 28)
UserControl.Size 28 * Screen.TwipsPerPixelX, 28 * Screen.TwipsPerPixelY
End Sub

Private Sub UserControl_Terminate()
If nID <> 0 Then
    KillTimer 0, nID
    nID = 0
    Set xT = Nothing
End If
End Sub

Friend Sub RaiseTimer()
RaiseEvent Timer
End Sub

I think the code speaks itself. For the SetTimer function we need the address for a callback function (in a code module), named fTimerCallback.
The only problem could be the RaiseTimer() function. We declare this function as Friend to be visible from code module but not public visible. From here we will raise the Timer event.

Code module is simply, too:

Public xT As TimerX

Public Function fTimerCallBack(ByVal lnghwnd As Long, _
		ByVal lngMessage As Long, _
		ByVal wParam As Long, ByVal lParam As Long) As Long
xT.RaiseTimer
End Function

We have a reference to TimerX control (xT) and a callback function that will be called when we have WM_TIMER message from the timer we use. For raising TimerX's Timer event, we call RaiseTimer procedure of the TimerX, which will raise the event. Simply, isn't is?

Let use this control in a small program. The form looks like this:

The code for form is:

Dim x As Long

Private Sub Form_Load()
	Text1 = TimerX1.Interval
	Caption = "TimerX test (c) Ovidiu Crisan"
End Sub

Private Sub cmdClearList_Click()
	List1.Clear
End Sub

Private Sub cmdInterval_Click()
	TimerX1.Interval = CLng(Text1.Text)
End Sub

Private Sub cmdStartStop_Click()
	TimerX1.Enable = Not TimerX1.Enable
End Sub

Private Sub TimerX1_Timer()
	List1.AddItem "Count: " & x
	x = x + 1
	List1.ListIndex = List1.NewIndex
End Sub

Please, excuse my English mistakes and send your comment to me or visit my home page.

Ovidiu Crisan
Romania
Tekmetrics Certified Visual Basic Programmer