Autor Téma: Firemonkey - umístění aplikace do popředí  (Přečteno 257 krát)

Offline age.new

  • Plnoletý
  • ***
  • Příspěvků: 234
  • Karma: 0
Firemonkey - umístění aplikace do popředí
« kdy: 21-09-2020, 15:31:47 »
Vážená komunito,

narazil jsem na problém, který u VCL není, pouze u Firemonkey. Pomocí Mutex si hlídám, zda již aplikace běží (povoluji jen jednu instanci). Pokud ano, získám její handle a snažím se ji umístit do popředí. Z nějakého důvodu posunutí do popředí nefunguje. Zkoušel jsem více způsobů nalezených na netu (např. ShowWindow atd.), ale prostě nic nefunguje. Handl aplikace existuje. Napadá někoho proč?

Kód: Delphi [Vybrat]
  1. var
  2.   Mutex: THandle;
  3.   H: HWND;
  4. begin
  5.   Mutex := CreateMutex(nil, true, PChar('MyApp'));
  6.   try
  7.     if (Mutex <> 0) and (GetLastError = 0) then
  8.     begin
  9.       Application.Initialize;
  10.       Application.CreateForm(TFormMain, FormMain);
  11.       Application.Run;
  12.     end
  13.     else
  14.     begin
  15.       H := FindWindow(nil, PChar('MyApp'));
  16.       if H <> 0 then
  17.       begin
  18.         BringWindowToTop(H);
  19.         SetForegroundWindow(H);
  20.       end
  21.       else TDialogService.MessageDialog('Application is already running!', TMsgDlgType.mtError, [TMsgDlgBtn.mbOK], TMsgDlgBtn.mbOK, 0, nil);
  22.     end;
  23.   finally
  24.     if Mutex <> 0 then CloseHandle(Mutex);
  25.   end;
  26.  


Děkuji.

Offline KarelHorky

  • Plnoletý
  • ***
  • Příspěvků: 219
  • Karma: 9
    • Verze Delphi: XE6, Delphi 10.2 Tokyo
Re:Firemonkey - umístění aplikace do popředí
« Odpověď #1 kdy: 22-09-2020, 12:40:37 »
Abych se seznámil s Firemonkey, tak jsem si někdy okolo roku 2014 v Delphi XE5 vytvořil aplikaci pro odpočet času. Po vypršení času se aplikace měla aktivovat a ukázat nastavené hlášení. Měl jsem stejný problém, aktivovat aplikaci do popředí. Podařilo se mi tehdy najít řešení, v podstatě šlo o to, zjistit handle aplikace, ne hlavního okna:

Kód: Delphi [Vybrat]
  1. var
  2.   hAppHandle: hwnd;
  3.  
  4. function EnumWindowCallback(hWnd: hWnd; lParam: lParam): BOOL; stdcall;
  5.  
  6.  
  7. implementation
  8.  
  9. {$R *.fmx}
  10.  
  11. function EnumWindowCallback(hWnd: hWnd; lParam: lParam): BOOL; stdcall;
  12. const
  13.   FMXClassName = 'TFMAppClass';
  14. var
  15.   ProcessID: DWORD;
  16.   ClassName: string;
  17.   ClassNameLength: NativeInt;
  18. begin
  19.   // XE4 (possibly others) has a phantom TFMAppClass window
  20.   if (GetWindowThreadProcessId(hWnd, ProcessID) = GetCurrentThreadId) and
  21.     (ProcessID = GetCurrentProcessId) then
  22.   begin
  23.     // Thanks to the ubiquitous David Heffernan... http://stackoverflow.com/questions/7096542/collect-all-active-window-class-names
  24.     SetLength(ClassName, 256);
  25.     ClassNameLength := GetClassName(hWnd, PChar(ClassName), Length(ClassName));
  26.     if ClassNameLength = 0 then
  27.       RaiseLastOSError;
  28.     SetLength(ClassName, ClassNameLength);
  29.     if ClassName = FMXClassName then
  30.     begin
  31.       // Found. store and return false to stop enumerating
  32.       hAppHandle := hWnd;
  33.       Exit(False);
  34.     end;
  35.   end;
  36.   Result := True; // Fallthrough, keep iterating
  37. end;
  38.  
  39.  
  40. procedure TwndCasovac5.Blikni;
  41. begin
  42.   if IsIconic(hAppHandle) then begin
  43.     ShowWindow(hAppHandle, SW_SHOWNOACTIVATE);
  44.   end;
  45.   SetWindowPos(hAppHandle, HWND_TOPMOST, 0, 0, 0, 0,
  46.                SWP_NOMOVE or SWP_NOACTIVATE or SWP_NOSIZE);
  47.   SetWindowPos(hAppHandle, HWND_NOTOPMOST, 0, 0, 0, 0,
  48.                SWP_NOMOVE or SWP_NOACTIVATE or SWP_NOSIZE);
  49. end;
  50.  
  51. procedure TwndCasovac5.FormCreate(Sender: TObject);
  52. begin
  53.     // find app handle
  54.   EnumWindows(@EnumWindowCallback, 0);
  55. end;
  56.  
Ve FormCreate se zjistí handle aplikace. Pak se nějak spustí časovač a až vyprší čas, zavolá se procedura Blikni a ta dostane okno do popředí.
Aplikace je funkční dodnes, ale nevím, jestli v aktuálních Delphi půjde zkompilovat a bude fungovat. Víc ti k tomu neřeknu, protože ve Firemonkey jsem už nic dalšího nedělal.
K.
Win10 Prof 64b, Firebird 2.5

Offline age.new

  • Plnoletý
  • ***
  • Příspěvků: 234
  • Karma: 0
Re:Firemonkey - umístění aplikace do popředí
« Odpověď #2 kdy: 24-09-2020, 10:26:56 »
Áha ... to vyzkouším. Děkuji.