Hi, I've created a while back a thread based Timer. At the time I developed the timer, I tested it in a Lazarus (LCL) GUI application and everything worked perfectly. Just tested it now and it still works fine.
Today I tried to use that Timer in a Console application and a fpGUI based application and the timer doesn't work for some reason! I'm using FPC 2.2.0 under Linux. I attached a Console test project and the threadtimer.pas unit. Has anybody got any ideas as to why it doesn't work in a console app? BTW: To get the console app to continue running, I have a loop checking for a file or sleeps for 500 ms. The timer is enabled before that loop starts, so I am supposed to see output to the console. I added some debug writeln()'s to know when the time starts or stops and which events file (application loop or timer event). Regards, - Graeme - _______________________________________________ fpGUI - a cross-platform Free Pascal GUI toolkit http://opensoft.homeip.net/fpgui/
{
A basic thread based timer component. Can be used in GUI and non-GUI apps.
Author: Graeme Geldenhuys
}
unit ThreadTimer;
{$mode objfpc}{$H+}
interface
uses
Classes;
type
TFPTimer = class; // forward declaration
TFPTimerThread = class(TThread)
private
FTimer: TFPTimer;
protected
procedure DoExecute;
procedure Execute; override;
public
constructor CreateTimerThread(Timer: TFPTimer);
end;
TFPTimer = class(TComponent)
private
FInterval: Integer;
FPriority: TThreadPriority;
FOnTimer: TNotifyEvent;
FContinue: Boolean;
FRunning: Boolean;
FEnabled: Boolean;
procedure SetEnabled(Value: Boolean );
protected
procedure StartTimer;
procedure StopTimer;
property Continue: Boolean read FContinue write FContinue;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure On;
procedure Off;
published
property Enabled: Boolean read FEnabled write SetEnabled;
property Interval: Integer read FInterval write FInterval;
property ThreadPriority: TThreadPriority read FPriority write FPriority default tpNormal;
property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
end;
implementation
uses
SysUtils;
{ No need to pull in the Windows unit. Also this works on all platforms. }
function _GetTickCount: Cardinal;
begin
Result := Cardinal(Trunc(Now * 24 * 60 * 60 * 1000));
end;
{ TFPTimerThread }
constructor TFPTimerThread.CreateTimerThread(Timer: TFPTimer);
begin
inherited Create(True);
FTimer := Timer;
FreeOnTerminate := True;
end;
procedure TFPTimerThread.Execute;
var
SleepTime: Integer;
Last: Cardinal;
begin
while FTimer.Continue do
begin
Last := _GetTickCount;
Synchronize(@DoExecute);
SleepTime := FTimer.FInterval - (_GetTickCount - Last);
if SleepTime < 10 then
SleepTime := 10;
Sleep(SleepTime);
end;
end;
procedure TFPTimerThread.DoExecute;
begin
if Assigned(FTimer.OnTimer) then FTimer.OnTimer(FTimer);
end;
{ TFPTimer }
constructor TFPTimer.Create(AOwner: TComponent);
begin
inherited;
FPriority := tpNormal;
end;
destructor TFPTimer.Destroy;
begin
StopTimer;
inherited Destroy;
end;
procedure TFPTimer.SetEnabled(Value: Boolean);
begin
if Value <> FEnabled then
begin
FEnabled := Value;
if FEnabled then
StartTimer
else
StopTimer;
end;
end;
procedure TFPTimer.StartTimer;
begin
if FRunning then
Exit; //==>
FContinue := True;
if not (csDesigning in ComponentState) then
begin
with TFPTimerThread.CreateTimerThread(Self) do
begin
Priority := FPriority;
Resume;
end;
end;
FRunning := True;
writeln('StartTimer'); // debug line
end;
procedure TFPTimer.StopTimer;
begin
writeln('StopTimer'); // debug line
FContinue := False;
FRunning := False;
end;
procedure TFPTimer.On;
begin
StartTimer;
end;
procedure TFPTimer.Off;
begin
StopTimer;
end;
end.
test.lpr
Description: Binary data
_______________________________________________ fpc-devel maillist - [email protected] http://lists.freepascal.org/mailman/listinfo/fpc-devel
