Solved

Threader timer

Posted on 2000-04-13
9
1,234 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
Comment Utility
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
Comment Utility
Look here, there are lots of good timer components:

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

Expert Comment

by:Lischke
Comment Utility
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
 
LVL 10

Expert Comment

by:Lischke
Comment Utility
Oops. forgot the credits: the component has actually been written by Glen Why.

Ciao, Mike
0
Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

 
LVL 6

Expert Comment

by:edey
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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

How to improve team productivity

Quip adds documents, spreadsheets, and tasklists to your Slack experience
- Elevate ideas to Quip docs
- Share Quip docs in Slack
- Get notified of changes to your docs
- Available on iOS/Android/Desktop/Web
- Online/Offline

Join & Write a Comment

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
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…
When you create an app prototype with Adobe XD, you can insert system screens -- sharing or Control Center, for example -- with just a few clicks. This video shows you how. You can take the full course on Experts Exchange at http://bit.ly/XDcourse.
This video explains how to create simple products associated to Magento configurable product and offers fast way of their generation with Store Manager for Magento tool.

728 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

10 Experts available now in Live!

Get 1:1 Help Now