[Lazarus] timer in a console application

michael.vancanneyt at wisa.be michael.vancanneyt at wisa.be
Fri Aug 10 14:38:01 CEST 2012



On Fri, 10 Aug 2012, Andrea Mauri wrote:

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

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
> Lazarus at lists.lazarus.freepascal.org
> http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
>




More information about the Lazarus mailing list