1 {
2 *****************************************************************************
3 * gtk3WSTrayIcon.pas *
4 * ------------------ *
5 * *
6 * *
7 *****************************************************************************
8
9 *****************************************************************************
10 This file is part of the Lazarus Component Library (LCL)
11
12 See the file COPYING.modifiedLGPL.txt, included in this distribution,
13 for details about the license.
14 *****************************************************************************
15
16 A unit that uses LibAppIndicator3-1 or libAyatana-AppIndicator3-1 to display a
17 TrayIcon in GTK3. Based on a GTK2 version by Anthony Walter, now works with
18 many common Linux systems "out of the box" or with the addition of one of the
19 above mentioned libraries and possibly gnome-shell-extension-appindicator.
20
21 See Wiki for details and Limitations (Menu only, one Icon only....)
22 Also refer to discussion in ../gtk2/UnityWSCtrls.pas
23 }
24
25
26 unit gtk3wstrayicon;
27
28 interface
29
30 {$mode delphi}
31 uses
32 GLib2, LazGtk3, LazGdkPixbuf2, gtk3widgets,
33 Classes, SysUtils, dynlibs,
34 Graphics, Controls, Forms, ExtCtrls, WSExtCtrls, LCLType, LazUTF8,
35 FileUtil;
36
37 type
38 TGtk3WSTrayIcon = class(TWSCustomTrayIcon)
39 published
Hidenull40 class function Hide(const ATrayIcon: TCustomTrayIcon): Boolean; override;
Shownull41 class function Show(const ATrayIcon: TCustomTrayIcon): Boolean; override;
42 class procedure InternalUpdate(const ATrayIcon: TCustomTrayIcon); override;
GetPositionnull43 class function GetPosition(const {%H-}ATrayIcon: TCustomTrayIcon): TPoint; override;
44 end;
45
46 { Gtk3AppIndicatorInit returns true if a LibAppIndicator3 library has been loaded }
Gtk3AppIndicatorInitnull47 function Gtk3AppIndicatorInit: Boolean;
48
49 implementation
50
51 {X$define DEBUGAPPIND}
52
53 uses gtk3objects; // TGtk3Image
54
55 const
56 libappindicator_3 = 'libappindicator3.so.1'; // Unity or Canonical libappindicator3-1
57 LibAyatanaAppIndicator = 'libayatana-appindicator3.so.1'; // Ayatana - typically called libayatana-appindicator3-1
58 IconThemePath = '/tmp/appindicators/'; // We must write our icon to a file.
59 IconType = 'png';
60
61 type
62 TAppIndicatorCategory = (
63 APP_INDICATOR_CATEGORY_APPLICATION_STATUS,
64 APP_INDICATOR_CATEGORY_COMMUNICATIONS,
65 APP_INDICATOR_CATEGORY_SYSTEM_SERVICES,
66 APP_INDICATOR_CATEGORY_HARDWARE,
67 APP_INDICATOR_CATEGORY_OTHER
68 );
69
70 TAppIndicatorStatus = (
71 APP_INDICATOR_STATUS_PASSIVE,
72 APP_INDICATOR_STATUS_ACTIVE,
73 APP_INDICATOR_STATUS_ATTENTION
74 );
75
76 PAppIndicator = Pointer;
77
78 var
79 { GlobalAppIndicator creation routines }
GTypenull80 app_indicator_get_type: function: GType; cdecl;
dnull81 app_indicator_new: function(id, icon_name: PGChar; category: TAppIndicatorCategory): PAppIndicator; cdecl;
dnull82 app_indicator_new_with_path: function(id, icon_name: PGChar; category: TAppIndicatorCategory; icon_theme_path: PGChar): PAppIndicator; cdecl;
83 { Set properties }
84 app_indicator_set_status: procedure(self: PAppIndicator; status: TAppIndicatorStatus); cdecl;
85 app_indicator_set_attention_icon: procedure(self: PAppIndicator; icon_name: PGChar); cdecl;
86 app_indicator_set_menu: procedure(self: PAppIndicator; menu: PGtkMenu); cdecl;
87 app_indicator_set_icon: procedure(self: PAppIndicator; icon_name: PGChar); cdecl;
88 app_indicator_set_label: procedure(self: PAppIndicator; _label, guide: PGChar); cdecl;
89 app_indicator_set_icon_theme_path: procedure(self: PAppIndicator; icon_theme_path: PGChar); cdecl;
90 app_indicator_set_ordering_index: procedure(self: PAppIndicator; ordering_index: guint32); cdecl;
91 { Get properties }
elfnull92 app_indicator_get_id: function(self: PAppIndicator): PGChar; cdecl;
elfnull93 app_indicator_get_category: function(self: PAppIndicator): TAppIndicatorCategory; cdecl;
elfnull94 app_indicator_get_status: function(self: PAppIndicator): TAppIndicatorStatus; cdecl;
elfnull95 app_indicator_get_icon: function(self: PAppIndicator): PGChar; cdecl;
elfnull96 app_indicator_get_icon_theme_path: function(self: PAppIndicator): PGChar; cdecl;
elfnull97 app_indicator_get_attention_icon: function(self: PAppIndicator): PGChar; cdecl;
elfnull98 app_indicator_get_menu: function(self: PAppIndicator): PGtkMenu; cdecl;
elfnull99 app_indicator_get_label: function(self: PAppIndicator): PGChar; cdecl;
elfnull100 app_indicator_get_label_guide: function(self: PAppIndicator): PGChar; cdecl;
elfnull101 app_indicator_get_ordering_index: function(self: PAppIndicator): guint32; cdecl;
102
103 { TAppIndTrayIconHandle }
104
105 type
106 TAppIndTrayIconHandle = class
107 private
108 FTrayIcon: TCustomTrayIcon;
109 FName: string;
110 FIconName: string;
111 public
112 constructor Create(TrayIcon: TCustomTrayIcon);
113 destructor Destroy; override;
114 procedure Update;
115 end;
116
117
118 var
119 GlobalAppIndicator: PAppIndicator;
120 GlobalIcon: Pointer;
121 GlobalIconPath: string;
122
123 constructor TAppIndTrayIconHandle.Create(TrayIcon: TCustomTrayIcon);
124 var
125 NewIcon: Pointer;
126 begin
127 inherited Create;
128 FTrayIcon := TrayIcon;
129 FName := 'app-' + IntToHex(IntPtr(Application), SizeOf(IntPtr) * 2);
130 NewIcon := {%H-}Pointer(TGtk3Image(FTrayIcon.Icon.Handle).handle);
131 if NewIcon = nil then
132 NewIcon := {%H-}Pointer(Application.Icon.Handle);
133 if NewIcon <> GlobalIcon then
134 begin
135 GlobalIcon := NewIcon;
136 ForceDirectories(IconThemePath);
137 FIconName := FName + '-' + IntToHex({%H-}IntPtr(GlobalIcon), SizeOf(GlobalIcon) * 2);
138 if FileExists(GlobalIconPath) then
139 DeleteFile(GlobalIconPath);
140 GlobalIconPath := IconThemePath + FIconName + '.' + IconType;
141 gdk_pixbuf_save(GlobalIcon, PChar(GlobalIconPath), IconType, nil, [nil]);
142 if GlobalAppIndicator <> nil then
143 app_indicator_set_icon(GlobalAppIndicator, PChar(FIconName));
144 end
145 else
146 FIconName := FName + '-' + IntToHex({%H-}IntPtr(GlobalIcon), SizeOf(GlobalIcon) * 2);
147 { Only the first created AppIndicator is functional }
148 if GlobalAppIndicator = nil then
149 { It seems that icons can only come from files :( }
150 GlobalAppIndicator := app_indicator_new_with_path(PChar(FName), PChar(FIconName),
151 APP_INDICATOR_CATEGORY_APPLICATION_STATUS, IconThemePath);
152 Update;
153 {$ifdef DEBUGAPPIND}
154 case app_indicator_get_status(GlobalAppIndicator) of
155 APP_INDICATOR_STATUS_PASSIVE : writeln('AppInd statis is Passive');
156 APP_INDICATOR_STATUS_ACTIVE : writeln('AppInd status is Active');
157 APP_INDICATOR_STATUS_ATTENTION : writeln('AppInd is Attention');
158 else writeln('AppInd status is unknown');
159 end;
160 {$endif}
161 end;
162
163 destructor TAppIndTrayIconHandle.Destroy;
164 begin
165 { Hide the global AppIndicator }
166 app_indicator_set_status(GlobalAppIndicator, APP_INDICATOR_STATUS_PASSIVE);
167 inherited Destroy;
168 end;
169
170 procedure TAppIndTrayIconHandle.Update;
171 var
172 NewIcon: Pointer;
173 begin
174 NewIcon := {%H-}Pointer(TGTK3Image(FTrayIcon.Icon.Handle).Handle);
175 if NewIcon = nil then
176 NewIcon := {%H-}Pointer(Application.Icon.Handle);
177 if NewIcon <> GlobalIcon then
178 begin
179 GlobalIcon := NewIcon;
180 FIconName := FName + '-' + IntToHex({%H-}IntPtr(GlobalIcon), SizeOf(GlobalIcon) * 2);
181 ForceDirectories(IconThemePath);
182 if FileExists(GlobalIconPath) then
183 DeleteFile(GlobalIconPath);
184 GlobalIconPath := IconThemePath + FIconName + '.' + IconType;
185 gdk_pixbuf_save(GlobalIcon, PChar(GlobalIconPath), IconType, nil, [nil]);
186 { Again it seems that icons can only come from files }
187 app_indicator_set_icon(GlobalAppIndicator, PChar(FIconName));
188 end;
189 { It seems to me you can only set the menu once for an AppIndicator }
190 if (app_indicator_get_menu(GlobalAppIndicator) = nil) and (FTrayIcon.PopUpMenu <> nil) then
191 //app_indicator_set_menu(GlobalAppIndicator, {%H-}PGtkMenu(FTrayIcon.PopUpMenu.Handle));
192 app_indicator_set_menu(GlobalAppIndicator, {%H-}PGtkMenu(TGTK3Menu(FTrayIcon.PopUpMenu.Handle).Widget));
193 app_indicator_set_status(GlobalAppIndicator, APP_INDICATOR_STATUS_ACTIVE);
194 end;
195
196 { TAppIndWSCustomTrayIcon }
197
TGtk3WSTrayIcon.Hidenull198 class function TGtk3WSTrayIcon.Hide(const ATrayIcon: TCustomTrayIcon): Boolean;
199 var
200 T: TAppIndTrayIconHandle;
201 begin
202 if ATrayIcon.Handle <> 0 then
203 begin
204 T := TAppIndTrayIconHandle(ATrayIcon.Handle);
205 ATrayIcon.Handle := 0;
206 T.Free;
207 end;
208 Result := True;
209 end;
210
TGtk3WSTrayIcon.Shownull211 class function TGtk3WSTrayIcon.Show(const ATrayIcon: TCustomTrayIcon): Boolean;
212 var
213 T: TAppIndTrayIconHandle;
214 begin
215 if ATrayIcon.Handle = 0 then
216 begin
217 T := TAppIndTrayIconHandle.Create(ATrayIcon);
218 ATrayIcon.Handle := HWND(T);
219 end;
220 Result := True;
221 end;
222
223 class procedure TGtk3WSTrayIcon.InternalUpdate(const ATrayIcon: TCustomTrayIcon);
224 var
225 T: TAppIndTrayIconHandle;
226 begin
227 if ATrayIcon.Handle <> 0 then
228 begin
229 T := TAppIndTrayIconHandle(ATrayIcon.Handle);
230 T.Update;
231 end;
232 end;
233
TGtk3WSTrayIcon.GetPositionnull234 class function TGtk3WSTrayIcon.GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint;
235 begin
236 Result := Point(0, 0);
237 end;
238
239 { AppIndicatorInit }
240
241 var
242 Loaded: Boolean;
243 Initialized: Boolean;
244
Gtk3AppIndicatorInitnull245 function Gtk3AppIndicatorInit: Boolean;
246 var
247 Module: HModule;
248
TryLoadnull249 function TryLoad(const ProcName: string; var Proc: Pointer): Boolean;
250 begin
251 Proc := GetProcAddress(Module, ProcName);
252 Result := Proc <> nil;
253 end;
254
255 begin
256 Result := False;
257 if Loaded then
258 Exit(Initialized);
259 Loaded := True;
260 if Initialized then
261 Exit(True);
262 Module := LoadLibrary(libappindicator_3);
263 if Module = 0 then begin
264 Module := LoadLibrary(LibAyatanaAppIndicator);
265 if Module = 0 then begin // Sorry, no TrayIcon !
266 {$ifdef DEBUGAPPIND}
267 writeln('Failed to load an appindicator library');{$endif}
268 Exit;
269 end
270 {$ifdef DEBUGAPPIND} else writeln('Loaded ' + LibAyatanaAppIndicator){$endif};
271 end {$ifdef DEBUGAPPIND} else writeln('Loaded ' + libappindicator_3){$endif};
272 Result :=
273 TryLoad('app_indicator_get_type', @app_indicator_get_type) and
274 TryLoad('app_indicator_new', @app_indicator_new) and
275 TryLoad('app_indicator_new_with_path', @app_indicator_new_with_path) and
276 TryLoad('app_indicator_set_status', @app_indicator_set_status) and
277 TryLoad('app_indicator_set_attention_icon', @app_indicator_set_attention_icon) and
278 TryLoad('app_indicator_set_menu', @app_indicator_set_menu) and
279 TryLoad('app_indicator_set_icon', @app_indicator_set_icon) and
280 TryLoad('app_indicator_set_label', @app_indicator_set_label) and
281 TryLoad('app_indicator_set_icon_theme_path', @app_indicator_set_icon_theme_path) and
282 TryLoad('app_indicator_set_ordering_index', @app_indicator_set_ordering_index) and
283 TryLoad('app_indicator_get_id', @app_indicator_get_id) and
284 TryLoad('app_indicator_get_category', @app_indicator_get_category) and
285 TryLoad('app_indicator_get_status', @app_indicator_get_status) and
286 TryLoad('app_indicator_get_icon', @app_indicator_get_icon) and
287 TryLoad('app_indicator_get_icon_theme_path', @app_indicator_get_icon_theme_path) and
288 TryLoad('app_indicator_get_attention_icon', @app_indicator_get_attention_icon) and
289 TryLoad('app_indicator_get_menu', @app_indicator_get_menu) and
290 TryLoad('app_indicator_get_label', @app_indicator_get_label) and
291 TryLoad('app_indicator_get_label_guide', @app_indicator_get_label_guide) and
292 TryLoad('app_indicator_get_ordering_index', @app_indicator_get_ordering_index);
293 Initialized := Result;
294 end;
295
296 initialization
297 GlobalAppIndicator := nil;
298 GlobalIconPath := '';
299 finalization
300 if FileExists(GlobalIconPath) then
301 DeleteFile(GlobalIconPath);
302 if GlobalAppIndicator <> nil then
303 g_object_unref(GlobalAppIndicator);
304 end.
305