Solved

Threader timer

Posted on 2000-04-13
9
1,245 Views
Last Modified: 2007-10-18
I am using a threaded timer, and I have always wonder why, even with the priority set to Time Critical, I was not getting a constant response time (I am using the timer to display the number of seconds used for a public terminal).  I now suspect that this because of Synchronize in the following procedure (full component listed below as well). Question: Not much happens in the code that runs every second, so I would like to remove the Synchronize. When I do, it does not seem to be called every second. How do I remove the Synchronize?

Is there a better component I could use?


procedure TTimerThread.Execute;
begin
   repeat
      SleepEx(Interval, False);
      Synchronize(DoTimer);          
   until Terminated;
end;




unit ThdTimer;

interface

uses
  Windows, Messages, SysUtils, Classes,
  Graphics, Controls, Forms, Dialogs;

type
  TThreadedTimer = class;

  TTimerThread = class(TThread)
    OwnerTimer: TThreadedTimer;
    Interval: DWord;
    procedure Execute; override;
    procedure DoTimer;
  end;

  TThreadedTimer = class(TComponent)
  private
    FEnabled: Boolean;
    FInterval: Word;
    FOnTimer: TNotifyEvent;
    FTimerThread: TTimerThread;
    FThreadPriority: TThreadPriority;
  protected
    procedure UpdateTimer;
    procedure SetEnabled(Value: Boolean);
    procedure SetInterval(Value: Word);
    procedure SetOnTimer(Value: TNotifyEvent);
    procedure SetThreadPriority(Value: TThreadPriority);
    procedure Timer; dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Reset;
  published
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property Interval: Word read FInterval write SetInterval default 1000;
    property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
    property ThreadPriority: TThreadPriority read FThreadPriority
      write SetThreadPriority;
  end;

procedure Register;

implementation

procedure TTimerThread.Execute;
begin
   repeat
      SleepEx(Interval, False);
      Synchronize(DoTimer);          
   until Terminated;
end;

procedure TTimerThread.DoTimer;
begin
   OwnerTimer.Timer;
end;

constructor TThreadedTimer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEnabled := True;
  FInterval := 1000;
  FThreadPriority := tpNormal;
  FTimerThread := TTimerThread.Create(False);
  FTimerThread.OwnerTimer := Self;
  FTimerThread.Interval := FInterval;
  FTimerThread.Priority := FThreadPriority;
end;

destructor TThreadedTimer.Destroy;
begin
  FEnabled := False;
  UpdateTimer;
  FTimerThread.Free;
  inherited Destroy;
end;

procedure TThreadedTimer.UpdateTimer;
begin
   if FTimerThread.Suspended = False then
      FTimerThread.Suspend;

   if (FInterval <> 0) and FEnabled and Assigned(FOnTimer) then
      FTimerThread.Resume;
end;

procedure TThreadedTimer.SetEnabled(Value: Boolean);
begin
   if Value <> FEnabled then
   begin
      FEnabled := Value;

      UpdateTimer;
   end;
end;

procedure TThreadedTimer.SetInterval(Value: Word);
begin
   if Value <> FInterval then
   begin
      FInterval := Value;
      FTimerThread.Interval := FInterval;
      UpdateTimer;
   end;
end;

procedure TThreadedTimer.SetOnTimer(Value: TNotifyEvent);
begin
   FOnTimer := Value;
   UpdateTimer;
end;

procedure TThreadedTimer.SetThreadPriority(Value: TThreadPriority);
begin
   if Value <> FThreadPriority then
   begin
      FThreadPriority := Value;
      FTimerThread.Priority := Value;
      UpdateTimer;
   end;                                
end;                              

procedure TThreadedTimer.Timer;
begin
   if Assigned(FOnTimer) then
      FOnTimer(Self);
end;        

procedure TThreadedTimer.Reset;
begin
   FTimerThread.Free;
   FTimerThread := TTimerThread.Create(False);
   FTimerThread.OwnerTimer := Self;
   FTimerThread.Priority := FThreadPriority;
   UpdateTimer;
end;


procedure Register;
begin
   RegisterComponents('System', [TThreadedTimer]);
end;
0
Comment
Question by:alexandram
9 Comments
 
LVL 20

Expert Comment

by:Madshi
ID: 2712195
Synchronize is a bad hack. It makes the procedure that you give into Synchronize to be executed in the main thread. So if all you're doing in a thread is calling Synchronize, your threads have no sense at all.
Windows is no real-time OS, so you can't rely on getting *exact* timers. But if you're using multimedia timers, you should come close enough to constant intervals.
I think on

www.torry.ru

there are some free high-res timer components, which work more exactly than the standard TTimer component.

Regards, Madshi.
0
 
LVL 20

Expert Comment

by:Madshi
ID: 2712210
Look here, there are lots of good timer components:

http://www.torry.ru/timers.htm
0
 
LVL 10

Expert Comment

by:Lischke
ID: 2712275
Here is one which is used by my 3D library GLScene;:

