Recent

Author Topic: [SOLVED] Terminate App Console  (Read 2071 times)

systemgvp

  • New Member
  • *
  • Posts: 28
[SOLVED] Terminate App Console
« on: June 22, 2019, 08:11:47 pm »
I've make this quicky application console, but How can I stop (example Q press) with normal key?

Code: Pascal  [Select]
  1. program project1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. uses
  6.   cthreads,
  7.   Classes, SysUtils, CustApp,
  8.   { you can add units after this }
  9.   fpTimer;
  10.  
  11. type
  12.  
  13.   { TMyApplication }
  14.  
  15.   TMyApplication = class(TCustomApplication)
  16.   protected
  17.     procedure DoRun; override;
  18.   public
  19.     Timer1: TFPTimer;
  20.     constructor Create(TheOwner: TComponent); override;
  21.     destructor Destroy; override;
  22.     procedure WriteHelp; virtual;
  23.     procedure Timer1Exec( Sender : TObject );
  24.   end;
  25.  
  26. { TMyApplication }
  27.  
  28. procedure TMyApplication.Timer1Exec( Sender : TObject );
  29. begin
  30.   //codice da far eseguire al timer
  31.   writeln('testo timer: '+TimeToStr(Time));
  32. end;
  33.  
  34. procedure TMyApplication.DoRun;
  35. var
  36.   ErrorMsg: String;
  37. begin
  38.   // quick check parameters
  39.   ErrorMsg := CheckOptions('h', 'help');
  40.   if ErrorMsg <> '' then begin
  41.     ShowException(Exception.Create(ErrorMsg));
  42.     Terminate;
  43.     Exit;
  44.   end;
  45.  
  46.   // parse parameters
  47.   if HasOption('h', 'help') then begin
  48.     WriteHelp;
  49.     Terminate;
  50.     Exit;
  51.   end;
  52.  
  53.   { add your program here }
  54.  
  55.   //avvia il Timer
  56.   timer1.StartTimer;
  57.   while true do CheckSynchronize;
  58.  
  59.   // stop program loop
  60.   Terminate;
  61. end;
  62.  
  63. constructor TMyApplication.Create(TheOwner: TComponent);
  64. begin
  65.   inherited Create(TheOwner);
  66.   StopOnException := True;
  67. end;
  68.  
  69. destructor TMyApplication.Destroy;
  70. begin
  71.   inherited Destroy;
  72. end;
  73.  
  74. procedure TMyApplication.WriteHelp;
  75. begin
  76.   { add your help code here }
  77.   writeln('Usage: ', ExeName, ' -h');
  78. end;
  79.  
  80. var
  81.   Application: TMyApplication;
  82. begin
  83.   Application := TMyApplication.Create(nil);
  84.   Application.Title := 'My Application';
  85.  
  86.   //crea il Timer
  87.   Application.Timer1 := TFPTimer.Create(nil);
  88.   Application.Timer1.Enabled := True;
  89.   Application.Timer1.interval := 1000;
  90.   Application.Timer1.onTimer := @Application.Timer1Exec;
  91.  
  92.   Application.Run;
  93.   Application.Free;
  94. end.
  95.  
« Last Edit: June 25, 2019, 11:52:36 am by systemgvp »

SymbolicFrank

  • Hero Member
  • *****
  • Posts: 635
Re: Terminate App Console
« Reply #1 on: June 22, 2019, 10:33:35 pm »
Exit TMyApplication.DoRun.

systemgvp

  • New Member
  • *
  • Posts: 28
Re: Terminate App Console
« Reply #2 on: June 22, 2019, 10:38:43 pm »
yes, but how can I say "if q is pressed do this"?

jamie

  • Hero Member
  • *****
  • Posts: 1997
Re: Terminate App Console
« Reply #3 on: June 22, 2019, 10:55:22 pm »
use TApplication instead of TcustomApplication as your base..

and assign the OnUserInput event...

you can then monitor all kinds of stuff.

systemgvp

  • New Member
  • *
  • Posts: 28
Re: Terminate App Console
« Reply #4 on: June 22, 2019, 11:33:53 pm »
forgive me, can you give me an example please?

I'm starting to develop with Lazarus and the console now.

JimD

  • Jr. Member
  • **
  • Posts: 62
Re: Terminate App Console
« Reply #5 on: June 23, 2019, 12:25:13 am »
Below is the default code created with: Lazarus, New Project, Console Application.
I added the quit option as an example.
My Config: Win10-64, lazarus-2.0.2-fpc-3.0.4-win64

