On Fri, 10 Aug 2012, Andrea Mauri wrote:
Il 10/08/2012 13:01, [email protected] ha scritto:
The fptimer unit has a timer that can be run in the main thread of an
application, in a console application.
I tried using fptimer in my objects but it seems that it does not work as
expected.
See the simple code below, a console app using a tfptimer to stop the
execution of a procedure, but the ontimer event is never called.
You must call checksynchronize at regular intervals in the main thread.
How you do this, depends on your application.
If your main thread controls the time limits then this can be used to
control another thread(s) which do(es) the calculations.
Must I use in some way the threads? I never used threads, so I don't know
exactly what to do.
FPTimer uses a thread to generate the timer events using synchronize.
The main thread needs to call checksynchronize at an interval smaller than
the timer slice, obviously.
Somethin like:
procedure TMyApplication.DoCalculation(i: integer);
begin
write(i, '-');
while not fStopExecution do
begin
CheckSynchronize;
inc(i);
end;
writeln(i);
end;
Just add Cthreads if you are on linux. On Windows, you don't need to do
anything.
Michael.
program Project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp, fpTimer
{ you can add units after this };
type
{ TMyApplication }
TMyApplication = class(TCustomApplication)
protected
procedure DoRun; override;
private
fStopExecution: boolean;
fTimer: TFPTimer;
procedure StopExecution(Sender: TObject);
procedure DoCalculation(i: integer);
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure WriteHelp; virtual;
end;
{ TMyApplication }
procedure TMyApplication.DoRun;
var
ErrorMsg: String;
i, n: integer;
begin
// quick check parameters
ErrorMsg:=CheckOptions('h','help');
if ErrorMsg<>'' then begin
ShowException(Exception.Create(ErrorMsg));
Terminate;
Exit;
end;
// parse parameters
if HasOption('h','help') then begin
WriteHelp;
Terminate;
Exit;
end;
{ add your program here }
n:= 10;
for i:= 0 to n do
begin
fStopExecution:= False;
fTimer.StartTimer;
DoCalculation(i);
fTimer.StopTimer;
end;
// stop program loop
Terminate;
end;
procedure TMyApplication.StopExecution(Sender: TObject);
begin
fStopExecution:= True;
end;
procedure TMyApplication.DoCalculation(i: integer);
begin
write(i, '-');
while not fStopExecution do
inc(i);
writeln(i);
end;
constructor TMyApplication.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
StopOnException:=True;
end;
destructor TMyApplication.Destroy;
begin
inherited Destroy;
end;
procedure TMyApplication.WriteHelp;
begin
{ add your help code here }
writeln('Usage: ',ExeName,' -h');
end;
var
Application: TMyApplication;
begin
Application:=TMyApplication.Create(nil);
Application.Title:='My Application';
Application.fTimer:= TFPTimer.Create(nil);
Application.fTimer.Interval:= 1000;
Application.fTimer.OnTimer:= @Application.StopExecution;
Application.Run;
Application.Free;
end.
--
_______________________________________________
Lazarus mailing list
[email protected]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
--
_______________________________________________
Lazarus mailing list
[email protected]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
