[Lazarus] timer in a console application

Andrea Mauri andrea.mauri.75 at gmail.com
Fri Aug 10 13:47:48 CEST 2012


Il 10/08/2012 13:01, michael.vancanneyt at wisa.be 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.
>
> 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.

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.






More information about the Lazarus mailing list