Recent

Author Topic: [SOLVED] Terminate App Console  (Read 2389 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: 639
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: 3099
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.
The only true wisdom is knowing you know nothing

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: 2921
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.8/FPC 3.0.4 - 32/64 bits on:
(K|L|X)Ubuntu 12..18, Windows XP, 7, 10 and 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: 10190
Re: Terminate App Console
« Reply #8 on: June 23, 2019, 05:03:57 pm »
ctrl-c
I am more like donkey than shrek

lucamar

  • Hero Member
  • *****
  • Posts: 2921
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.8/FPC 3.0.4 - 32/64 bits on:
(K|L|X)Ubuntu 12..18, Windows XP, 7, 10 and 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: 2921
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.8/FPC 3.0.4 - 32/64 bits on:
(K|L|X)Ubuntu 12..18, Windows XP, 7, 10 and 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

 

TinyPortal © 2005-2018