diff --git a/packages/fcl-base/examples/testtimer.pp b/packages/fcl-base/examples/testtimer.pp index 47c0955a0b..98922a5d3f 100644 --- a/packages/fcl-base/examples/testtimer.pp +++ b/packages/fcl-base/examples/testtimer.pp @@ -14,6 +14,7 @@ Type FTimer : TFPTimer; FCount : Integer; FTick : Integer; + N : TDateTime; Public Procedure DoRun; override; Procedure DoTick(Sender : TObject); @@ -29,11 +30,12 @@ begin Try FTick:=0; FCount:=0; + N:=Now; While (FCount<10) do begin Inc(FTick); - CheckSynchronize; // Needed, because we are not running in a GUI loop. Sleep(1); + CheckSynchronize; // Needed, because we are not running in a GUI loop. end; Finally FTimer.Enabled:=False; @@ -44,10 +46,15 @@ end; Procedure TTestTimerApp.DoTick(Sender : TObject); +Var + D : TDateTime; + begin Inc(FCount); - Writeln('Received timer event ',FCount,' after ',FTick,' ticks.'); + D:=Now-N; + Writeln('Received timer event ',FCount,' after ',FTick,' ticks. (Elapsed time: ',FormatDateTime('ss.zzz',D),')'); FTick:=0; + N:=Now; end; diff --git a/packages/fcl-base/src/fptimer.pp b/packages/fcl-base/src/fptimer.pp index f98ffed892..bdaee0783d 100644 --- a/packages/fcl-base/src/fptimer.pp +++ b/packages/fcl-base/src/fptimer.pp @@ -216,7 +216,7 @@ end; procedure TFPTimerThread.Execute; var SleepTime: Integer; - Last: Cardinal; + S,Last: Cardinal; T : TFPCustomTimer; begin @@ -229,9 +229,15 @@ begin SleepTime := T.FInterval - (_GetTickCount - Last); if SleepTime < 10 then SleepTime := 10; - Sleep(SleepTime); + Repeat + S:=5; + If S>SleepTime then + S:=SleepTime; + Sleep(S); + Dec(Sleeptime,S); + until (SleepTime<=0) or Terminated; T:=Timer; - If Assigned(T) then + If Assigned(T) and not terminated then Synchronize(@T.Timer); end else