[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