Code: Pascal  [Select]
  1. procedure TMyApplication.DoRun;
  2. var
  3.   ErrorMsg: String;
  4. begin
  5.   // quick check parameters
  6.  
  7.   //quit option added
  8.   //ErrorMsg:=CheckOptions('h', 'help');
  9.   ErrorMsg:=CheckOptions('h q', 'help quit');
  10.   if ErrorMsg<>'' then begin
  11.     ShowException(Exception.Create(ErrorMsg));
  12.     Terminate;
  13.     Exit;
  14.   end;
  15.  
  16.   // parse parameters
  17.   if HasOption('h', 'help') then begin
  18.     WriteHelp;
  19.     Terminate;
  20.     Exit;
  21.   end;
  22.  
  23.   { add your program here }
  24.  
  25.   //quit option added
  26.   if HasOption('q', 'quit') then begin
  27.     writeln('Quit.');
  28.     Terminate;
  29.     Exit;
  30.   end;
  31.  
  32.   // stop program loop
  33.   Terminate;
  34. end;
  35.  

lucamar

  • Hero Member
  • *****
  • Posts: 2025
Re: Terminate App Console
« Reply #6 on: June 23, 2019, 01:24:05 am »
yes, but how can I say "if q is pressed do this"?

Do you mean how to see whether "Q" was pressed?

In a console application, use the keyboard unit. Look for GetKeyEvent in the RTL docs: it has an example that shows what kind of key-event you got and the loop (handily, for you) is exited when you press 'Q', so you get to see how that is done ;D
Turbo Pascal 3 CP/M - Amstrad PCW 8256 (512 KB !!!) :P
Lazarus 2.0.2/2.0.4  - FPC 3.0.4 on:
(K|L)Ubuntu 12..16, Windows XP SP3, various DOSes.

systemgvp

  • New Member
  • *
  • Posts: 28
Re: Terminate App Console
« Reply #7 on: June 23, 2019, 04:28:57 pm »
thanks lucamar, but if I insert "GetKeyEvent" in function "TMyApplication.Timer1Exec", He wait read one key and block the function. But I search a method for don't block the function.

Thaddy

  • Hero Member
  • *****
  • Posts: 8967
Re: Terminate App Console
« Reply #8 on: June 23, 2019, 05:03:57 pm »
ctrl-c
Most people that want to use threading should learn to patch their jeans first: use a needle.

lucamar

  • Hero Member
  • *****
  • Posts: 2025
Re: Terminate App Console
« Reply #9 on: June 23, 2019, 06:13:02 pm »
thanks lucamar, but if I insert "GetKeyEvent" in function "TMyApplication.Timer1Exec", He wait read one key and block the function. But I search a method for don't block the function.

You didn't read the docs, did you?. In the page about GetKeyEvent it clearly says:
Quote from: Reference for unit 'keyboard' (rtl)
GetKeyEvent returns the last keyevent if it is available, or waits for one if none is available. A non-blocking version is available in PollKeyEvent.

ETA: Here is a (quick) example of how it could be done:

Code: Pascal  [Select]
  1. function UserPressed(const TestChar: Char): boolean;
  2. var
  3.   Key: TKeyEvent;
  4. begin
  5.   Result := False;
  6.   if PollKeyEvent <> 0 then begin
  7.     Key := TranslateKyEvent(GetKeyEvent);
  8.     Result := (GetKeyEventFlags(Key) = kbASCII)
  9.               and (GetKeyEventChar = TestChar);
  10.   end;
  11. end;

Call it for example with:
Code: Pascal  [Select]
  1. if UserPressed('q') then begin
  2.   Terminate;
  3.   Exit;
  4. end;

or, in your case, with:
Code: Pascal  [Select]
  1.   repeat
  2.     CheckSynchronize;
  3.   until UserPressed('q');

Remember to call InitKeyboard and DoneKeyboard at the appropiate places!!!
« Last Edit: June 23, 2019, 06:39:47 pm by lucamar »
Turbo Pascal 3 CP/M - Amstrad PCW 8256 (512 KB !!!) :P
Lazarus 2.0.2/2.0.4  - FPC 3.0.4 on:
(K|L)Ubuntu 12..16, Windows XP SP3, various DOSes.

systemgvp

  • New Member
  • *
  • Posts: 28
Re: Terminate App Console
« Reply #10 on: June 24, 2019, 03:10:39 pm »
thanks, this code work. I share it to help someone with my same problem

