Building the Right Environment to Support AI, Machine Learning and Deep Learning
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?
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