Recent

Author Topic: Ttimer in console application  (Read 446 times)

simsee

  • Jr. Member
  • **
  • Posts: 82
Ttimer in console application
« on: March 03, 2021, 04:44:49 pm »
Can Ttimer be used only for a GUI application or also in console applications?

MarkMLl

  • Hero Member
  • *****
  • Posts: 2565
Re: Ttimer in console application
« Reply #1 on: March 03, 2021, 05:46:18 pm »
Assume it can't.

A more detailed answer can't be given since you've provided no info on the OS you're using or the version of Lazarus and FPC.

MarkMLl
Turbo Pascal v1 on CCP/M-86, multitasking with LAN and graphics in 128Kb.
Pet hate: people who boast about the size and sophistication of their computer.
GitHub repositories: https://github.com/MarkMLl?tab=repositories

GetMem

  • Hero Member
  • *****
  • Posts: 4017
Re: Ttimer in console application
« Reply #2 on: March 03, 2021, 05:54:27 pm »
Can Ttimer be used only for a GUI application or also in console applications?
You have several options for a console timer:
1. TTimer: Add LCL to the required packages(project inspector)
2 TFPTimer: Add fptimer to the uses, LCL is not needed
3. TThread: Measure time inside a thread, like this:
Code: Pascal  [Select][+][-]
  1. unit uThreadTimer;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, lclintf;
  9.  
  10. type
  11.   TOnTimer = procedure(Sender: TObject) of object;
  12.  
  13.   { TThreadTimer }
  14.  
  15.   TThreadTimer = class(TThread)
  16.   private
  17.     FTime: QWORD;
  18.     FInterval: Cardinal;
  19.     FOnTimer: TOnTimer;
  20.     FEnabled: Boolean;
  21.     procedure DoOnTimer;
  22.   protected
  23.     procedure Execute; override;
  24.   public
  25.     property OnTimer: TOnTimer read FOnTimer write FOnTimer;
  26.     property Interval: Cardinal read FInterval write FInterval;
  27.     property Enabled: Boolean read FEnabled write FEnabled;
  28.     procedure StopTimer;
  29.     procedure StartTimer;
  30.     constructor Create(CreateSuspended: Boolean);
  31.     destructor Destroy; override;
  32.   end;
  33.  
  34.  
  35. implementation
  36.  
  37. constructor TThreadTimer.Create(CreateSuspended: Boolean);
  38. begin
  39.   inherited Create(CreateSuspended);
  40.   FInterval := 1000;
  41.   FreeOnTerminate := True;
  42.   FEnabled := False;
  43. end;
  44.  
  45. destructor TThreadTimer.Destroy;
  46. begin
  47.   //
  48.   inherited Destroy;
  49. end;
  50.  
  51. procedure TThreadTimer.DoOnTimer;
  52. begin
  53.   if Assigned(FOnTimer) then
  54.     FOnTimer(Self);
  55. end;
  56.  
  57. procedure TThreadTimer.Execute;
  58. begin
  59.   while not Terminated do
  60.   begin
  61.     Sleep(1);
  62.     if (GetTickCount64 - FTime > FInterval) and (FEnabled) then
  63.     begin
  64.       FTime := GetTickCount64;
  65.       Synchronize(@DoOnTimer);
  66.     end;
  67.   end;
  68. end;
  69.  
  70. procedure TThreadTimer.StopTimer;
  71. begin
  72.   FEnabled := False;
  73. end;
  74.  
  75. procedure TThreadTimer.StartTimer;
  76. begin
  77.   FTime := GetTickCount64;
  78.   FEnabled := True;
  79.   if Self.Suspended then
  80.     Start;
  81. end;
  82. end.

Fred vS

  • Hero Member
  • *****
  • Posts: 2214
    • StrumPract is the musicians best friend
Re: Ttimer in console application
« Reply #3 on: March 03, 2021, 05:58:47 pm »
Can Ttimer be used only for a GUI application or also in console applications?

Like MarkMLI explained, no (or more complicated).

But you may use a TFPTimer from fptimer.pp unit:

Here demo from fpc/packages/fcl-base/examples/testtimer.pp

Code: Pascal  [Select][+][-]
  1. {$mode objfpc}
  2. {$H+}
  3. program testtimer;
  4.  
  5. uses
  6. {$ifdef unix}
  7.   cthreads,
  8. {$endif}
  9.   sysutils,classes,custapp,fptimer;
  10.  
  11. Type
  12.   TTestTimerApp = Class(TCustomApplication)
  13.   Private
  14.     FTimer : TFPTimer;
  15.     FCount : Integer;
  16.     FTick : Integer;
  17.     N : TDateTime;
  18.   Public  
  19.     Procedure DoRun; override;
  20.     Procedure DoTick(Sender : TObject);
  21.   end;
  22.  
  23. Procedure TTestTimerApp.DoRun;
  24.  
  25. begin
  26.   FTimer:=TFPTimer.Create(Self);
  27.   FTimer.Interval:=100;
  28.   FTimer.OnTimer:=@DoTick;
  29.   FTimer.Enabled:=True;
  30.   Try
  31.     FTick:=0;
  32.     FCount:=0;
  33.     N:=Now;
  34.     While (FCount<10) do
  35.       begin
  36.       Inc(FTick);
  37.       Sleep(1);
  38.       CheckSynchronize; // Needed, because we are not running in a GUI loop.
  39.       end;
  40.   Finally
  41.     FTimer.Enabled:=False;
  42.     FreeAndNil(FTimer);
  43.   end;
  44.   Terminate;
  45. end;
  46.  
  47. Procedure TTestTimerApp.DoTick(Sender : TObject);
  48.  
  49. Var
  50.   D : TDateTime;
  51.  
  52. begin
  53.   Inc(FCount);
  54.   D:=Now-N;
  55.   Writeln('Received timer event ',FCount,' after ',FTick,' ticks. (Elapsed time: ',FormatDateTime('ss.zzz',D),')');
  56.   FTick:=0;
  57.   N:=Now;
  58. end;
  59.        
  60.  
  61. begin
  62.   With TTestTimerApp.Create(Nil) do
  63.     Try
  64.       Run
  65.     finally
  66.       Free;
  67.     end;  
  68. end.
  69.  

[EDIT] Ooops, GetMem was faster....


« Last Edit: March 03, 2021, 06:10:25 pm by Fred vS »
I use Lazarus 2.0.6 32/64 and FPC 3.2.0 32/64 on Debian 10.2 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64 and Mac OS X Snow Leopard 32.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt, Carbon.

https://github.com/fredvs
https://gitlab.com/fredvs

simsee

  • Jr. Member
  • **
  • Posts: 82
Re: Ttimer in console application
« Reply #4 on: March 03, 2021, 06:17:33 pm »
My application must be cross platform.  Thanks for the replies

Fred vS

  • Hero Member
  • *****
  • Posts: 2214
    • StrumPract is the musicians best friend
Re: Ttimer in console application
« Reply #5 on: March 03, 2021, 06:23:14 pm »
My application must be cross platform.

Hello.

TFPTimer is cross platform and GetMem demo too.
I use Lazarus 2.0.6 32/64 and FPC 3.2.0 32/64 on Debian 10.2 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64 and Mac OS X Snow Leopard 32.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt, Carbon.

https://github.com/fredvs
https://gitlab.com/fredvs

 

TinyPortal © 2005-2018