Improve company productivity with a Business Account.Sign Up

x
?
Solved

Threader timer

Posted on 2000-04-13
9
Medium Priority
?
1,305 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
The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

 
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 1200 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: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

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.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

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…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
If you are looking for an automated solution for backup single or multiple Office 365 user mailboxes to Outlook data file, then you can use Kernel Office 365 Backup & Restore tool. Go through the video to check out the steps to backup single or mult…
Through the video, you can check the migration process of Outlook PST file to PDF. Kernel for Outlook to PDF tool can convert Outlook emails with all attributes like Subject, To, From, Cc, Bcc and other folders such as Inbox, Outbox, Sent Items, Jun…

606 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