Autor Téma: Systray a FMX  (Přečteno 273 krát)

Offline raul

  • Hrdina
  • ****
  • Příspěvků: 347
  • Karma: 15
    • Verze Delphi: FPC :D
Systray a FMX
« kdy: 27-05-2020, 10:49:46 »
Zdar :)

Potrebuju dostat apliakci do traye (na Win a i na macOS), nasel jsem nejake komponenty https://sivv.com/ape, bohuzel, autor nema na webu demo, dokumentaci nic a samotna komponenta je soucasti baliku vetsiho(takze cena je relativne vyssi). Snazim se z nej vytahnout demo uz tyden, dneska neco poslal (binarku pro macOS), ktera ale nejde ani spustit. Pustil jsem se tedy do toho sam (jak ja nemam rad to GUI) a skoncil +- na knihovne uTray viz nize.

Kód: Delphi [Vybrat]
  1. unit uTray;
  2.  
  3. interface
  4.  
  5. uses
  6. {$IFDEF Windows}
  7.   ShellApi,
  8.   Winapi.Messages,
  9.   FMX.Platform.Win,
  10.   Winapi.Windows,
  11. {$ENDIF}
  12.   FMX.Platform,
  13.   Classes;
  14.  
  15. {$IFDEF Windows}
  16. const
  17.   WM_ICONTRAY = WM_USER + 1;
  18. {$ENDIF}
  19.  
  20.  
  21. type
  22.   tTray = class
  23.   private
  24. {$IFDEF Windows}
  25.     class var OrgWndProc: Pointer;
  26.     class var NewWndProc: Pointer;
  27.     class var TrayIconData: TNotifyIconData;
  28.     class var TrayWnd: HWND;
  29.     class procedure TrayMessage(var Msg: TMessage);// message WM_ICONTRAY;
  30. {$ENDIF}
  31.     class var fOnRightClick: TNotifyEvent;
  32.     class var fOnDoubleClick: TNotifyEvent;
  33.     class var fOnLeftClick: TNotifyEvent;
  34.   protected
  35.  
  36.   public
  37.     class procedure SwitchToTaskBar;
  38.     class procedure SwitchToTray;
  39.     class procedure SwitchTaskTray(const pTask : boolean);
  40.  
  41.     class procedure HideFromTaskbar;
  42.     class procedure ShowOnTaskBar;
  43.     class procedure HideFromSystray;
  44.     class procedure ShowInSystray;
  45.   published
  46.  
  47.     class property OnLeftClick: TNotifyEvent read fOnLeftClick write fOnLeftClick;
  48.     class property OnRightClick: TNotifyEvent read fOnRightClick write fOnRightClick;
  49.     class property OnDoubleClick: TNotifyEvent read fOnDoubleClick write fOnDoubleClick;
  50.  
  51.   end;
  52.  
  53. implementation
  54.  
  55. uses
  56.   FMX.Forms, SysUtils;
  57.  
  58. { tTray }
  59.  
  60. {$IFDEF Windows}
  61. class procedure tTray.TrayMessage(var Msg: TMessage);
  62. begin
  63.   if Msg.Msg = WM_ICONTRAY then
  64.   begin
  65.     case Msg.lParam of
  66.       WM_LBUTTONDOWN:
  67.         begin
  68.            if Assigned(fOnLeftClick) then
  69.              fOnLeftClick(nil);
  70.         end;
  71.       WM_RBUTTONDOWN:
  72.         begin
  73.            if Assigned(fOnRightClick) then
  74.              fOnRightClick(nil);
  75.         end;
  76.       WM_LBUTTONDBLCLK:
  77.       begin
  78.            if Assigned(fOnDoubleClick) then
  79.              fOnDoubleClick(nil);
  80.       end;
  81.     end
  82.   end
  83.   else
  84.     Msg.Result := DefWindowProc(TrayWnd, Msg.Msg, Msg.WParam, Msg.lParam);
  85. end;
  86. {$ENDIF}
  87.  
  88. class procedure tTray.HideFromSystray;
  89. begin
  90. {$IFDEF Windows}
  91.   Shell_NotifyIcon(NIM_DELETE, @TrayIconData);
  92.   DeallocateHWnd(TrayWnd);
  93. {$ENDIF}
  94. end;
  95.  
  96. class procedure tTray.HideFromTaskbar;
  97. {$IFDEF Windows}
  98. var
  99.   AppHandle: HWND;
  100. {$ENDIF}
  101. begin
  102. {$IFDEF Windows}
  103.   AppHandle := FMX.Platform.Win.ApplicationHWND;
  104.   ShowWindow(AppHandle, SW_HIDE);
  105.   SetWindowLong(AppHandle, GWL_EXSTYLE, GetWindowLong(AppHandle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW);
  106. {$ENDIF}
  107. end;
  108.  
  109. class procedure tTray.ShowInSystray;
  110. {$IFDEF Windows}
  111. var
  112.   LInstance : Pointer;
  113. {$ENDIF}
  114. begin
  115. {$IFDEF Windows}
  116.   TrayWnd := AllocateHWnd(TrayMessage);
  117.  
  118.   begin
  119.     TrayIconData.cbSize := SizeOf(TrayIconData);
  120.     TrayIconData.Wnd := TrayWnd;
  121.     TrayIconData.uID := 1;
  122.     TrayIconData.uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
  123.     TrayIconData.uCallbackMessage := WM_ICONTRAY;
  124.     TrayIconData.hIcon := LoadIcon(HInstance, PChar('MAINICON'));
  125.     StrPCopy(TrayIconData.szTip, Application.Title);
  126.   end;
  127.   Shell_NotifyIcon(NIM_ADD, @TrayIconData);
  128. {$ENDIF}
  129. end;
  130.  
  131. class procedure tTray.ShowOnTaskBar;
  132. {$IFDEF Windows}
  133. var
  134.   AppHandle: HWND;
  135. {$ENDIF}
  136. begin
  137. {$IFDEF Windows}
  138.   AppHandle := FMX.Platform.Win.ApplicationHWND; // GetParent(FmxHandleToHWND(AMainForm.Handle));
  139.   ShowWindow(AppHandle, SW_HIDE);
  140.   SetWindowLong(AppHandle, GWL_EXSTYLE, GetWindowLong(AppHandle, GWL_EXSTYLE) and (not WS_EX_TOOLWINDOW));
  141.   ShowWindow(AppHandle, SW_SHOW);
  142. {$ENDIF}
  143. end;
  144.  
  145. class procedure tTray.SwitchTaskTray(const pTask: boolean);
  146. begin
  147. {$IFDEF Windows}
  148.    if pTask then
  149.      SwitchToTaskBar else SwitchToTray;
  150. {$ENDIF}
  151. end;
  152.  
  153. class procedure tTray.SwitchToTaskBar;
  154. begin
  155. {$IFDEF Windows}
  156.    HideFromSystray;
  157.    ShowOnTaskBar;
  158. {$ENDIF}
  159. end;
  160.  
  161. class procedure tTray.SwitchToTray;
  162. begin
  163. {$IFDEF Windows}
  164.    HideFromTaskbar;
  165.    ShowInSystray;
  166. {$ENDIF}
  167. end;
  168.  
  169. initialization
  170.  
  171. finalization
  172. {$IFDEF Windows}
  173.   tTray.HideFromSystray;
  174. {$ENDIF}
  175.  
  176. end.

Pouziti :

Kód: Delphi [Vybrat]
  1. procedure TMainForm.OnTrayLeftClick(Sender : tObject);
  2. begin
  3.    Show;
  4.  end;
  5.  
  6. procedure TMainForm.OnTrayRightClick(Sender : tObject);
  7. begin
  8.    WindowState := TWindowState.wsMinimized;//  Hide;
  9. end;
  10.  
  11. procedure TMainForm.FormCreate(Sender: TObject);
  12. begin
  13.    tTray.ShowInSystray;
  14.    tTray.OnLeftClick := OnTrayLeftClick;
  15.    tTray.OnRightClick := OnTrayRightClick;
  16. end;
  17.  

Co se deje ?
1) Kdyz aplikaci zmensim klasicky, je vse ok. Jakmile kliknu na tray, aplikace se v poradku zobrazi.
2) Dalsi minimalizace (at jiz pres tray, ci v aplikaci hornim tlacitkem) zminimalizuje aplikaci pouze jako dokument desktopu (tzn form nezmizi jen je zmensen vlevo dole na startem)
3) pokud aplikaci obnovim z taskbaru, opet to jednou funguje, dokud nesahnu na tray.

Googlil jsem, ale v mezicase prosly v tomhle delphi zrejme velkym vyvojem, protoze napovedy a rady na starsi XE jiz nefunguji (ShowOnTaskBar, Application.Minimalize, apod)

Nejaka rada pro nedelace GUI ?
Lazarus 1.6.3:), FPC, Intel/Arm, Windows/Linux