Code: Pascal  [Select]
  1. program semaforologica;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. uses
  6.   cthreads,
  7.   Classes, SysUtils, CustApp,
  8.   { you can add units after this }
  9.   fpTimer, Crt, keyboard;
  10.  
  11. type
  12.  
  13.   { semaforo_logica }
  14.  
  15.   semaforo_logica = class(TCustomApplication)
  16.   protected
  17.     procedure DoRun; override;
  18.   public
  19.     Timer1: TFPTimer;
  20.     VeicoliSuArchi : array[0..7] of integer;
  21.     constructor Create(TheOwner: TComponent); override;
  22.     destructor Destroy; override;
  23.     procedure WriteHelp; virtual;
  24.     procedure Timer1Exec( Sender : TObject );
  25.   end;
  26.  
  27. { semaforo_logica }
  28.  
  29. function LetturaTastoPremuto(const TestChar: Char): boolean;
  30. var Key: TKeyEvent;
  31. begin
  32.   Result := False;
  33.   if PollKeyEvent <> 0 then begin
  34.     Key := TranslateKeyEvent(GetKeyEvent);
  35.     Result := (GetKeyEventFlags(Key) = kbASCII) and (GetKeyEventChar(Key) = TestChar);
  36.   end;
  37. end;
  38.  
  39. procedure semaforo_logica.DoRun;
  40. var ErrorMsg: String;
  41. begin
  42.   // quick check parameters
  43.   ErrorMsg := CheckOptions('h', 'help');
  44.   if ErrorMsg <> '' then begin
  45.     ShowException(Exception.Create(ErrorMsg));
  46.     Terminate;
  47.     Exit;
  48.   end;
  49.  
  50.   // parse parameters
  51.   if HasOption('h', 'help') then begin
  52.     WriteHelp;
  53.     Terminate;
  54.     Exit;
  55.   end;
  56.  
  57.   //avvia il Timer
  58.   timer1.StartTimer;
  59.   repeat
  60.     CheckSynchronize;
  61.   until LetturaTastoPremuto('q');
  62.  
  63.   // stop program loop
  64.   Terminate;
  65. end;
  66.  
  67. constructor semaforo_logica.Create(TheOwner: TComponent);
  68. begin
  69.   inherited Create(TheOwner);
  70.   StopOnException := True;
  71. end;
  72.  
  73. destructor semaforo_logica.Destroy;
  74. begin
  75.   inherited Destroy;
  76. end;
  77.  
  78. procedure semaforo_logica.WriteHelp;
  79. begin
  80.   { add your help code here }
  81.   writeln('Usage: ', ExeName, ' -h');
  82.   writeln('aiuto 1');
  83.   writeln('aiuto 2');
  84. end;
  85.  
  86. procedure semaforo_logica.Timer1Exec( Sender : TObject );
  87. begin
  88.   //pulisce la console
  89.   ClrScr;
  90.   //codice da far eseguire al timer
  91.   writeln('Time: '+TimeToStr(Time));
  92.   writeln('');
  93.  
  94.   { add your program here }
  95.  
  96.   //controlla se terminare l'applicazione
  97.   if LetturaTastoPremuto('q') then
  98.   begin
  99.     writeln('Gestore semaforo: TERMINATO');
  100.     Terminate;
  101.     Exit;
  102.   end;
  103. end;
  104.  
  105. var
  106.   Application: semaforo_logica;
  107. begin
  108.   Application := semaforo_logica.Create(nil);
  109.   Application.Title:='Test timer';
  110.   //crea il Timer
  111.   Application.Timer1 := TFPTimer.Create(nil);
  112.   Application.Timer1.Enabled := True;
  113.   Application.Timer1.interval := 1000;
  114.   Application.Timer1.onTimer := @Application.Timer1Exec;
  115.   //avvia l'applicazione
  116.   Application.Run;
  117.   Application.Free;
  118. end.
  119.  

But He work without "InitKeyboard and DoneKeyboard". If he works, better not touch!  ;)

lucamar

  • Hero Member
  • *****
  • Posts: 2025
Re: Terminate App Console
« Reply #11 on: June 24, 2019, 05:51:16 pm »
But He work without "InitKeyboard and DoneKeyboard". If he works, better not touch!  ;)

Rather "learn to defend yourself before they come for you" :)

Without Init/DoneKeyboard your program will very possibly behave erratically in, for example, Linux. You should at least do this:

Code: Pascal  [Select]
  1. procedure semaforo_logica.DoRun;
  2. var ErrorMsg: String;
  3. begin
  4.   // quick check parameters
  5.   ErrorMsg := CheckOptions('h', 'help');
  6.   if ErrorMsg <> '' then begin
  7.     ShowException(Exception.Create(ErrorMsg));
  8.     Terminate;
  9.     Exit;
  10.   end;
  11.  
  12.   // parse parameters
  13.   if HasOption('h', 'help') then begin
  14.     WriteHelp;
  15.     Terminate;
  16.     Exit;
  17.   end;
  18.  
  19.   InitKeyboard;
  20.   try
  21.     //avvia il Timer
  22.     timer1.StartTimer;
  23.     repeat
  24.       CheckSynchronize;
  25.     until LetturaTastoPremuto('q');
  26.   finally
  27.     DoneKeyboard;
  28.   end;
  29.  
  30.   // stop program loop
  31.   Terminate;
  32. end;
Turbo Pascal 3 CP/M - Amstrad PCW 8256 (512 KB !!!) :P
Lazarus 2.0.2/2.0.4  - FPC 3.0.4 on:
(K|L)Ubuntu 12..16, Windows XP SP3, various DOSes.

systemgvp

  • New Member
  • *
  • Posts: 28
Re: Terminate App Console
« Reply #12 on: June 25, 2019, 11:52:19 am »
Thanks lucamar, I'added your code