Extended Timer Control - Intervals greater than 60000+ milliseconds

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 are the pitfalls? Let's 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 two 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's create the TimerX (UserControl) properties and form. Mainly, we need two 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

Next, add declaration for SetTimer and KillTimer function with API Viewer Add-in.

Let's 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 for 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. Simple, isn't it?

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

Downloads

download zipped project file (11k)