unit AsyncTimer;

interface

uses
  Windows, Classes, SysUtils;

const

AsyncTimer_DefTimerThreadPriority = tpTimeCritical;
AsyncTimer_DefTakerThreadPriority = tpHigher;
AsyncTimer_DefInterval = 100;
AsyncTimer_DefEnabled = false;

type

  EAsyncTimerError = class( Exception );

  TAsyncTimer = class(TComponent)
  private
       FTimerThreadPriority :TThreadPriority;
    FTakerThreadPriority :TThreadPriority;
    FOnTimer :TNotifyEvent;
    FOnTimingFault :TNotifyEvent;
    FInterval :Longint;
    FTimerThread :THandle;
    FTimerThreadID :THandle;
       FTakerThread :THandle;
       FTakerThreadID :THandle;
    FEnabled :Boolean;
    FTakerActive :Boolean;
    FFinished :Boolean;
    procedure InitTimerThread;
       procedure DoneTimerThread;
       procedure SetTimerThreadPriority( NewPriority :TThreadPriority );
       procedure SetTakerThreadPriority( NewPriority :TThreadPriority );
       procedure SetEnabled( NewState :Boolean );
       procedure UpdateTimerThreadPriority;
       procedure UpdateTakerThreadPriority;
       procedure InitTakerThread;
       procedure DoneTakerThread;
  protected
    procedure Timer; dynamic;
    procedure TimingFault; dynamic;
    procedure Loaded; override;
  public
    constructor Create( AnOwner :TComponent ); override;
    destructor Destroy; override;
  published
       property Enabled :Boolean
      read FEnabled write SetEnabled
      default AsyncTimer_DefEnabled;
    property Interval :Longint
      read FInterval write FInterval
      default AsyncTimer_DefInterval;
    property OnTimer :TNotifyEvent
      read FOnTimer write FOnTimer;
    property OnTimingFault :TNotifyEvent
      read FOnTimingFault write FOnTimingFault;
    property TimerThreadPriority :TThreadPriority
      read FTimerThreadPriority write SetTimerThreadPriority
      default AsyncTimer_DefTimerThreadPriority;
    property TakerThreadPriority :TThreadPriority
      read FTakerThreadPriority write SetTakerThreadPriority
      default AsyncTimer_DefTakerThreadPriority;
  end;

implementation

const TimerThreadStackSize = $1000;

procedure TakerThreadProc( Timer :TAsyncTimer ); stdcall;
begin
      while not Timer.FFinished do begin
            Timer.FTakerActive := true;
            Timer.Timer;
            Timer.FTakerActive := false;
            SuspendThread( Timer.FTakerThread );
      end;
end;


procedure TimerThreadProc( Timer :TAsyncTimer ); stdcall;
begin
  while Timer.FInterval > 0 do
      begin
        if Timer.FTakerThread <> 0 then
             if Timer.FTakerActive then Timer.TimingFault
              else ResumeThread( Timer.FTakerThread );
        sleep( Timer.FInterval );
      end;
end;

{ TAsyncTimer }

constructor TAsyncTimer.Create( AnOwner :TComponent );
begin
 inherited Create( AnOwner );
 FInterval := AsyncTimer_DefInterval;
 FTimerThreadPriority := AsyncTimer_DefTimerThreadPriority;
 FTakerThreadPriority := AsyncTimer_DefTakerThreadPriority;
 FOnTimer := Nil;
 FOnTimingFault := Nil;
 FTimerThread := 0;
 FTakerThread := 0;
 FTakerActive := false;
 FFinished := false;
 FEnabled := AsyncTimer_DefEnabled;
end;

destructor TAsyncTimer.Destroy;
begin
  DoneTimerThread;
  DoneTakerThread;
  inherited Destroy;
end;

procedure TAsyncTimer.Loaded;
begin
 inherited Loaded;
 InitTakerThread;
 InitTimerThread;
end;

procedure TAsyncTimer.SetTimerThreadPriority(
 NewPriority :TThreadPriority );
begin
 if ( NewPriority <> FTimerThreadPriority ) then
   begin
    FTimerThreadPriority := NewPriority;
    UpdateTimerThreadPriority;
   end;
end;

procedure TAsyncTimer.SetTakerThreadPriority(
 NewPriority :TThreadPriority );
begin
 if ( NewPriority <> FTakerThreadPriority ) then
   begin
    FTakerThreadPriority := NewPriority;
    UpdateTakerThreadPriority;
   end;
end;

procedure TAsyncTimer.SetEnabled( NewState :Boolean );
begin
 if (FTakerThread=0) then
      InitTakerThread;
 if (FTimerThread=0) then
   InitTimerThread;
 if ( FEnabled xor NewState ) then
   begin
    if ( ( [ csDesigning, csReading ] - ComponentState ) <> [] ) then
        if NewState
       then ResumeThread( FTimerThread )
       else SuspendThread( FTimerThread );
       FEnabled := NewState;
   end;
end;


