1{%MainUnit gtk2wsextctrls.pp} 2{ 3 gtk2trayicon.inc 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 Gtk2 specific code. 17} 18 19{ TGtk2WSCustomTrayIcon } 20 21type 22 { TGtk2TrayIconHandle } 23 24 TGtk2TrayIconHandle = class 25 private 26 plug: PGtkWidget; 27 DrawingArea: PGtkWidget; 28 Tips: PGtkTooltips; 29 fEmbedded: Boolean; 30 fTrayIcon: TCustomTrayIcon; 31{$ifdef UseStatusIcon} 32 FStatusIcon: PGtkStatusIcon; 33{$endif} 34{$ifdef HasGdk2X} 35 fDisplay: PDisplay; 36 fWindow: TWindow; 37 fScreen: PScreen; 38 fScreenID: longint; 39 fTrayParent: TWindow; 40 function SendMessage(window: TWindow; msg: Integer; data1, data2, data3: Integer): Boolean; 41 procedure SetEmbedded; 42{$endif HasGdk2X} 43 public 44 constructor Create(const wsTrayIcon: TCustomTrayIcon); 45 destructor Destroy; override; 46 procedure Show; 47 function GetPosition: TPoint; 48 procedure Update(NewPixBuf: PGdkPixbuf; const NewHint: String); 49 end; 50 51const 52 SYSTEM_TRAY_REQUEST_DOCK = 0; 53 //SYSTEM_TRAY_BEGIN_MESSAGE = 1; 54 //SYSTEM_TRAY_CANCEL_MESSAGE = 2; 55 56{$ifdef HasGdk2X} 57var 58 XError: Integer; 59{******************************************************************* 60* TempX11ErrorHandler () 61* 62* DESCRIPTION: Temp ErrorHandler 63* 64* PARAMETERS: ? 65* 66* RETURNS: ? 67* 68*******************************************************************} 69function TempX11ErrorHandler({%H-}Display:PDisplay; ErrorEv:PXErrorEvent):longint;cdecl; 70begin 71 XError := ErrorEv^.error_code; 72 WriteLn('Error: ' + IntToStr(XError)); 73 Result:=0; 74end; 75 76{******************************************************************* 77* TGtk2TrayIconHandle.Send_Message () 78* 79* DESCRIPTION: Sends a message to the X client 80* 81* PARAMETERS: None 82* 83* RETURNS: Nothing 84* 85*******************************************************************} 86function TGtk2TrayIconHandle.SendMessage(window: TWindow; msg: Integer; data1, data2, data3: Integer): Boolean; 87var 88 Ev: TXEvent; 89begin 90 FillChar(Ev{%H-}, SizeOf(TXEvent), 0); 91 92 ev.xclient._type := ClientMessage; 93 ev.xclient.window := window; 94 ev.xclient.message_type := XInternAtom (fDisplay, '_NET_SYSTEM_TRAY_OPCODE', False); 95 ev.xclient.format := 32; 96 ev.xclient.data.l[0] := CurrentTime; 97 ev.xclient.data.l[1] := msg; 98 ev.xclient.data.l[2] := data1; 99 ev.xclient.data.l[3] := data2; 100 ev.xclient.data.l[4] := data3; 101 102 XError := 0; 103 XSendEvent(fDisplay, fTrayParent, False, NoEventMask, @ev); 104 XSync(fDisplay, False); 105 Result := XError = 0; 106 XError := 0; 107end; 108 109{******************************************************************* 110* TGtk2TrayIconHandle.SetEmbedded () 111* 112* DESCRIPTION: Docks the GtkPlug into the system tray 113* 114* PARAMETERS: None 115* 116* RETURNS: Nothing 117* 118*******************************************************************} 119procedure TGtk2TrayIconHandle.SetEmbedded; 120var 121 old_error: TXErrorHandler; 122 buf: array [0..32] of char; 123 selection_atom : TAtom; 124begin 125 if fEmbedded then 126 Exit; 127 old_error := XSetErrorHandler(@TempX11ErrorHandler); 128 129 xsync(fdisplay,true); 130 buf := PChar('_NET_SYSTEM_TRAY_S' + IntToStr(fScreenID)); 131 selection_atom := XInternAtom(fDisplay, buf, false); 132 XGrabServer(fDisplay); 133 134 fTrayParent := XGetSelectionOwner(fDisplay, selection_atom); 135 if fTrayParent <> None then 136 begin 137 XSelectInput(fDisplay, fTrayParent, StructureNotifyMask); 138 end; 139 140 XUngrabServer(fDisplay); 141 XFlush(fDisplay); 142 if fTrayParent <> None then 143 fEmbedded := SendMessage(fTrayParent, SYSTEM_TRAY_REQUEST_DOCK, fWindow, 0, 0); 144 145 XSetErrorHandler(old_error); 146end; 147{$endif HasGdk2X} 148 149{******************************************************************* 150* realize_cb () 151* 152* DESCRIPTION: Callback function for the realize signal 153* Sets the systray icon after the widget is realized 154* 155* PARAMETERS: None 156* 157* RETURNS: Nothing 158* 159*******************************************************************} 160procedure realize_cb({%H-}widget: PGtkWidget; user_data: gpointer); cdecl; 161var 162 wsTrayIcon: TCustomTrayIcon absolute user_data; 163begin 164 with TGtk2TrayIconHandle(wsTrayIcon.Handle) do 165 begin 166 {$ifdef HasGdk2X} 167 fDisplay := GDK_WINDOW_XDISPLAY(plug^.window); 168 fWindow := GDK_WINDOW_XWINDOW(plug^.window); 169 170{ Does not work 171 172 gdk_screen := gtk_widget_get_screen(plug); 173 fScreen := GDK_SCREEN_XSCREEN(gdk_screen); // get the real screen} 174 175 fScreen := XDefaultScreenOfDisplay(fDisplay); 176 fScreenID := XScreenNumberOfScreen(fScreen); // and it's number 177 SetEmbedded; 178 {$endif} 179 end; 180end; 181 182{******************************************************************* 183* button_release_cb () 184* 185* DESCRIPTION: Callback function for Mouse Click 186* 187* PARAMETERS: None 188* 189* RETURNS: Nothing 190* 191*******************************************************************} 192function button_release_cb({%H-}widget: PGtkWidget; event: PGdkEventButton; 193 user_data: gpointer): gboolean; cdecl; 194var 195 vwsTrayIcon: TCustomTrayIcon absolute user_data; 196begin 197 Result := False; 198 199 case event^.button of 200 1: 201 begin 202 if Assigned(vwsTrayIcon.OnClick) then vwsTrayIcon.OnClick(vwsTrayIcon); 203 if Assigned(vwsTrayIcon.OnMouseUp) then 204 vwsTrayIcon.OnMouseUp(vwsTrayIcon, mbLeft, [], Round(event^.X), Round(event^.Y)); 205 end; 206 207 2: if Assigned(vwsTrayIcon.OnMouseUp) then 208 vwsTrayIcon.OnMouseUp(vwsTrayIcon, mbMiddle, [], Round(event^.X), Round(event^.Y)); 209 210 3: 211 begin 212 if Assigned(vwsTrayIcon.OnMouseUp) then 213 vwsTrayIcon.OnMouseUp(vwsTrayIcon, mbRight, [], Round(event^.X), Round(event^.Y)); 214 if Assigned(vwsTrayIcon.PopUpMenu) then 215 vwsTrayIcon.PopUpMenu.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y); 216 end; 217 end; 218end; 219 220{******************************************************************* 221* button_press_cb () 222* 223* DESCRIPTION: Callback function for Mouse Click 224* 225* PARAMETERS: None 226* 227* RETURNS: Nothing 228* 229*******************************************************************} 230function button_press_cb({%H-}widget: PGtkWidget; event: PGdkEventButton; 231 user_data: gpointer): gboolean; cdecl; 232var 233 vwsTrayIcon: TCustomTrayIcon absolute user_data; 234begin 235 Result := False; 236 237 if (event^._type = GDK_2BUTTON_PRESS) and Assigned(vwsTrayIcon.OnDblClick) then 238 vwsTrayIcon.OnDblClick(vwsTrayIcon) 239 else 240 begin 241 case event^.button of 242 1: if Assigned(vwsTrayIcon.OnMouseDown) then 243 vwsTrayIcon.OnMouseDown(vwsTrayIcon, mbLeft, [], Round(event^.X), Round(event^.Y)); 244 245 2: if Assigned(vwsTrayIcon.OnMouseDown) then 246 vwsTrayIcon.OnMouseDown(vwsTrayIcon, mbMiddle, [], Round(event^.X), Round(event^.Y)); 247 248 3: if Assigned(vwsTrayIcon.OnMouseDown) then 249 vwsTrayIcon.OnMouseDown(vwsTrayIcon, mbRight, [], Round(event^.X), Round(event^.Y)); 250 end; 251 end; 252end; 253 254{******************************************************************* 255* popup_cb () 256* 257* DESCRIPTION: Callback function for the popup menu 258* 259* PARAMETERS: None 260* 261* RETURNS: Nothing 262* 263*******************************************************************} 264function popup_cb({%H-}widget: PGtkWidget; user_data: gpointer): Boolean; cdecl; 265var 266 vwsTrayIcon: TCustomTrayIcon absolute user_data; 267begin 268 Result := True; 269 270 if Assigned(vwsTrayIcon.PopUpMenu) then 271 vwsTrayIcon.PopUpMenu.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y); 272end; 273 274{******************************************************************* 275* motion_cb () 276* 277* DESCRIPTION: Callback function for the OnMouseMove event 278* 279* PARAMETERS: None 280* 281* RETURNS: Nothing 282* 283*******************************************************************} 284function motion_cb({%H-}widget: PGtkWidget; event: PGdkEventMotion; user_data: gpointer): Boolean; cdecl; 285var 286 vwsTrayIcon: TCustomTrayIcon absolute user_data; 287begin 288 Result := False; 289 290 if Assigned(vwsTrayIcon.OnMouseMove) then 291 vwsTrayIcon.OnMouseMove(vwsTrayIcon, [], Round(event^.X), Round(event^.Y)); 292end; 293 294{$ifdef UseStatusIcon} 295procedure activate_cb_statusicon({%H-}status_icon: PGtkStatusIcon; user_data: gpointer); cdecl; 296var 297 vwsTrayIcon: TCustomTrayIcon absolute user_data; 298begin 299 if Assigned(vwsTrayIcon.OnMouseDown) then 300 with Mouse.CursorPos do 301 vwsTrayIcon.OnMouseDown(vwsTrayIcon, mbLeft, [], X, Y); 302end; 303 304procedure popup_cb_statusicon({%H-}status_icon: PGtkStatusIcon; {%H-}button: guint; 305 {%H-}activate_time: guint; user_data: gpointer); cdecl; 306var 307 vwsTrayIcon: TCustomTrayIcon absolute user_data; 308begin 309 if Assigned(vwsTrayIcon.PopUpMenu) then 310 vwsTrayIcon.PopUpMenu.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y); 311end; 312 313function button_press_cb_statusicon({%H-}status_icon: PGtkStatusIcon; 314 event: PGdkEvent; user_data: gpointer): gboolean; cdecl; 315var 316 vwsTrayIcon: TCustomTrayIcon absolute user_data; 317begin 318 Result := False; 319 320 if (PGdkEventButton(event)^._type = GDK_2BUTTON_PRESS) and Assigned(vwsTrayIcon.OnDblClick) then 321 vwsTrayIcon.OnDblClick(vwsTrayIcon) 322 else 323 begin 324 case PGdkEventButton(event)^.button of 325 1: if Assigned(vwsTrayIcon.OnMouseDown) then 326 vwsTrayIcon.OnMouseDown(vwsTrayIcon, mbLeft, [], Round(PGdkEventButton(event)^.X), Round(PGdkEventButton(event)^.Y)); 327 328 2: if Assigned(vwsTrayIcon.OnMouseDown) then 329 vwsTrayIcon.OnMouseDown(vwsTrayIcon, mbMiddle, [], Round(PGdkEventButton(event)^.X), Round(PGdkEventButton(event)^.Y)); 330 331 3: if Assigned(vwsTrayIcon.OnMouseDown) then 332 vwsTrayIcon.OnMouseDown(vwsTrayIcon, mbRight, [], Round(PGdkEventButton(event)^.X), Round(PGdkEventButton(event)^.Y)); 333 end; 334 end; 335end; 336 337function button_release_cb_statusicon({%H-}status_icon: PGtkStatusIcon; 338 event: PGdkEvent; user_data: gpointer): gboolean; cdecl; 339var 340 vwsTrayIcon: TCustomTrayIcon absolute user_data; 341begin 342 Result := False; 343 case PGdkEventButton(event)^.button of 344 1: 345 begin 346 if Assigned(vwsTrayIcon.OnClick) then vwsTrayIcon.OnClick(vwsTrayIcon); 347 if Assigned(vwsTrayIcon.OnMouseUp) then 348 vwsTrayIcon.OnMouseUp(vwsTrayIcon, mbLeft, [], Round(PGdkEventButton(event)^.X), Round(PGdkEventButton(event)^.Y)); 349 end; 350 351 2: if Assigned(vwsTrayIcon.OnMouseUp) then 352 vwsTrayIcon.OnMouseUp(vwsTrayIcon, mbMiddle, [], Round(PGdkEventButton(event)^.X), Round(PGdkEventButton(event)^.Y)); 353 354 3: 355 begin 356 if Assigned(vwsTrayIcon.OnMouseUp) then 357 vwsTrayIcon.OnMouseUp(vwsTrayIcon, mbRight, [], Round(PGdkEventButton(event)^.X), Round(PGdkEventButton(event)^.Y)); 358 if Assigned(vwsTrayIcon.PopUpMenu) then 359 vwsTrayIcon.PopUpMenu.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y); 360 end; 361 end; 362end; 363 364function query_tooltip_cb_statusicon({%H-}status_icon: PGtkStatusIcon; 365 x: guint; y: guint; {%H-}keyboard_mode: gboolean; {%H-}tooltip: gpointer{PGtkTooltip}; user_data: gpointer): gboolean; cdecl; 366var 367 vwsTrayIcon: TCustomTrayIcon absolute user_data; 368begin 369 Result := FALSE; 370 371 if Assigned(vwsTrayIcon.OnMouseMove) then 372 vwsTrayIcon.OnMouseMove(vwsTrayIcon, [], x, y); 373end; 374{$endif} 375 376constructor TGtk2TrayIconHandle.Create(const wsTrayIcon: TCustomTrayIcon); 377begin 378 fTrayIcon := wsTrayIcon; 379 380{$ifdef UseStatusIcon} 381 FStatusIcon := nil; 382 if Available_GtkStatusIcon_2_10 then 383 begin 384 FStatusIcon := gtk_status_icon_new(); 385 gtk_status_icon_set_from_pixbuf(FStatusIcon, {%H-}PGdkPixbuf(FTrayIcon.Icon.Handle)); 386 {$IF FPC_FULLVERSION>30300} 387 gtk_status_icon_set_tooltip_text(FStatusIcon, PChar(FTrayIcon.Hint)); 388 {$ELSE} 389 gtk_status_icon_set_tooltip(FStatusIcon, PChar(FTrayIcon.Hint)); 390 {$ENDIF} 391 g_object_set(PGObject(FStatusIcon), 'has-tooltip', gTRUE, nil); 392 fEmbedded := gtk_status_icon_is_embedded(FStatusIcon); 393 394 g_signal_connect(FStatusIcon, 'activate', TGCallback(@activate_cb_statusicon), fTrayIcon); 395 g_signal_connect(FStatusIcon, 'popup-menu', TGCallback(@popup_cb_statusicon), fTrayIcon); 396 g_signal_connect(FStatusIcon, 'button-press-event', TGCallback(@button_press_cb_statusicon), fTrayIcon); 397 g_signal_connect(FStatusIcon, 'button-release-event', TGCallback(@button_release_cb_statusicon), fTrayIcon); 398 g_signal_connect(FStatusIcon, 'query-tooltip', TGCallback(@query_tooltip_cb_statusicon), fTrayIcon); 399 end 400 else 401{$endif} 402 begin 403 // Creates the GtkPlug 404 plug := gtk_plug_new(0); 405 Tips := gtk_tooltips_new; 406 g_object_ref(Tips); 407 gtk_object_sink(GTK_OBJECT(Tips)); 408 gtk_tooltips_set_tip(GTK_TOOLTIPS(Tips), plug, PChar(wsTrayIcon.Hint), ''); 409 410 // Connects the signals 411 gtk_widget_add_events(plug, GDK_ALL_EVENTS_MASK); 412 g_signal_connect(plug, 'realize', TGCallback(@realize_cb), wsTrayIcon); 413 g_signal_connect(plug, 'popup-menu', TGCallback(@popup_cb), wsTrayIcon); 414 g_signal_connect(plug, 'motion-notify-event', TGCallback(@motion_cb), wsTrayIcon); 415 g_signal_connect(plug, 'button-press-event', TGCallback(@button_press_cb), wsTrayIcon); 416 g_signal_connect(plug, 'button-release-event', TGCallback(@button_release_cb), wsTrayIcon); 417 418 // Draws the icon 419 with wsTrayIcon do 420 begin 421 DrawingArea := gtk_image_new_from_pixbuf({%H-}PGdkPixbuf(Icon.Handle)); 422 gtk_container_add(GTK_CONTAINER(plug), DrawingArea); 423 gtk_widget_show(DrawingArea); 424 end; 425 end; 426end; 427 428destructor TGtk2TrayIconHandle.Destroy; 429begin 430{$ifdef UseStatusIcon} 431 if FStatusIcon <> nil then 432 begin 433 gtk_status_icon_set_visible(FStatusIcon, False); 434 g_object_unref(FStatusIcon); 435 FStatusIcon := nil; 436 end 437 else 438{$endif} 439 begin 440 gtk_widget_destroy(plug); 441 plug := nil; 442 443 g_object_unref(Tips); 444 Tips := nil; 445 end; 446end; 447 448procedure TGtk2TrayIconHandle.Show; 449begin 450{$ifdef UseStatusIcon} 451 if FStatusIcon <> nil then 452 gtk_status_icon_set_visible(FStatusIcon, True) 453 else 454{$endif} 455 gtk_widget_show(plug); 456end; 457 458function TGtk2TrayIconHandle.GetPosition: TPoint; 459var 460{$ifdef UseStatusIcon} 461 AScreen: PGdkScreen; 462 AArea: TGdkRectangle; 463 AOrientation: TGtkOrientation; 464{$endif} 465 WindowHandle: PGDKWindow; 466begin 467{$ifdef UseStatusIcon} 468 if FStatusIcon <> nil then 469 begin 470 gtk_status_icon_get_geometry(FStatusIcon, @AScreen, @AArea, @AOrientation); 471 Result.x := AArea.x; 472 Result.y := AArea.y; 473 end 474 else 475{$endif} 476 begin 477 if Assigned(plug) then 478 begin 479 WindowHandle := plug^.window; 480 if Assigned(WindowHandle) then 481 gdk_window_get_origin(WindowHandle, @Result.X, @Result.Y); 482 end; 483 end; 484end; 485 486procedure TGtk2TrayIconHandle.Update(NewPixBuf: PGdkPixbuf; const NewHint: String); 487begin 488{$ifdef UseStatusIcon} 489 if FStatusIcon <> nil then 490 begin 491 gtk_status_icon_set_from_pixbuf(FStatusIcon, NewPixBuf); 492 {$IF FPC_FULLVERSION>30300} 493 gtk_status_icon_set_tooltip_text(FStatusIcon, PChar(NewHint)); 494 {$ELSE} 495 gtk_status_icon_set_tooltip(FStatusIcon, PChar(NewHint)); 496 {$ENDIF} 497 g_object_set(PGObject(FStatusIcon), 'has-tooltip', gTRUE, nil); 498 end 499 else 500{$endif} 501 begin 502 // Updates the tooltips 503 if Assigned(Tips) then 504 gtk_tooltips_set_tip(GTK_TOOLTIPS(Tips), plug, PChar(NewHint), ''); 505 // Updates the icon 506 if Assigned(DrawingArea) then 507 gtk_image_set_from_pixbuf(GTK_IMAGE(DrawingArea), NewPixbuf); 508 end; 509end; 510 511{******************************************************************* 512* TGtk2WSCustomTrayIcon.Hide () 513* 514* DESCRIPTION: Hides the main tray icon of the program 515* 516* PARAMETERS: None 517* 518* RETURNS: True if sucessfull, otherwise False 519* 520*******************************************************************} 521class function TGtk2WSCustomTrayIcon.Hide(const ATrayIcon: TCustomTrayIcon): Boolean; 522begin 523 Result := False; 524 525 { Free and nil the handle } 526 TGtk2TrayIconHandle(ATrayIcon.Handle).Free; 527 ATrayIcon.Handle := 0; 528 529 Result := True; 530end; 531 532{******************************************************************* 533* TGtk2WSCustomTrayIcon.Show () 534* 535* DESCRIPTION: Shows the main tray icon of the program 536* 537* PARAMETERS: None 538* 539* RETURNS: True if sucessfull, otherwise False 540* 541*******************************************************************} 542class function TGtk2WSCustomTrayIcon.Show(const ATrayIcon: TCustomTrayIcon): Boolean; 543var 544 TrayIconHandle: TGtk2TrayIconHandle; 545begin 546 Result := False; 547 548 TrayIconHandle := TGtk2TrayIconHandle.Create(ATrayIcon); 549 ATrayIcon.Handle := HWND(TrayIconHandle); 550 {******************************************************************* 551 * Now shows the GtkPlug 552 *******************************************************************} 553 TrayIconHandle.Show; 554 {$ifdef UseStatusIcon} 555 Result := True; 556 {$else} 557 if TrayIconHandle.fEmbedded then 558 Result := True 559 else 560 Hide(ATrayIcon); 561 {$endif} 562end; 563 564{******************************************************************* 565* TGtk2WSCustomTrayIcon.InternalUpdate () 566* 567* DESCRIPTION: Makes modifications to the Icon while running 568* i.e. without hiding it and showing again 569* 570* PARAMETERS: None 571* 572* RETURNS: Nothing 573* 574*******************************************************************} 575class procedure TGtk2WSCustomTrayIcon.InternalUpdate(const ATrayIcon: TCustomTrayIcon); 576begin 577 if ATrayIcon.Handle <> 0 then 578 TGtk2TrayIconHandle(ATrayIcon.Handle).Update({%H-}PGdkPixbuf(ATrayIcon.Icon.Handle), ATrayIcon.Hint); 579end; 580 581{******************************************************************* 582* TGtk2WSCustomTrayIcon.GetPosition () 583* 584* DESCRIPTION: Returns the position of the tray icon on the display. 585* This function is utilized to show message boxes near 586* the icon 587* 588* PARAMETERS: None 589* 590* RETURNS: Nothing 591* 592*******************************************************************} 593class function TGtk2WSCustomTrayIcon.GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint; 594begin 595 Result := Point(0, 0); 596 if ATrayIcon.Handle <> 0 then 597 Result := TGtk2TrayIconHandle(ATrayIcon.Handle).GetPosition; 598end; 599 600