1 {
2 *****************************************************************************
3 * qtsystemtrayicon.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 unit qtsystemtrayicon;
17 {$mode objfpc}{$H+}
18
19 interface
20 {$i qtdefines.inc}
21
22 uses
23 Classes, types, Controls, ExtCtrls, Graphics, Forms, LCLType, LCLProc, LazUTF8,
24 qtobjects, qt5, qtproc, qtint;
25
26 type
27 TSysTrayIconPaintData = record
28 PaintWidget: QWidgetH;
29 ClipRect: types.PRect;
30 ClipRegion: QRegionH;
31 Context: TQtDeviceContext;
32 end;
33
34 { TQtSystemTrayIcon }
35
36 TQtSystemTrayIcon = class(TQtObject)
37 private
38 FSysTrayHook: QObject_hookH;
39 FHook: QSystemTrayIcon_hookH;
40 FSysTrayWidget: QWidgetH;
41 FCanvas: TCanvas;
BeginPaintInternalnull42 function BeginPaintInternal(var APaintData: TSysTrayIconPaintData): hdc;
43 procedure EndPaintInternal(var APaintData: TSysTrayIconPaintData);
44 public
45 FTrayIcon: TCustomTrayIcon;
46 public
47 constructor Create(vIcon: QIconH); virtual;
48 destructor Destroy; override;
49 public
50 procedure AttachEvents; override;
51 procedure DetachEvents; override;
52 procedure AttachSysTrayWidget(AWidget: QWidgetH);
53 procedure DetachSysTrayWidget;
EventFilternull54 function EventFilter(Sender: QObjectH; Event: QEventH): Boolean; cdecl; override;
55 procedure setContextMenu(menu: QMenuH);
56 procedure setIcon(icon: QIconH);
57 procedure setToolTip(tip: WideString);
58 procedure signalActivated(AReason: QSystemTrayIconActivationReason); cdecl;
59 procedure showBaloonHint(const ATitle, AHint: String;
60 const AFlag: QSystemTrayIconMessageIcon; const ATimeOut: Integer);
GetGeometrynull61 function GetGeometry: TRect;
GetPositionnull62 function GetPosition: TPoint;
63 procedure Show;
64 procedure Hide;
65 procedure UpdateSystemTrayWidget;
66 property Canvas: TCanvas read FCanvas write FCanvas;
67 property SysTrayWidget: QWidgetH read FSysTrayWidget;
68 end;
69
70 implementation
71
72 { TQtSystemTrayIcon }
73
74 constructor TQtSystemTrayIcon.Create(vIcon: QIconH);
75 var
76 AName: WideString; {just to debug}
77 begin
78 inherited Create;
79 FSysTrayWidget := nil;
80 FSysTrayHook := nil;
81 if vIcon <> nil then
82 TheObject := QSystemTrayIcon_create(vicon, nil)
83 else
84 TheObject := QSystemTrayIcon_create();
85 AName := 'LCL_QSystemTrayIcon';
86 QObject_setObjectName(TheObject, @AName);
87 FCanvas := nil;
88 QtWidgetSet.RegisterSysTrayIcon(Self);
89 AttachEvents;
90 end;
91
92 destructor TQtSystemTrayIcon.Destroy;
93 begin
94 QtWidgetSet.UnRegisterSysTrayIcon(Self);
95 inherited Destroy;
96 end;
97
98 procedure TQtSystemTrayIcon.AttachEvents;
99 begin
100 inherited AttachEvents;
101 FHook := QSystemTrayIcon_hook_create(QSystemTrayIconH(TheObject));
102 QSystemTrayIcon_hook_hook_activated(FHook, @signalActivated);
103 end;
104
105 procedure TQtSystemTrayIcon.DetachEvents;
106 begin
107 DetachSysTrayWidget;
108 if Assigned(FHook) then
109 begin
110 QSystemTrayIcon_hook_destroy(FHook);
111 FHook := nil;
112 end;
113 inherited DetachEvents;
114 end;
115
116 procedure TQtSystemTrayIcon.AttachSysTrayWidget(AWidget: QWidgetH);
117 begin
118 if (AWidget = nil) and (FSysTrayWidget <> nil) then
119 DetachSysTrayWidget;
120 FSysTrayWidget := AWidget;
121 if FSysTrayWidget <> nil then
122 begin
123 FSysTrayHook := QObject_hook_create(FSysTrayWidget);
124 QObject_hook_hook_events(FSysTrayHook, @EventFilter);
125 end;
126 end;
127
128 procedure TQtSystemTrayIcon.DetachSysTrayWidget;
129 begin
130 if FSysTrayWidget <> nil then
131 begin
132 if FSysTrayHook <> nil then
133 QObject_hook_destroy(FSysTrayHook);
134 FSysTrayHook := nil;
135 FSysTrayWidget := niL;
136 end;
137 end;
138
BeginPaintInternalnull139 function TQtSystemTrayIcon.BeginPaintInternal(var APaintData: TSysTrayIconPaintData): hdc;
140 var
141 DC: TQtDeviceContext;
142 begin
143 DC := TQtDeviceContext.Create(FSysTrayWidget, True);
144 Result := HDC(DC);
145 if Result <> 0 then
146 begin
147 QPainter_setLayoutDirection(DC.Widget, QtLayoutDirectionAuto);
148 if APaintData.ClipRegion <> nil then
149 begin
150 DC.setClipRegion(APaintData.ClipRegion);
151 DC.setClipping(True);
152 end;
153 if APaintData.ClipRect <> nil then
154 begin
155 New(DC.vClipRect);
156 DC.vClipRect^ := APaintData.ClipRect^;
157 end;
158 APaintData.Context := DC;
159 end;
160 end;
161
162 procedure TQtSystemTrayIcon.EndPaintInternal(var APaintData: TSysTrayIconPaintData);
163 begin
164 if APaintData.ClipRect <> nil then
165 Dispose(APaintData.ClipRect);
166 if APaintData.Context <> nil then
167 APaintData.Context.Free;
168 APaintData.Context := nil;
169 end;
170
TQtSystemTrayIcon.EventFilternull171 function TQtSystemTrayIcon.EventFilter(Sender: QObjectH; Event: QEventH
172 ): Boolean; cdecl;
173 var
174 X, Y: Integer;
175 R: TRect;
176 P, APos: TQtPoint;
177 AHint: WideString;
178 {$IFDEF HASX11}
179 PaintData: TSysTrayIconPaintData;
180 {$ENDIF}
181 begin
182 Result := False;
183 if Sender <> FSysTrayWidget then
184 exit;
185
186 case QEvent_type(Event) of
187 QEventPaint:
188 begin
189 if Assigned(FTrayIcon.OnPaint) then
190 begin
191 // qt kernel sets QtWA_PaintOnScreen and QtWA_NoSystemBackground
192 // also OnPaint won't fire until we enter widget with mouse.
193 // Thats so now until I find out howto find systrayicon private QWidget
194 // without searching in QtWidgetSet.EventFilter.
195 {$IFDEF HASX11}
196 QObject_event(QWidgetH(Sender), Event);
197 FillChar(PaintData{%H-}, SizeOf(PaintData), 0);
198 with PaintData do
199 begin
200 PaintWidget := FSysTrayWidget;
201 ClipRegion := QPaintEvent_Region(QPaintEventH(Event));
202 if ClipRect = nil then
203 New(ClipRect);
204 QPaintEvent_Rect(QPaintEventH(Event), ClipRect);
205 end;
206 FCanvas := TCanvas.Create;
207 try
208 FCanvas.Handle := BeginPaintInternal(PaintData);
209 if Assigned(FTrayIcon.OnPaint) then
210 FTrayIcon.OnPaint(FTrayIcon);
211 EndPaintInternal(PaintData);
212 finally
213 FreeThenNil(FCanvas);
214 end;
215 Result := True;
216 {$ELSE}
217 DebugLn('TQtSystemTrayIcon: Paint event is not supported.');
218 {$ENDIF}
219 end;
220 end;
221 QEventToolTip:
222 begin
223 if Assigned(FTrayIcon) and (FTrayIcon.Hint <> '') then
224 begin
225 R := GetGeometry;
226 QtPoint(R.Left, R.Top);
227 AHint := UTF8ToUTF16(FTrayIcon.Hint);
228 QToolTip_showText(@P, @AHint);
229 end;
230 end;
231 QEventMouseMove:
232 begin
233 if Assigned(FTrayIcon) and Assigned(FTrayIcon.OnMouseMove) then
234 begin
235 QMouseEvent_pos(QMouseEventH(Event), @APos);
236 X := APos.X;
237 // Y := QMouseEvent_pos(QMouseEventH(Event),);
238 Y := APos.Y;
239 FTrayIcon.OnMouseMove(FTrayIcon, [], X, Y);
240 if Assigned(FTrayIcon.OnPaint) and (FSysTrayWidget <> nil) then
241 QWidget_update(FSysTrayWidget);
242 end;
243 end;
244 end;
245 end;
246
247 procedure TQtSystemTrayIcon.setContextMenu(menu: QMenuH);
248 begin
249 QSystemTrayIcon_setContextMenu(QSystemTrayIconH(TheObject), menu);
250 end;
251
252 procedure TQtSystemTrayIcon.setIcon(icon: QIconH);
253 begin
254 QSystemTrayIcon_setIcon(QSystemTrayIconH(TheObject), icon);
255 end;
256
257 procedure TQtSystemTrayIcon.setToolTip(tip: WideString);
258 begin
259 QSystemTrayIcon_setToolTip(QSystemTrayIconH(TheObject), @tip)
260 end;
261
262 procedure TQtSystemTrayIcon.signalActivated(
263 AReason: QSystemTrayIconActivationReason); cdecl;
264 var
265 MousePos: TQtPoint;
266 begin
267 if not Assigned(FTrayIcon) then
268 exit;
269 QCursor_pos(@MousePos);
270
271 if Assigned(FTrayIcon.OnPaint) and (FSysTrayWidget <> nil) then
272 QWidget_update(FSysTrayWidget); // trigger paint event.
273
274 case AReason of
275 QSystemTrayIconTrigger:
276 begin
277 if Assigned(FTrayIcon.OnMouseDown) then
278 FTrayIcon.OnMouseDown(FTrayIcon, mbLeft, [], MousePos.x, MousePos.y);
279 if Assigned(FTrayIcon.OnClick) then
280 FTrayIcon.OnClick(FTrayIcon);
281 if Assigned(FTrayIcon.OnMouseUp) then
282 FTrayIcon.OnMouseUp(FTrayIcon, mbLeft, [], MousePos.x, MousePos.y);
283 end;
284 QSystemTrayIconDoubleClick:
285 begin
286 if Assigned(FTrayIcon.OnMouseDown) then
287 FTrayIcon.OnMouseDown(FTrayIcon, mbLeft, [], MousePos.x, MousePos.y);
288
289 if Assigned(FTrayIcon.OnDblClick) then
290 FTrayIcon.OnDblClick(FTrayIcon);
291
292 if Assigned(FTrayIcon.OnMouseUp) then
293 FTrayIcon.OnMouseUp(FTrayIcon, mbLeft, [], MousePos.x, MousePos.y);
294 end;
295 QSystemTrayIconMiddleClick:
296 begin
297 if Assigned(FTrayIcon.OnMouseDown) then
298 FTrayIcon.OnMouseDown(FTrayIcon, mbMiddle, [], MousePos.x, MousePos.y);
299 if Assigned(FTrayIcon.OnMouseUp) then
300 FTrayIcon.OnMouseUp(FTrayIcon, mbMiddle, [], MousePos.x, MousePos.y);
301 end;
302 QSystemTrayIconContext:
303 begin
304 if Assigned(FTrayIcon.OnMouseDown) then
305 FTrayIcon.OnMouseDown(FTrayIcon, mbRight, [], MousePos.x, MousePos.y);
306
307 if Assigned(FTrayIcon.OnMouseUp) then
308 FTrayIcon.OnMouseUp(FTrayIcon, mbRight, [], MousePos.x, MousePos.y);
309 end;
310 end;
311 end;
312
313 procedure TQtSystemTrayIcon.showBaloonHint(const ATitle, AHint: String;
314 const AFlag: QSystemTrayIconMessageIcon; const ATimeOut: Integer);
315 var
316 WHint: WideString;
317 WTitle: WideString;
318 begin
319 WHint := GetUTF8String(AHint);
320 WTitle := GetUTF8String(ATitle);
321 QSystemTrayIcon_showMessage(QSystemTrayIconH(TheObject), @WTitle, @WHint, AFlag, ATimeOut);
322 end;
323
GetGeometrynull324 function TQtSystemTrayIcon.GetGeometry: TRect;
325 begin
326 Result := Classes.Rect(0, 0, 0, 0);
327 if Assigned(TheObject) then
328 QSystemTrayIcon_geometry(QSystemTrayIconH(TheObject), @Result);
329 end;
330
GetPositionnull331 function TQtSystemTrayIcon.GetPosition: TPoint;
332 var
333 R: TRect;
334 begin
335 R := GetGeometry;
336 Result := Point(R.Left, R.Top);
337 end;
338
339 procedure TQtSystemTrayIcon.Show;
340 begin
341 QSystemTrayIcon_show(QSystemTrayIconH(TheObject));
342 end;
343
344 procedure TQtSystemTrayIcon.Hide;
345 begin
346 QSystemTrayIcon_hide(QSystemTrayIconH(TheObject));
347 end;
348
349 procedure TQtSystemTrayIcon.UpdateSystemTrayWidget;
350 begin
351 if Assigned(FSysTrayWidget) then
352 QWidget_update(FSysTrayWidget);
353 end;
354
355 end.
356