procedure TAsyncTimer.InitTimerThread;
var CreationFlags :Longint;
begin
  if not ( csDesigning in ComponentState ) then { create thread at run-time only }
    begin
     CreationFlags := 0;
     if not FEnabled then CreationFlags := CREATE_SUSPENDED;
        FTimerThread := CreateThread( Nil, TimerThreadStackSize,
            @TimerThreadProc, Self, CreationFlags, FTimerThreadID );
        if ( FTimerThread = 0 ) then
            raise EAsyncTimerError.Create( 'Thread creation error' );
        UpdateTimerThreadPriority;
       end;
end;

procedure TAsyncTimer.DoneTimerThread;
begin
 if ( FTimerThread <> 0 ) then
      begin
        FInterval := -1;
        ResumeThread( FTimerThread );
        WaitForSingleObject( FTimerThread, INFINITE );
     FTimerThread := 0;
   end;
end;

const

  Priorities: array [TThreadPriority] of Integer =
   (THREAD_PRIORITY_IDLE, THREAD_PRIORITY_LOWEST, THREAD_PRIORITY_BELOW_NORMAL,
    THREAD_PRIORITY_NORMAL, THREAD_PRIORITY_ABOVE_NORMAL,
    THREAD_PRIORITY_HIGHEST, THREAD_PRIORITY_TIME_CRITICAL);


procedure TAsyncTimer.UpdateTimerThreadPriority;
begin
  SetThreadPriority( FTimerThread, Priorities[ FTimerThreadPriority ] );
end;

procedure TAsyncTimer.UpdateTakerThreadPriority;
begin
  SetThreadPriority( FTakerThread, Priorities[ FTakerThreadPriority ] );
end;

procedure TAsyncTimer.Timer;
begin
      if assigned( FOnTimer ) then FOnTimer( Self );
end;

procedure TAsyncTimer.InitTakerThread;
begin
 if not ( csDesigning in ComponentState ) then { create thread at run-time only }
   begin
    FTakerActive := false;
    FTakerThread := CreateThread( Nil, 0, @TakerThreadProc,
        Self, CREATE_SUSPENDED, FTakerThreadID );
       if ( FTakerThread = 0 ) then
            raise EAsyncTimerError.Create( 'Timer event taker thread creation error' );
       UpdateTakerThreadPriority;
  end;
end;

procedure TAsyncTimer.DoneTakerThread;
begin
 if ( FTakerThread <> 0 ) then
      begin
        FFinished := true;
        ResumeThread( FTakerThread );
     WaitForSingleObject( FTakerThread, INFINITE );
     FTakerThread := 0;
   end;
end;

procedure TAsyncTimer.TimingFault;
begin
 if assigned( FOnTimingFault ) then FOnTimingFault( Self );
end;


end.


But as Madshi already said. Windows is no real time OS so there's no guarantee about a particular time interval.

Ciao, Mike
0
Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

 
LVL 10

Expert Comment

by:Lischke
ID: 2712285
Oops. forgot the credits: the component has actually been written by Glen Why.

Ciao, Mike
0
 
LVL 6

Expert Comment

by:edey
ID: 2712638
I'm a little confused, are you looking for a timer that repeats *very* regularly, or a precise means of measuring *elapsed* time, as this line would suggest:

"(I am using the timer to display the number of seconds used for a public terminal)."

if the latter is correct, then you joust need to keep record of the starting time, and don't neccessarily need to update exactly every second.


GL
Mike
0
 
LVL 2

Expert Comment

by:mullet_attack
ID: 2715418
I write scoreboard software for various sports. Usually I need to display elapsed time. I have found that using a timer is next to useless, as stated before, Windows is not a real-time OS.

Best technique I use is to read the system time, store it in variable, and then deduct it from NOW. I usually do this in a low priority 100-250ms timer, that way the displayed time may be slightly wrong second-to-second, (nobody notices ) however overall it will be the same accuracy as the PC's clock.
0
 
LVL 12

Accepted Solution

by:
rwilson032697 earned 300 total points
ID: 2715471
You could use a multimedia timer with SetTimeEvent et al. They are much more accurate than using a standard TTimer (in a thread or otherwise)

Cheers,

Raymond.
0
 
LVL 1

Expert Comment

by:nrico
ID: 2726285
rwilson --
  Not entirely correct. It's not called "SetTimeEvent()" but "timeSetEvent()" :-). And yes, those are VERY accurate. (At least as accurate as you can get them under Windoze)
0
 

Author Comment

by:alexandram
ID: 2734800
I found an example of using this and it works well. I will test my program for a while using it but it is promessing.
0

Featured Post

Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
This tutorial gives a high-level tour of the interface of Marketo (a marketing automation tool to help businesses track and engage prospective customers and drive them to purchase). You will see the main areas including Marketing Activities, Design …
Migrating to Microsoft Office 365 is becoming increasingly popular for organizations both large and small. If you have made the leap to Microsoft’s cloud platform, you know that you will need to create a corporate email signature for your Office 365…

813 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now