mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 19:29:24 +02:00
* Alternat implementation based on event, from Derek (Bug ID 28831)
git-svn-id: trunk@33298 -
This commit is contained in:
michael
parent
8f9899e5c4
commit
6ab9435e44
@ -23,12 +23,32 @@
|
||||
|
||||
A nice improvement would be an implementation that works
|
||||
in all threads, such as the threadedtimer of IBX for linux.
|
||||
|
||||
Replaced SLEEP with TEvent for those platforms supporting threading:
|
||||
Windows, Linux, BSD.
|
||||
On the other platforms, use sleep. This unfortunately has a high overhead
|
||||
resulting in drift. A five minute timer could be up to 40 seconds late
|
||||
do to entering and returning (linux x64). MOdified to check the absolute
|
||||
time every minute, has reduced that lag to about 0.100 second. This is
|
||||
still greater than TEvent, where the delay is only a few milliseconds (0-3).
|
||||
}
|
||||
|
||||
unit fpTimer;
|
||||
unit fptimer;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
{
|
||||
Windows, or any platform that uses Cthreads has TEvent with a timed wait
|
||||
which can include android and embedded.
|
||||
You can force the use of the Sleep() based timer by defining USESLEEP
|
||||
}
|
||||
|
||||
{$IFNDEF USESLEEP}
|
||||
{$if Defined(MSWINDOWS) or (Defined(UNIX) and not Defined(BEOS))}
|
||||
{$define Has_EventWait}
|
||||
{$endif}
|
||||
{$ENDIF}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
@ -36,20 +56,25 @@ uses
|
||||
|
||||
type
|
||||
TFPTimerDriver = Class;
|
||||
|
||||
|
||||
{ TFPCustomTimer }
|
||||
|
||||
TFPCustomTimer = class(TComponent)
|
||||
private
|
||||
FInterval: Integer;
|
||||
FDriver : TFPTimerDriver;
|
||||
FOnTimer: TNotifyEvent;
|
||||
FContinue: Boolean;
|
||||
FRunning: Boolean;
|
||||
FEnabled: Boolean;
|
||||
procedure SetEnabled(Value: Boolean );
|
||||
FOnStartTimer : TNotifyEvent;
|
||||
FOnStopTimer : TNotifyEvent;
|
||||
FOnTimer : TNotifyEvent;
|
||||
FInterval : Cardinal;
|
||||
FActive : Boolean;
|
||||
FEnabled : Boolean;
|
||||
FUseTimerThread : Boolean;
|
||||
procedure SetEnabled(const AValue: Boolean );
|
||||
procedure SetInterval(const AValue: Cardinal);
|
||||
protected
|
||||
property Continue: Boolean read FContinue write FContinue;
|
||||
procedure Timer; virtual;
|
||||
property Active: Boolean read FActive write FActive;
|
||||
Function CreateTimerDriver : TFPTimerDriver;
|
||||
procedure Timer; virtual;
|
||||
public
|
||||
Constructor Create(AOwner: TComponent); override;
|
||||
Destructor Destroy; override;
|
||||
@ -57,25 +82,36 @@ type
|
||||
procedure StopTimer; virtual;
|
||||
protected
|
||||
property Enabled: Boolean read FEnabled write SetEnabled;
|
||||
property Interval: Integer read FInterval write FInterval;
|
||||
property Interval: Cardinal read FInterval write SetInterval;
|
||||
property UseTimerThread: Boolean read FUseTimerThread write FUseTimerThread;
|
||||
property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
|
||||
property OnStartTimer: TNotifyEvent read FOnStartTimer write FOnStartTimer;
|
||||
property OnStopTimer: TNotifyEvent read FOnStopTimer write FOnStopTimer;
|
||||
end;
|
||||
|
||||
TFPTimer = Class(TFPCustomTimer)
|
||||
Published
|
||||
Property Enabled;
|
||||
Property Interval;
|
||||
Property UseTimerThread;
|
||||
Property OnTimer;
|
||||
end;
|
||||
Property OnStartTimer;
|
||||
Property OnStopTimer;
|
||||
end;
|
||||
|
||||
{ TFPTimerDriver }
|
||||
|
||||
TFPTimerDriver = Class(TObject)
|
||||
Protected
|
||||
FTimer : TFPCustomTimer;
|
||||
FTimerStarted : Boolean;
|
||||
procedure SetInterval(const AValue: Cardinal); virtual;
|
||||
Public
|
||||
Constructor Create(ATimer : TFPCustomTimer); virtual;
|
||||
Procedure StartTimer; virtual; abstract;
|
||||
Procedure StopTimer; virtual; abstract;
|
||||
Property Timer : TFPCustomTimer Read FTimer;
|
||||
property TimerStarted: Boolean read FTimerStarted;
|
||||
end;
|
||||
TFPTimerDriverClass = Class of TFPTimerDriver;
|
||||
|
||||
@ -100,9 +136,8 @@ end;
|
||||
destructor TFPCustomTimer.Destroy;
|
||||
|
||||
begin
|
||||
If FEnabled then
|
||||
StopTimer;
|
||||
FDriver.FTimer:=Nil;
|
||||
StopTimer;
|
||||
FDriver.FTimer:=Nil;
|
||||
FreeAndNil(FDriver);
|
||||
Inherited;
|
||||
end;
|
||||
@ -114,34 +149,59 @@ begin
|
||||
Result:=DefaultTimerDriverClass.Create(Self);
|
||||
end;
|
||||
|
||||
procedure TFPCustomTimer.SetEnabled(Value: Boolean);
|
||||
procedure TFPCustomTimer.SetEnabled(const AValue: Boolean);
|
||||
begin
|
||||
if Value <> FEnabled then
|
||||
if AValue <> FEnabled then
|
||||
begin
|
||||
if Value then
|
||||
FEnabled := AValue;
|
||||
if FEnabled then
|
||||
StartTimer
|
||||
else
|
||||
StopTimer;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPCustomTimer.StartTimer;
|
||||
procedure TFPCustomTimer.SetInterval(const AValue: Cardinal);
|
||||
begin
|
||||
If FEnabled then
|
||||
Exit;
|
||||
FEnabled:=True;
|
||||
FContinue:=True;
|
||||
If Not (csDesigning in ComponentState) then
|
||||
if FInterval <> AValue then
|
||||
begin
|
||||
fInterval := AValue;
|
||||
if FActive and (fInterval > 0) then
|
||||
FDriver.SetInterval(AValue) // Allow driver to update Interval
|
||||
else
|
||||
StopTimer; // Timer not required
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPCustomTimer.StartTimer;
|
||||
var
|
||||
IsActive: Boolean;
|
||||
begin
|
||||
IsActive:=FEnabled and (fInterval > 0) and Assigned(FOnTimer);
|
||||
If IsActive and not fActive and Not (csDesigning in ComponentState) then
|
||||
begin
|
||||
FDriver.StartTimer;
|
||||
if FDriver.TimerStarted then
|
||||
begin
|
||||
FActive := True;
|
||||
if Assigned(OnStartTimer) then
|
||||
OnStartTimer(Self);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPCustomTimer.StopTimer;
|
||||
begin
|
||||
If Not FEnabled then
|
||||
Exit;
|
||||
FEnabled:=False;
|
||||
FContinue:=False;
|
||||
FDriver.StopTimer;
|
||||
if FActive then
|
||||
begin
|
||||
FDriver.StopTimer;
|
||||
if not FDriver.TimerStarted then
|
||||
begin
|
||||
FActive:=False;
|
||||
if Assigned(OnStopTimer) then
|
||||
OnStopTimer(Self);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPCustomTimer.Timer;
|
||||
@ -149,14 +209,13 @@ procedure TFPCustomTimer.Timer;
|
||||
begin
|
||||
{ We check on FEnabled: If by any chance a tick comes in after it was
|
||||
set to false, the user won't notice, since no event is triggered.}
|
||||
If FEnabled and Assigned(FOnTimer) then
|
||||
If FActive and Assigned(FOnTimer) then
|
||||
FOnTimer(Self);
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
TFPTimerDriver
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
|
||||
Constructor TFPTimerDriver.Create(ATimer : TFPCustomTimer);
|
||||
|
||||
@ -164,116 +223,327 @@ begin
|
||||
FTimer:=ATimer;
|
||||
end;
|
||||
|
||||
procedure TFPTimerDriver.SetInterval(const AValue: Cardinal);
|
||||
begin
|
||||
// Default implementation is to restart the timer on Interval change
|
||||
if TimerStarted then
|
||||
begin
|
||||
StopTimer;
|
||||
FTimerStarted := (AValue > 0);
|
||||
if FTimerStarted then
|
||||
StartTimer;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
Default implementation. Threaded timer, one thread per timer.
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
const
|
||||
cMilliSecs: Extended = 60.0 * 60.0 * 24.0 * 1000.0;
|
||||
|
||||
Type
|
||||
|
||||
{ TFPTimerThread }
|
||||
|
||||
TFPTimerThread = class(TThread)
|
||||
private
|
||||
FTimerDriver: TFPTimerDriver;
|
||||
FStartTime : TDateTime;
|
||||
{$ifdef Has_EventWait}
|
||||
FWaitEvent: PEventState;
|
||||
{$else}
|
||||
fSignaled: Boolean;
|
||||
{$endif}
|
||||
fInterval: Cardinal;
|
||||
Function Timer : TFPCustomTimer;
|
||||
Function GetWakeTime(var AInterval,Counter : Int64; Out WakeInterval : Integer; Out WakeTime : TDateTime) : Boolean;
|
||||
public
|
||||
procedure Execute; override;
|
||||
constructor CreateTimerThread(ATimerDriver: TFPTimerDriver);
|
||||
procedure Terminate;
|
||||
procedure SetInterval(const AValue: Cardinal);
|
||||
end;
|
||||
|
||||
{ TFPThreadedTimerDriver }
|
||||
|
||||
TFPThreadedTimerDriver = Class(TFPTimerDriver)
|
||||
Private
|
||||
FThread : TFPTimerThread;
|
||||
Procedure DoNilTimer(Sender : TObject);
|
||||
protected
|
||||
Procedure SetInterval(const AValue: cardinal); override;
|
||||
Public
|
||||
Procedure StartTimer; override;
|
||||
Procedure StopTimer; override;
|
||||
end;
|
||||
|
||||
function _GetTickCount: Cardinal;
|
||||
begin
|
||||
Result := Cardinal(Trunc(Now * 24 * 60 * 60 * 1000));
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
TFPTimerThread
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
|
||||
constructor TFPTimerThread.CreateTimerThread(ATimerDriver: TFPTimerDriver);
|
||||
begin
|
||||
inherited Create(True);
|
||||
FTimerDriver:=ATimerDriver;
|
||||
{$ifdef Has_EventWait}
|
||||
FWaitEvent := BasicEventCreate(nil,false,false,'');
|
||||
{$else}
|
||||
fSignaled := False;
|
||||
{$endif}
|
||||
fInterval := ATimerDriver.Timer.Interval;
|
||||
FreeOnTerminate := True;
|
||||
end;
|
||||
|
||||
procedure TFPTimerThread.Terminate;
|
||||
begin
|
||||
inherited Terminate;
|
||||
{$ifdef Has_EventWait}
|
||||
BasicEventSetEvent(fWaitEvent);
|
||||
{$else}
|
||||
fSignaled := True;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure TFPTimerThread.SetInterval(const AValue: Cardinal);
|
||||
begin
|
||||
if fInterval <> AValue then
|
||||
begin
|
||||
fInterval := AValue;
|
||||
{$ifdef Has_EventWait}
|
||||
BasicEventSetEvent(fWaitEvent); // Wake thread
|
||||
{$else}
|
||||
fSignaled := True;
|
||||
{$endif}
|
||||
end;
|
||||
end;
|
||||
|
||||
Function TFPTimerThread.Timer : TFPCustomTimer;
|
||||
|
||||
begin
|
||||
If Assigned(FTimerDriver) Then
|
||||
Result:=FTimerDriver.FTimer
|
||||
else
|
||||
Result:=Nil;
|
||||
Result:=Nil;
|
||||
end;
|
||||
|
||||
procedure TFPTimerThread.Execute;
|
||||
var
|
||||
SleepTime: Integer;
|
||||
S,Last: Cardinal;
|
||||
T : TFPCustomTimer;
|
||||
|
||||
Function TFPTimerThread.GetWakeTime(var AInterval,Counter : Int64; Out WakeInterval : Longint; Out WakeTime : TDateTime) : Boolean;
|
||||
|
||||
|
||||
Var
|
||||
Diff: Extended;
|
||||
|
||||
begin
|
||||
while Not Terminated do
|
||||
{ Use Counter*fInterval to avoid numerical errors resulting from adding
|
||||
small values (AInterval/cMilliSecs) to a large real number (TDateTime),
|
||||
even when using Extended precision }
|
||||
WakeTime := FStartTime + (Counter*AInterval / cMilliSecs);
|
||||
Diff := (WakeTime - Now);
|
||||
if Diff > 0 then
|
||||
begin
|
||||
Last := _GetTickCount;
|
||||
T:=Timer;
|
||||
If Assigned(T) then
|
||||
begin
|
||||
SleepTime := T.FInterval - (_GetTickCount - Last);
|
||||
if SleepTime < 10 then
|
||||
SleepTime := 10;
|
||||
Repeat
|
||||
S:=5;
|
||||
If S>SleepTime then
|
||||
S:=SleepTime;
|
||||
Sleep(S);
|
||||
Dec(Sleeptime,S);
|
||||
until (SleepTime<=0) or Terminated;
|
||||
T:=Timer;
|
||||
If Assigned(T) and not terminated then
|
||||
Synchronize(@T.Timer);
|
||||
end
|
||||
else
|
||||
Terminate;
|
||||
WakeInterval := Trunc(Diff * cMilliSecs);
|
||||
if WakeInterval < 10 then
|
||||
WakeInterval := 10; // Provide a minimum wait time
|
||||
end
|
||||
else
|
||||
begin
|
||||
WakeInterval:=MaxInt;
|
||||
// Time has already expired, execute Timer and restart wait loop
|
||||
try
|
||||
if not Timer.UseTimerThread then
|
||||
Synchronize(@Timer.Timer) // Call user event
|
||||
else
|
||||
Timer.Timer;
|
||||
except
|
||||
// Trap errors to prevent this thread from terminating
|
||||
end;
|
||||
Inc(Counter);
|
||||
Result:=True;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$ifdef Has_EventWait}
|
||||
procedure TFPTimerThread.Execute;
|
||||
var
|
||||
WakeTime, StartTime: TDateTime;
|
||||
WakeInterval: Integer;
|
||||
Counter: int64; { use Int64 to avoid overflow with Counter*fInterval (~49 days)}
|
||||
AInterval: int64;
|
||||
Diff: Extended;
|
||||
|
||||
Const
|
||||
wrSignaled = 0;
|
||||
wrTimeout = 1;
|
||||
wrAbandoned= 2;
|
||||
wrError = 3;
|
||||
|
||||
begin
|
||||
WakeInterval := MaxInt;
|
||||
Counter := 1;
|
||||
AInterval := fInterval;
|
||||
FStartTime := Now;
|
||||
while not Terminated do
|
||||
begin
|
||||
if GetWakeTime(AInterval,Counter,WakeInterval,WakeTime) then
|
||||
Continue;
|
||||
if not Terminated then
|
||||
case BasicEventWaitFor(WakeInterval,fWaitEvent) of
|
||||
wrTimeout:
|
||||
begin
|
||||
if Terminated then
|
||||
Break
|
||||
else
|
||||
begin
|
||||
try
|
||||
if not Timer.UseTimerThread then
|
||||
// If terminate is called while here, then the Synchronize will be
|
||||
// queued while the stoptimer is being processed.
|
||||
// StopTimer cannot wait until thread completion as this would deadlock
|
||||
Synchronize(@Timer.Timer) // Call user event
|
||||
else
|
||||
Timer.Timer;
|
||||
except
|
||||
// Trap errors to prevent this thread from terminating
|
||||
end;
|
||||
Inc(Counter); // Next interval
|
||||
end;
|
||||
end;
|
||||
wrSignaled:
|
||||
begin
|
||||
if Terminated then
|
||||
Break
|
||||
else
|
||||
begin // Interval has changed
|
||||
Counter := 1; // Restart timer without creating new thread
|
||||
AInterval := fInterval;
|
||||
FStartTime := Now;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
Break;
|
||||
end
|
||||
end;
|
||||
BasicEventDestroy(fWaitEvent);
|
||||
end;
|
||||
|
||||
{$ELSE Has_EventWait}
|
||||
|
||||
procedure TFPTimerThread.Execute;
|
||||
|
||||
var
|
||||
WakeTime, StartTime: TDateTime;
|
||||
WakeInterval: Integer;
|
||||
Counter: int64; { use Int64 to avoid overflow with Counter*fInterval (~49 days)}
|
||||
AInterval: int64;
|
||||
Diff: Extended;
|
||||
S,Last: Cardinal;
|
||||
RecheckTimeCounter: integer;
|
||||
|
||||
const
|
||||
cSleepTime = 500; // 0.5 second, better than every 5 milliseconds
|
||||
cRecheckTimeCount = 120; // Recheck clock every minute, as the sleep loop can loose time
|
||||
|
||||
begin
|
||||
WakeInterval := MaxInt;
|
||||
Counter := 1;
|
||||
AInterval := fInterval;
|
||||
FStartTime := Now;
|
||||
while not Terminated do
|
||||
begin
|
||||
if GetWakeTime(AInterval,Counter,WakeInterval,WakeTime) then
|
||||
Continue;
|
||||
if not Terminated then
|
||||
begin
|
||||
RecheckTimeCounter := cRecheckTimeCount;
|
||||
s := cSleepTime;
|
||||
repeat
|
||||
if s > WakeInterval then
|
||||
s := WakeInterval;
|
||||
sleep(s);
|
||||
if fSignaled then // Terminated or interval has changed
|
||||
begin
|
||||
if not Terminated then
|
||||
begin
|
||||
fSignaled := False;
|
||||
Counter := 1; // Restart timer
|
||||
AInterval := fInterval;
|
||||
StartTime := Now;
|
||||
end;
|
||||
break; // Need to break out of sleep loop
|
||||
end;
|
||||
|
||||
dec(WakeInterval,s); // Update total wait time
|
||||
dec(RecheckTimeCounter); // Do we need to recheck current time
|
||||
if (RecheckTimeCounter < 0) and (WakeInterval > 0) then
|
||||
begin
|
||||
Diff := (WakeTime - Now);
|
||||
WakeInterval := Trunc(Diff * cMilliSecs);
|
||||
RecheckTimeCounter := cRecheckTimeCount;
|
||||
s := cSleepTime;
|
||||
end;
|
||||
until (WakeInterval<=0) or Terminated;
|
||||
if WakeInterval <= 0 then
|
||||
try
|
||||
inc(Counter);
|
||||
if not Timer.UseTimerThread then
|
||||
// If terminate is called while here, then the Synchronize will be
|
||||
// queued while the stoptimer is being processed.
|
||||
// StopTimer cannot wait until thread completion as this would deadlock
|
||||
Synchronize(@Timer.Timer) // Call user event
|
||||
else
|
||||
Timer.Timer;
|
||||
except
|
||||
// Trap errors to prevent this thread from terminating
|
||||
end;
|
||||
end
|
||||
end;
|
||||
end;
|
||||
{$ENDIF Has_EventWait}
|
||||
{ ---------------------------------------------------------------------
|
||||
TFPThreadedTimerDriver
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
Procedure TFPThreadedTimerDriver.DoNilTimer(Sender : TObject);
|
||||
|
||||
procedure TFPThreadedTimerDriver.SetInterval(const AValue: cardinal);
|
||||
begin
|
||||
FThread:=Nil;
|
||||
if FThread <> nil then
|
||||
begin
|
||||
if AValue > 0 then
|
||||
FThread.SetInterval(AValue)
|
||||
else
|
||||
StopTimer;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TFPThreadedTimerDriver.StartTimer;
|
||||
Procedure TFPThreadedTimerDriver.StartTimer;
|
||||
|
||||
begin
|
||||
FThread:=TFPTimerThread.CreateTimerThread(Self);
|
||||
FThread.OnTerminate:=@DoNilTimer;
|
||||
FThread.Start;
|
||||
if FThread = nil then
|
||||
begin
|
||||
FThread:=TFPTimerThread.CreateTimerThread(Self);
|
||||
FThread.Start;
|
||||
FTimerStarted := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
Procedure TFPThreadedTimerDriver.StopTimer;
|
||||
begin
|
||||
FThread.FTimerDriver:=Nil;
|
||||
FThread.Terminate; // Will free itself.
|
||||
CheckSynchronize; // make sure thread is not stuck at synchronize call.
|
||||
If Assigned(FThread) then
|
||||
Fthread.WaitFor;
|
||||
if FThread <> nil then
|
||||
begin
|
||||
try
|
||||
// Cannot wait on thread in case
|
||||
// 1. this is called in a Synchonize method and the FThread is
|
||||
// about to run a synchronize method. In these cases we would have a deadlock
|
||||
// 2. In a DLL and this is called as part of DLLMain, which never
|
||||
// returns endthread (hence WaitFor) until DLLMain is exited
|
||||
FThread.Terminate; // Will call FThread.Wake;
|
||||
finally
|
||||
FThread := nil;
|
||||
end;
|
||||
FTimerStarted := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Initialization
|
||||
DefaultTimerDriverClass:=TFPThreadedTimerDriver;
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user