Firemonkey - umístění aplikace do popředí

[age.new]

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.

[KarelHorky]

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.

[age.new]

Áha ... to vyzkouším. Děkuji.