paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-05 12:47:27 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Fixed bug ID #23444, improved example to show elapsed time

Browse Source 
git-svn-id: trunk@23247 -
This commit is contained in:
michael 2012-12-29 09:58:12 +00:00
parent b3de56a540
commit f2ee6bcb77
2 changed files with 18 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
packages/fcl-base/examples/testtimer.pp
View File

@ -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;

12
packages/fcl-base/src/fptimer.pp
View File

@ -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