Recent

Author Topic: app always on top [solved]  (Read 6280 times)

440bx

  • Hero Member
  • *****
  • Posts: 2772
Re: app always on top
« Reply #15 on: January 16, 2022, 01:24:06 pm »
I've seen what you want to do done... for instance, there are plenty of places where you have these "help yourself" terminals, e.g, self checkout in grocery stores, self checking in airports, etc.  Many of these run plain, standard Windows and they are limited to running that one app without interruption.  That said, there usually isn't a normal keyboard that would allow a user to get the O/S's attention (such as Alt-Tab, Ctrl-Esc, etc)

What you want to do is possible and, there is sanctioned way of doing it (hacks/tricks are not a good idea in this case.)  Obviously, if you knew how it's done, I'd would offer it but, I don't.
FPC v3.0.4 and Lazarus 1.8.2 on Windows 7 64bit.

Soner

  • Sr. Member
  • ****
  • Posts: 274
Re: app always on top
« Reply #16 on: January 16, 2022, 02:01:04 pm »
I needed it for our kiosk application so I made it last year. The user cant't even call taskmanager with [ctrl+alt+del] keys.
have fun:
Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
  16.     procedure FormCreate(Sender: TObject);
  17.     procedure FormDeactivate(Sender: TObject);
  18.   private
  19.  
  20.   public
  21.  
  22.   end;
  23.  
  24. var
  25.   Form1: TForm1;
  26.  
  27. implementation
  28.  
  29. uses
  30.   LCLType {$IfDef WINDOWS},windows{$EndIf};
  31.  
  32. {$R *.lfm}
  33.  
  34. procedure ActivateForm(Handle: HWND);
  35. begin
  36. {$IfDef WINDOWS}
  37. SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0,  SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
  38. {$else}
  39. #todo
  40. {$EndIf}
  41. end;
  42.  
  43. { TForm1 }
  44.  
  45. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: boolean);
  46. begin
  47.   CanClose:=MessageDlg('Do you want close it?'+LineEnding+''+LineEnding+'(You can ask for password)', mtWarning, [mbYes, mbNo],0) = mrYes;
  48. end;
  49.  
  50. procedure TForm1.FormCreate(Sender: TObject);
  51. begin
  52.   BorderStyle:=bsNone;
  53.   WindowState:=wsMaximized;
  54.   Application.OnDeactivate:=@FormDeactivate;
  55.   Application.OnMinimize:=@FormDeactivate;
  56. end;
  57.  
  58. procedure TForm1.FormDeactivate(Sender: TObject);
  59. begin
  60.   //funktioniert nur im debugmodus: Application.MainForm.BringToFront;
  61.  
  62.   if WindowState=wsMinimized then WindowState:=wsMaximized;
  63.   ActivateForm(Handle);
  64. end;
  65.  
  66. end.
  67.  

And example project included too. Tested on Windows 7, Windows 10.
Edit:
Press [alt]+[f4] to close the application, i forget to put a button.
« Last Edit: January 16, 2022, 02:02:42 pm by Soner »

winni

  • Hero Member
  • *****
  • Posts: 3053
Re: app always on top
« Reply #17 on: January 16, 2022, 03:00:30 pm »
Hi!

For the kiosk mode use this:

 
Code: Pascal  [Select][+][-]
  1. WindowState:=wsFullScreen;

Winni

diego bertotti

  • Jr. Member
  • **
  • Posts: 91
Re: app always on top
« Reply #18 on: January 16, 2022, 04:09:13 pm »
Thanks for replys

But need top and focus

Working on it

Zoran

  • Hero Member
  • *****
  • Posts: 1726
    • http://wiki.lazarus.freepascal.org/User:Zoran
Re: app always on top
« Reply #19 on: January 16, 2022, 08:29:25 pm »
Try the attached application, see how it uses GetKeyState function.
Here (Windows 10), it works same if application is focused or not.
Try it!

diego bertotti

  • Jr. Member
  • **
  • Posts: 91
Re: app always on top [solved]
« Reply #20 on: January 17, 2022, 03:08:26 pm »
hi

finally i found it

check this

https://stackoverflow.com/questions/688337/how-do-i-force-my-app-to-come-to-the-front-and-take-focus

just a simple conversion c to pascal.

thanks to all

diego bertotti

  • Jr. Member
  • **
  • Posts: 91
Re: app always on top [solved]
« Reply #21 on: January 21, 2022, 01:40:27 pm »
hi, again its me

just to share with all.

