1{%MainUnit gtkwsextctrls.pp} 2{ 3 gtk1trayicon.pas 4 5 ***************************************************************************** 6 This file is part of the Lazarus Component Library (LCL) 7 8 See the file COPYING.modifiedLGPL.txt, included in this distribution, 9 for details about the license. 10 ***************************************************************************** 11 12 Authors: Felipe Monteiro de Carvalho and Andrew Haines 13 14 Special thanks for: Danny Milosavljevic and the Lazarus Team 15 16 Gtk1 specific code. Works on gnome also. 17} 18 19{ TGtkWSCustomTrayIcon } 20 21type 22 23 { TGtk1TrayIconHandle } 24 25 TGtk1TrayIconHandle = class(TObject) 26 private 27 plug: PGtkWidget; 28 drawingarea: PGtkWidget; 29 fDisplay: PDisplay; 30 fcanvas: TCanvas; 31 fWindow: TWindow; 32 fScreenID: longint; 33 fTrayParent: TWindow; 34 //fOwner: TComponent; 35 fEmbedded: Boolean; 36 //fMsgCount: Integer; 37 fTrayIcon: TCustomTrayIcon; 38 function GetCanvas: TCanvas; 39 function NotifyExpose(Event: PGdkEventExpose; Widget: PGtkWidget): Boolean; cdecl; 40 function NotifyMouseMove(Event: PGdkEventMotion; Widget: PGtkWidget): Boolean; cdecl; 41 function NotifyMouseDown(Event: PGdkEventButton; Widget: PGtkWidget): Boolean; cdecl; 42 function NotifyMouseUp(Event: PGdkEventButton; Widget: PGtkWidget): Boolean; cdecl; 43 procedure PaintForm(Sender: TObject); 44 function Send_Message(window: TWindow; msg: Integer;data1, data2,data3: Integer): boolean; 45 public 46 destructor Destroy; override; 47 procedure CreateForm(id: Integer); 48 function GetPosition: TPoint; 49 procedure Hide; 50 procedure SetEmbedded; 51 procedure SetMinSize(AWidth, AHeight: Integer); 52 function TrayParent(UseCachedValue: Boolean = True): TWindow; 53 public 54 property Canvas: TCanvas read GetCanvas; 55 end; 56 57const 58 SYSTEM_TRAY_REQUEST_DOCK = 0; 59 SYSTEM_TRAY_BEGIN_MESSAGE = 1; 60 SYSTEM_TRAY_CANCEL_MESSAGE = 2; 61 62// Temp ErrorHandler 63function TempX11ErrorHandler(Display:PDisplay; ErrorEv:PXErrorEvent):longint;cdecl; 64begin 65 WriteLn('Error: ' + IntToStr(ErrorEv^.error_code)); 66 Result:=0; 67end; 68 69function TGtk1TrayIconHandle.GetCanvas: TCanvas; 70begin 71 if Assigned(FCanvas) then Exit(FCanvas); 72 73 Result := TCanvas.Create; 74 Result.Handle:= GetDC(HWND(drawingarea)); 75 FCanvas := Result; 76end; 77 78function TGtk1TrayIconHandle.NotifyExpose(Event: PGdkEventExpose; 79 Widget: PGtkWidget): Boolean; cdecl; 80begin 81 Result := False; 82 83 PaintForm(fTrayIcon); 84end; 85 86function TGtk1TrayIconHandle.NotifyMouseMove(Event: PGdkEventMotion; 87 Widget: PGtkWidget): Boolean; cdecl; 88begin 89 Result := False; 90 91 if Assigned(fTrayIcon.OnMouseMove) then 92 fTrayIcon.OnMouseMove(fTrayIcon, [], Trunc(Event^.x), Trunc(Event^.y)); 93end; 94 95function TGtk1TrayIconHandle.NotifyMouseDown(Event: PGdkEventButton; 96 Widget: PGtkWidget): Boolean; cdecl; 97var 98 Button: TMouseButton; 99begin 100 Result := False; 101 102 case Event^.button of 103 GDK_RIGHTBUTTON: Button := mbRight; 104 GDK_MIDDLEBUTTON: Button := mbMiddle; 105 GDK_LEFTBUTTON: Button := mbLeft; 106 end; 107 108 if Assigned(fTrayIcon.OnMouseDown) then 109 fTrayIcon.OnMouseDown(fTrayIcon, Button, [], Trunc(Event^.x), Trunc(Event^.y)); 110end; 111 112function TGtk1TrayIconHandle.NotifyMouseUp(Event: PGdkEventButton; 113 Widget: PGtkWidget): Boolean; cdecl; 114var 115 Button: TMouseButton; 116begin 117 Result := False; 118 119 case Event^.button of 120 3: Button := mbRight; 121 2: Button := mbMiddle; 122 1: Button := mbLeft; 123 end; 124 125 if Button = mbLeft then 126 case gdk_event_get_type(Event) of 127 GDK_BUTTON_PRESS: 128 if Assigned(fTrayIcon.OnClick) then 129 fTrayIcon.OnClick(fTrayIcon); 130 GDK_2BUTTON_PRESS: 131 if Assigned(fTrayIcon.OnDblClick) then 132 fTrayIcon.OnDblClick(fTrayIcon); 133 end; 134 135 { Just using GetPosition to get the screen position and then add 136 Event^.x and Event^.y to it won't work. It seams that this will 137 cause a small difference with Mouse.CursorPos, and using 138 TPopupMenu.PopUp will result in a wrong position for the menu } 139 if (Button = mbRight) and (fTrayIcon.PopUpMenu <> nil) then 140 fTrayIcon.PopUpMenu.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y); 141 142 if Assigned(fTrayIcon.OnMouseUp) then 143 fTrayIcon.OnMouseUp(fTrayIcon, Button, [], Trunc(Event^.x), Trunc(Event^.y)); 144end; 145 146{******************************************************************* 147* TGtk1TrayIconHandle.Send_Message () 148* 149* DESCRIPTION: Sends a message to the X client 150* 151*******************************************************************} 152function TGtk1TrayIconHandle.Send_Message(window: TWindow; msg: Integer;data1, data2,data3: Integer): boolean; 153var 154 Ev: TXEvent; 155// fmt: Integer; 156begin 157 FillChar(Ev, SizeOf(TXEvent), $0); 158 159 ev.xclient._type := ClientMessage; 160 ev.xclient.window := window; 161 ev.xclient.message_type := XInternAtom (fDisplay, '_NET_SYSTEM_TRAY_OPCODE', False ); 162 ev.xclient.format := 32; 163 ev.xclient.data.l[0] := CurrentTime; 164 ev.xclient.data.l[1] := msg; 165 ev.xclient.data.l[2] := data1; 166 ev.xclient.data.l[3] := data2; 167 ev.xclient.data.l[4] := data3; 168 169 XSendEvent(fDisplay, fTrayParent, False, NoEventMask, @ev); 170 XSync(fDisplay, False); 171 Result := false;//(untrap_errors() = 0); 172end; 173 174function TGtk1TrayIconHandle.TrayParent(UseCachedValue: Boolean = True): TWindow; 175var 176 buf: array[0..32] of char; 177 selection_atom: TAtom; 178begin 179 if (fTrayParent <> 0) and UseCachedValue then 180 Exit(fTrayParent); 181 fDisplay := gdk_display; 182 fScreenID := gdk_screen; 183 //fScreenID := XScreenNumberOfScreen(fScreen); // and it's number 184 XGrabServer(fDisplay); 185 186 buf := PChar('_NET_SYSTEM_TRAY_S' + IntToStr(fScreenID)); 187 selection_atom := XInternAtom(fDisplay, buf, false); 188 fTrayParent := XGetSelectionOwner(fDisplay, selection_atom); 189 190 XUngrabServer(fDisplay); 191 192 Result := fTrayParent; 193end; 194 195destructor TGtk1TrayIconHandle.Destroy; 196begin 197 if Assigned(FCanvas) and FCanvas.HandleAllocated then 198 begin 199 ReleaseDC(HWND(drawingarea), fcanvas.Handle); 200 FCanvas.Free; 201 end; 202 if Assigned(drawingarea) then 203 begin 204 g_signal_handlers_destroy(G_OBJECT(drawingarea)); 205 gtk_widget_destroy(drawingarea); 206 end; 207 if Assigned(plug) then 208 gtk_widget_destroy(plug); 209 210 inherited Destroy; 211end; 212 213{******************************************************************* 214* TGtk1TrayIconHandle.SetEmbedded () 215* 216* DESCRIPTION: 217* 218*******************************************************************} 219procedure TGtk1TrayIconHandle.SetEmbedded; 220var 221 old_error: TXErrorHandler; 222begin 223 fEmbedded := False; 224 if TrayParent = None then 225 Exit; 226 227 // so we have a TWindow 228 gtk_widget_realize(plug); 229 230 old_error := XSetErrorHandler(@TempX11ErrorHandler); 231 Sleep(80); 232 xsync(fdisplay,true); 233 234 XGrabServer(fDisplay); 235 XSelectInput(fDisplay, TrayParent, StructureNotifyMask); 236 XUngrabServer(fDisplay); 237 XFlush(fDisplay); 238 239 fWindow := GDK_WINDOW_XWINDOW (Pointer(PGtkWidget(plug)^.window)); 240 241 Send_Message(TrayParent, SYSTEM_TRAY_REQUEST_DOCK, fWindow, 0, 0); 242 243 GTK_WIDGET_SET_FLAGS(plug,GTK_VISIBLE); 244 GTK_WIDGET_SET_FLAGS(plug,GTK_MAPPED); 245 246 gtk_widget_show_all(plug); 247 248 XSetErrorHandler(old_error); 249 fEmbedded:=True; 250end; 251 252procedure TGtk1TrayIconHandle.Hide; 253begin 254 gtk_widget_hide_all(drawingarea); 255 fEmbedded := False; 256end; 257 258{******************************************************************* 259* TGtk1TrayIconHandle.CreateForm () 260* 261* DESCRIPTION: 262* 263*******************************************************************} 264procedure TGtk1TrayIconHandle.CreateForm(id: Integer); 265begin 266 plug := gtk_plug_new(0); 267 drawingarea := gtk_event_box_new; 268 269 gtk_container_add(GTK_CONTAINER(plug), drawingarea); 270 271 //gtk_widget_add_events(drawingarea, GDK_MOTION_NOTIFY); 272 273 gtk_signal_connect_object_after(G_OBJECT(drawingarea), 'expose-event', TGtkSignalFunc(@TGtk1TrayIconHandle.NotifyExpose), G_OBJECT(Self)); 274 gtk_signal_connect_object(G_OBJECT(drawingarea), 'motion-notify-event', TGtkSignalFunc(@TGtk1TrayIconHandle.NotifyMouseMove), G_OBJECT(Self)); 275 gtk_signal_connect_object(G_OBJECT(drawingarea), 'button-press-event', TGtkSignalFunc(@TGtk1TrayIconHandle.NotifyMouseDown), G_OBJECT(Self)); 276 gtk_signal_connect_object(G_OBJECT(drawingarea), 'button-release-event', TGtkSignalFunc(@TGtk1TrayIconHandle.NotifyMouseUp), G_OBJECT(Self)); 277 // 278 279 fEmbedded := False; 280 GetCanvas; 281end; 282 283{******************************************************************* 284* TGtk1TrayIconHandle.GetPosition () 285* 286* DESCRIPTION: Returns the (x, y) position of the icon on the screen 287* 288*******************************************************************} 289function TGtk1TrayIconHandle.GetPosition: TPoint; 290var 291 WindowHandle: PGDKWindow; 292begin 293 Result := Point(0, 0); 294 295 if not Assigned(plug) then Exit; 296 297 WindowHandle := plug^.window; 298 299 if not Assigned(WindowHandle) then Exit; 300 301 gdk_window_get_origin(WindowHandle, @Result.X, @Result.Y); 302end; 303 304{******************************************************************* 305* TGtk1TrayIconHandle.SetMinSize () 306* 307* DESCRIPTION: Attemps to avoid problems on Gnome 308* 309*******************************************************************} 310procedure TGtk1TrayIconHandle.SetMinSize(AWidth, AHeight: Integer); 311begin 312 gtk_widget_set_usize(drawingarea, AWidth, AHeight); 313end; 314 315{******************************************************************* 316* TGtk1TrayIconHandle.PaintForm () 317* 318* DESCRIPTION: Paint method of the Icon Window 319* 320*******************************************************************} 321procedure TGtk1TrayIconHandle.PaintForm(Sender: TObject); 322begin 323 if fTrayIcon.ShowIcon then Canvas.Draw(0, 0, fTrayIcon.Icon); 324 325 if Assigned(fTrayIcon.OnPaint) then fTrayIcon.OnPaint(Self); 326end; 327 328{******************************************************************* 329* TGtkWSCustomTrayIcon.Hide () 330* 331* DESCRIPTION: Hides the main tray icon of the program 332* 333* PARAMETERS: None 334* 335* RETURNS: True if sucessfull, otherwise False 336* 337*******************************************************************} 338class function TGtkWSCustomTrayIcon.Hide(const ATrayIcon: TCustomTrayIcon): Boolean; 339var 340 TrayIconHandle: TGtk1TrayIconHandle; 341begin 342 Result := False; 343 344 TrayIconHandle := TGtk1TrayIconHandle(ATrayIcon.Handle); 345 TrayIconHandle.Free; 346 347 ATrayIcon.Handle := 0; 348 349 Result := True; 350end; 351 352{******************************************************************* 353* TGtkWSCustomTrayIcon.Show () 354* 355* DESCRIPTION: Shows the main tray icon of the program 356* 357* PARAMETERS: None 358* 359* RETURNS: True if sucessfull, otherwise False 360* 361*******************************************************************} 362class function TGtkWSCustomTrayIcon.Show(const ATrayIcon: TCustomTrayIcon): Boolean; 363var 364 TrayIconHandle: TGtk1TrayIconHandle; 365begin 366 Result := False; 367 368 TrayIconHandle := TGtk1TrayIconHandle.Create; 369 TrayIconHandle.fTrayIcon := ATrayIcon; 370 371 ATrayIcon.Handle := PtrInt(TrayIconHandle); 372 373 TrayIconHandle.CreateForm(0); 374 TrayIconHandle.SetMinSize(ATrayIcon.Icon.Width, ATrayIcon.Icon.Height); 375 TrayIconHandle.SetEmbedded; 376 377 Result := True; 378end; 379 380{******************************************************************* 381* TGtkWSCustomTrayIcon.InternalUpdate () 382* 383* DESCRIPTION: Makes modifications to the Icon while running 384* i.e. without hiding it and showing again 385* 386*******************************************************************} 387class procedure TGtkWSCustomTrayIcon.InternalUpdate(const ATrayIcon: TCustomTrayIcon); 388var 389 TrayIconHandle: TGtk1TrayIconHandle; 390begin 391 TrayIconHandle := TGtk1TrayIconHandle(ATrayIcon.Handle); 392 393 if not Assigned(TrayIconHandle) then Exit; 394end; 395 396{******************************************************************* 397* TGtkWSCustomTrayIcon.GetPosition () 398* 399* DESCRIPTION: Returns the position of the tray icon on the display. 400* This function is utilized to show message boxes near 401* the icon 402* 403*******************************************************************} 404class function TGtkWSCustomTrayIcon.GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint; 405var 406 TrayIconHandle: TGtk1TrayIconHandle; 407begin 408 Result := Point(0, 0); 409 410 TrayIconHandle := TGtk1TrayIconHandle(ATrayIcon.Handle); 411 412 if not Assigned(TrayIconHandle) then Exit; 413 414 Result := TrayIconHandle.GetPosition; 415end; 416 417class function TGtkWSCustomTrayIcon.GetCanvas(const ATrayIcon: TCustomTrayIcon): TCanvas; 418var 419 TrayIconHandle: TGtk1TrayIconHandle; 420begin 421 TrayIconHandle := TGtk1TrayIconHandle(ATrayIcon.Handle); 422 423 if not Assigned(TrayIconHandle) then Exit(ATrayIcon.Icon.Canvas); 424 425 Result := TrayIconHandle.Canvas; 426end; 427 428 429