Solved

Threader timer

Posted on 2000-04-13
9
1,247 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
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
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

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

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…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Two types of users will appreciate AOMEI Backupper Pro: 1 - Those with PCIe drives (and haven't found cloning software that works on them). 2 - Those who want a fast clone of their boot drive (no re-boots needed) and it can clone your drive wh…

861 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