This code works almost perfectly. It fails only in a few cases of clicks combinations


Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
  9.   windows;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     CheckBox1: TCheckBox;
  17.     CheckGroup1: TCheckGroup;
  18.     Memo1: TMemo;
  19.     Timer1: TTimer;
  20.     procedure CheckGroup1ItemClick(Sender: TObject; Index: integer);
  21.     procedure FormActivate(Sender: TObject);
  22.     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
  23.     procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
  24.     procedure FormCreate(Sender: TObject);
  25.     procedure FormDeactivate(Sender: TObject);
  26.     procedure FormDestroy(Sender: TObject);
  27.     procedure FormWindowStateChange(Sender: TObject);
  28.     procedure Timer1Timer(Sender: TObject);
  29.   private
  30.  
  31.   public
  32.  
  33.  
  34.   end;
  35.  
  36.   const
  37.   LSFW_LOCK = 1;
  38.   LSFW_UNLOCK = 2;
  39.  
  40.  
  41. var
  42.   Form1: TForm1;
  43.   function LockSetForegroundWindow(LSFW_UNLOCK:UINT):WINBOOL; external 'user32' name 'LockSetForegroundWindow';
  44.  
  45. implementation
  46.  
  47.  
  48.  
  49.  
  50. {$R *.lfm}
  51.  
  52. { TForm1 }
  53.  
  54. procedure ActivateForm(Handle: HWND);
  55. var
  56.   dwCurrentThread: DWORD;
  57.   dwFGThread: DWORD;
  58. begin
  59.  
  60. dwCurrentThread := GetCurrentThreadId();
  61. dwFGThread      := GetWindowThreadProcessId(GetForegroundWindow(), NIL);
  62.  
  63.  
  64. AttachThreadInput(dwCurrentThread, dwFGThread, TRUE);
  65.  
  66. // Possible actions you may wan to bring the window into focus.
  67. {SetForegroundWindow(handle);
  68. LockSetForegroundWindow(1); }
  69. if SetForegroundWindow(handle) then
  70.   begin
  71.   form1.memo1.lines.add('FormActivate-SetForegroundWindow funcionó');
  72.   if LockSetForegroundWindow(LSFW_LOCK) then
  73.     form1.memo1.lines.add('FormActivate-LockSetForegroundWindow funcionó')
  74.     else
  75.     form1.memo1.lines.add('FormActivate-LockSetForegroundWindow no funcionó ' + inttostr(getlasterror));
  76.   end
  77.   else
  78.   begin
  79.   form1.memo1.lines.add('FormActivate-SetForegroundWindow falló')
  80.   end;
  81.  
  82.  
  83. //SetCapture(handle);
  84. //Sets the mouse capture to the specified window belonging to the current thread
  85.  
  86. //SetFocus(handle);
  87. //Sets the keyboard focus to the specified window
  88.  
  89. //SetActiveWindow(handle);
  90. //Activates a window. The window must be attached to the calling thread's message queue.
  91.  
  92. EnableWindow(handle, TRUE);
  93. //Enables or disables mouse and keyboard input to the specified window or control.
  94.  
  95. AttachThreadInput(dwCurrentThread, dwFGThread, FALSE);
  96.  
  97.  
  98. {$IfDef WINDOWS}
  99. {if SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW) then
  100.  form1.memo1.lines.add('SetWindowsPos funcionó')
  101.  else
  102.  form1.memo1.lines.add('SetWindowsPos no funcionó') ;
  103.  form1.formactivate(form1);  }
  104.  
  105.  {$else}
  106. #todo
  107. {$EndIf}
  108. end;
  109.  
  110. procedure TForm1.FormActivate(Sender: TObject);
  111. begin
  112.  
  113.  
  114. end;
  115.  
  116. procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
  117. begin
  118.   LockSetForegroundWindow(2);
  119. end;
  120.  
  121. procedure TForm1.CheckGroup1ItemClick(Sender: TObject; Index: integer);
  122. begin
  123.     case index of
  124.   9: begin
  125.      Application.terminate;
  126.      end;
  127.   0..8: begin
  128.      inputbox('Opción ' + IntToSTR(index+1), 'cantidad de opción '+ intToStr(index+1),'1');
  129.      end;
  130.     end;
  131. end;
  132.  
  133. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: boolean);
  134. begin
  135.  
  136. end;
  137.  
  138. procedure TForm1.FormCreate(Sender: TObject);
  139. begin
  140.     Application.OnDeactivate:=@FormDeactivate;
  141.     Application.OnMinimize:=@FormDeactivate;
  142. end;
  143.  
  144. procedure TForm1.FormDeactivate(Sender: TObject);
  145. begin
  146.   if WindowState=wsMinimized then WindowState:=wsNormal;
  147.   memo1.lines.add('FormDeactivate-se desactivo');
  148.   ActivateForm(application.Handle);
  149.  
  150. end;
  151.  
  152. procedure TForm1.FormDestroy(Sender: TObject);
  153. begin
  154.   LockSetForegroundWindow(2);
  155. end;
  156.  
  157. procedure TForm1.FormWindowStateChange(Sender: TObject);
  158. begin
  159.  
  160. end;
  161.  
  162. procedure TForm1.Timer1Timer(Sender: TObject);
  163. Var
  164.   hh: Handle;
  165.  
  166. begin
  167.   checkbox1.checked:= not checkbox1.checked;
  168.  
  169. end;
  170.  
  171.  
  172.  
  173. end.

SymbolicFrank

  • Hero Member
  • *****
  • Posts: 935
Re: app always on top [solved]
« Reply #22 on: January 21, 2022, 02:48:55 pm »
Ah, yes. Try such an (industrial, POS or kiosk) app on multiple monitors :)

If you do it on Windows, kill explorer.exe. If the PC is dedicated to your app, change all occurrences of 'shell=explorer.exe' to 'shell=yourapp.exe' in the registry.

diego bertotti

  • Jr. Member
  • **
  • Posts: 91
Re: app always on top [solved]
« Reply #23 on: January 22, 2022, 03:14:22 pm »
now is working locksetforegroundwindow!! the problem was the function call declaration, i missed the clause stdcall.

Code: Pascal  [Select][+][-]
  1. function LockSetForegroundWindow(LSFW_UNLOCK:UINT):WINBOOL; stdcall; external 'user32' name 'LockSetForegroundWindow';
  2.  

searching i found this function too:
Code: Pascal  [Select][+][-]
  1. SwitchToThisWindow(handle);
  2.  

but is not like MS documentation. I'm not full tested yet.

and this topic too:

https://forum.lazarus.freepascal.org/index.php?topic=35282.0
« Last Edit: January 24, 2022, 11:47:21 am by diego bertotti »

 

TinyPortal © 2005-2018