Mega Code Archive
Multi threaded timers
<![CDATA[
Ever added a TTimer to your application only to find that its event isn't being executed because the main VCL thread is busy?
Delphi Developer September 2000
--------------------------------------------------------------------------------
Copyright Pinnacle Publishing, Inc. All rights reserved.
--------------------------------------------------------------------------------
Will the Real Timer Please Execute?
Steve Zimmelman
Necessity is often the mother of invention, and this time was no exception. While I was working on some Microsoft Word/Excel integration, a problem arose when I was processing documents with the Visible property set to False. Word would display a dialog box (that the user couldn't see) and wait for a response. Well, needless to say this made the application appear as though it was hung. I needed a way to time the process and handle things, should they take too long. So I slapped a TTimer component on the form, set the interval for 1,000 (one second), and counted the number of times the timer event executed. Sounds good, right? Wrong! When the Word dialog box showed itself, it was using the main VCL thread, which in turn wasn't giving way to any other processes, including TTimer. So, once again, the application appeared as though it was hung.
The solution was to create a thread that could track the time no matter how busy the main VCL thread was. But creating a thread every time I needed this functionality didn't seem like the best solution from an object-oriented standpoint. So I created a new Timer component that would create and use its own internal thread and execute an event method at a specific interval.
The TThreadTimer component is the result. It's a simple subclass of TComponent that manages an internal thread. The thread is created and destroyed by the component. When the Enabled property is True, the thread is created, and when False, it's destroyed. I also wanted to make sure that the thread didn't get created while in design mode. So I checked the ComponentState before executing any methods:
Procedure TThreadTimer.SetEnabled(Value:Boolean);
Begin
If (Value <> FEnabled) Then Begin
FEnabled := Value ;
// Don't Create or Kill the thread unless
// the app is running.
If Not (csDesigning In ComponentState)
Then Begin
If FEnabled Then Begin
FTimerEventCount := 0 ;
FThread := TTheThread.Create(Self);
End Else Begin
KillThread ;
End;
End;
End;
End;
I used a method called KillThread to stop the thread from executing and free it. Before I can actually destroy the thread, I need to be sure that the associated event isn't in the middle of processing. If the thread was freed while the event was executing, an exception would be raised because the event would return to a thread that no longer existed. I handled this with a simple Boolean variable, FOnTimerEventInProgress, that got initialized to True before the timer event was executed, and switched to False just after it finished:
Procedure TThreadTimer.KillThread ;
Begin
Try
FEnabled := False ;
If (FThread <> Nil) Then Begin
// Wait for the OnTimerInterval Event to
// finish before terminating the thread.
While FThread.FOnTimerEventInProgress
Do Begin
Application.ProcessMessages ;
End;
FThread.Terminate ;
FThread.Free ;
End;
Finally
FThread := Nil ;
FTimerEventCount := 0 ;
End;
End;
Because the component encompasses a thread object, and the thread object needs to reference some of the component's properties and methods, I used the Create Constructor of the thread to capture a reference to its owner:
Constructor TTheThread.Create(AOwner:TThreadTimer);
Begin
FOnTimerEventInProgress := False ;
// We need to access some of the Owner's
// properties from the thread.
FOwner := AOwner ;
Inherited Create(False);
End;
The thread object itself is rather simple. It has a Create Constructor,an Execute, and an OnTimer method. The Execute method executes just after the Create Constructor, and remains active until the Execute method exits. I used the Terminated property to keep the thread alive until it's explicitly told to exit. Terminated is set to True when the thread's Terminate method is called. In the execute loop, I use a simple Sleep() to pause the thread and wait for the specified timer interval. I use Application.ProcessMessages to be sure the thread has all of the current processing information before executing the timer event. I included a property in the main component called SynchronizeEvent. This makes the TThreadTimer behave like a standard TTimer component, by synchronizing the event with the main VCL thread:
Procedure TTheThread.Execute ;
Begin
While Not Self.Terminated Do Begin
Application.ProcessMessages ;
Sleep(FOwner.Interval);
Application.ProcessMessages ;
If FOwner.SynchronizeEvent Then
Synchronize(OnTimer)
Else
OnTimer ;
End;
End;
Procedure TTheThread.OnTimer ;
Begin
Try
If Assigned(FOwner.FOnTimerInterval) Then Begin
If FOwner.Enabled Then Begin
FOnTimerEventInProgress := True ;
Inc(FOwner.FTimerEventCount);
FOwner.FOnTimerInterval(FOwner);
End;
End ;
Finally
FOnTimerEventInProgress := False ;
End;
End;
There are three essential pieces to the TThreadTimer component: the Thread, Interval, and the TimerEvent. As mentioned earlier, the thread is created and destroyed by the Enabled property. As soon as the thread is created, the timer is active and executes the OnTimerInterval event after the specified interval period has elapsed.
There's also a function called TimerEventCount—it does exactly what its name implies. It increments an integer each time the OnTimerInterval event is processed. This can be used to watch for potential time-outs. For example, you might have the interval set for 1,000 (one second), and the event trap set for TimerEventCount >= 60. So if the event executes 60 times, then a minute has gone by and you might need to handle something in the application. But remember, this timer is on a separate thread, so attempting to manipulate other VCL objects in the main thread might result in exceptions.
After creating the ThreadTimer object, it didn't take long to realize that the timer event would be unable to update any VCL objects while the main thread was busy. For instance, if you wanted to check a record pointer of a table while the table was being processed and display the results to a TLabel, you'd be out of luck. TLabel would wait until the main thread allowed it to update. So back to the proverbial drawing board once again.
I discovered that TCanvas, for the most part, doesn't use the main thread for updating. So I created a new label component called TCanvasLabel. TCanvasLabel is a subclass of TGraphicControl, and only uses the Canvas property for drawing.
I designed TCanvasLabel so it could be used as a Label and a ProgressBar. The properties Fill, FillPercent, and FillColor are used to paint a portion of the label's canvas a different color. The Paint method is used to display the contents of the label:
Procedure TCanvasLabel.Paint ;
Var
Rect : TRect ;
fLeft,fTop : Integer ;
Begin
// AutoSize should be set to False when the label
// is used in a thread other than the main
// VCL thread.
If AutoSize Then
SetSize ;
Rect := ClientRect ;
// Paint label with primary background color.
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := Self.Color;
Canvas.FillRect(ClientRect);
If (FillPercent > 0) And FFill Then Begin
// calculate the fill percentage.
Rect.Right := Trunc((Rect.Right *
(FillPercent / 100))) ;
Canvas.Brush.Color := FillColor;
Canvas.FillRect(Rect);
End ;
Canvas.Brush.Style := bsClear;
Case Alignment Of
taLeftJustify:
Begin
fLeft := 0 ;
End;
taRightJustify:
Begin
fLeft := ClientRect.Right -
Canvas.TextWidth(Caption) ;
End;
taCenter:
Begin
fLeft := Trunc((ClientRect.Right -
Canvas.TextWidth(Caption))/2);
End;
End;
Case Layout Of
tlTop: fTop := 0 ;
tlCenter:
fTop := Trunc((ClientRect.Bottom -
Canvas.TextHeight(Caption))/2);
tlBottom:
fTop := (Self.Height -
Canvas.TextHeight(Caption)) ;
End;
Canvas.TextOut(fleft,fTop,Caption);
// force the canvas to update itself.
Canvas.Refresh ;
End;
There are a couple of caveats you need to watch out for when using events that use threads:
The AutoSize property of TCanvasLabel should be set to False when running the application. Resizing the label uses the main VCL thread, so the label won't update.
Be sure not to include any standard VCL objects in your thread event without thoroughly testing them, or specifically creating them in code inside the thread.
A simple use of both these components can be found in the demo included in the accompanying file. The simple application demonstrates
the difference between a standard TTimer and the timer found in the TThreadTimer component.
The TTimer event updates a TLabel with the current time once every second. To create a busy process, the application appends 10,000 records in a For loop.
You'll notice that during the append process, the time display stops for the standard TTimer while the other labels are updated at their designated intervals.
]]>