{%MainUnit gtkwsextctrls.pp} { gtk1trayicon.pas ***************************************************************************** This file is part of the Lazarus Component Library (LCL) See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** Authors: Felipe Monteiro de Carvalho and Andrew Haines Special thanks for: Danny Milosavljevic and the Lazarus Team Gtk1 specific code. Works on gnome also. } { TGtkWSCustomTrayIcon } type { TGtk1TrayIconHandle } TGtk1TrayIconHandle = class(TObject) private plug: PGtkWidget; drawingarea: PGtkWidget; fDisplay: PDisplay; fcanvas: TCanvas; fWindow: TWindow; fScreenID: longint; fTrayParent: TWindow; //fOwner: TComponent; fEmbedded: Boolean; //fMsgCount: Integer; fTrayIcon: TCustomTrayIcon; function GetCanvas: TCanvas; function NotifyExpose(Event: PGdkEventExpose; Widget: PGtkWidget): Boolean; cdecl; function NotifyMouseMove(Event: PGdkEventMotion; Widget: PGtkWidget): Boolean; cdecl; function NotifyMouseDown(Event: PGdkEventButton; Widget: PGtkWidget): Boolean; cdecl; function NotifyMouseUp(Event: PGdkEventButton; Widget: PGtkWidget): Boolean; cdecl; procedure PaintForm(Sender: TObject); function Send_Message(window: TWindow; msg: Integer;data1, data2,data3: Integer): boolean; public destructor Destroy; override; procedure CreateForm(id: Integer); function GetPosition: TPoint; procedure Hide; procedure SetEmbedded; procedure SetMinSize(AWidth, AHeight: Integer); function TrayParent(UseCachedValue: Boolean = True): TWindow; public property Canvas: TCanvas read GetCanvas; end; const SYSTEM_TRAY_REQUEST_DOCK = 0; SYSTEM_TRAY_BEGIN_MESSAGE = 1; SYSTEM_TRAY_CANCEL_MESSAGE = 2; // Temp ErrorHandler function TempX11ErrorHandler(Display:PDisplay; ErrorEv:PXErrorEvent):longint;cdecl; begin WriteLn('Error: ' + IntToStr(ErrorEv^.error_code)); Result:=0; end; function TGtk1TrayIconHandle.GetCanvas: TCanvas; begin if Assigned(FCanvas) then Exit(FCanvas); Result := TCanvas.Create; Result.Handle:= GetDC(HWND(drawingarea)); FCanvas := Result; end; function TGtk1TrayIconHandle.NotifyExpose(Event: PGdkEventExpose; Widget: PGtkWidget): Boolean; cdecl; begin Result := False; PaintForm(fTrayIcon); end; function TGtk1TrayIconHandle.NotifyMouseMove(Event: PGdkEventMotion; Widget: PGtkWidget): Boolean; cdecl; begin Result := False; if Assigned(fTrayIcon.OnMouseMove) then fTrayIcon.OnMouseMove(fTrayIcon, [], Trunc(Event^.x), Trunc(Event^.y)); end; function TGtk1TrayIconHandle.NotifyMouseDown(Event: PGdkEventButton; Widget: PGtkWidget): Boolean; cdecl; var Button: TMouseButton; begin Result := False; case Event^.button of GDK_RIGHTBUTTON: Button := mbRight; GDK_MIDDLEBUTTON: Button := mbMiddle; GDK_LEFTBUTTON: Button := mbLeft; end; if Assigned(fTrayIcon.OnMouseDown) then fTrayIcon.OnMouseDown(fTrayIcon, Button, [], Trunc(Event^.x), Trunc(Event^.y)); end; function TGtk1TrayIconHandle.NotifyMouseUp(Event: PGdkEventButton; Widget: PGtkWidget): Boolean; cdecl; var Button: TMouseButton; begin Result := False; case Event^.button of 3: Button := mbRight; 2: Button := mbMiddle; 1: Button := mbLeft; end; if Button = mbLeft then case gdk_event_get_type(Event) of GDK_BUTTON_PRESS: if Assigned(fTrayIcon.OnClick) then fTrayIcon.OnClick(fTrayIcon); GDK_2BUTTON_PRESS: if Assigned(fTrayIcon.OnDblClick) then fTrayIcon.OnDblClick(fTrayIcon); end; { Just using GetPosition to get the screen position and then add Event^.x and Event^.y to it won't work. It seams that this will cause a small difference with Mouse.CursorPos, and using TPopupMenu.PopUp will result in a wrong position for the menu } if (Button = mbRight) and (fTrayIcon.PopUpMenu <> nil) then fTrayIcon.PopUpMenu.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y); if Assigned(fTrayIcon.OnMouseUp) then fTrayIcon.OnMouseUp(fTrayIcon, Button, [], Trunc(Event^.x), Trunc(Event^.y)); end; {******************************************************************* * TGtk1TrayIconHandle.Send_Message () * * DESCRIPTION: Sends a message to the X client * *******************************************************************} function TGtk1TrayIconHandle.Send_Message(window: TWindow; msg: Integer;data1, data2,data3: Integer): boolean; var Ev: TXEvent; // fmt: Integer; begin FillChar(Ev, SizeOf(TXEvent), $0); ev.xclient._type := ClientMessage; ev.xclient.window := window; ev.xclient.message_type := XInternAtom (fDisplay, '_NET_SYSTEM_TRAY_OPCODE', False ); ev.xclient.format := 32; ev.xclient.data.l[0] := CurrentTime; ev.xclient.data.l[1] := msg; ev.xclient.data.l[2] := data1; ev.xclient.data.l[3] := data2; ev.xclient.data.l[4] := data3; XSendEvent(fDisplay, fTrayParent, False, NoEventMask, @ev); XSync(fDisplay, False); Result := false;//(untrap_errors() = 0); end; function TGtk1TrayIconHandle.TrayParent(UseCachedValue: Boolean = True): TWindow; var buf: array[0..32] of char; selection_atom: TAtom; begin if (fTrayParent <> 0) and UseCachedValue then Exit(fTrayParent); fDisplay := gdk_display; fScreenID := gdk_screen; //fScreenID := XScreenNumberOfScreen(fScreen); // and it's number XGrabServer(fDisplay); buf := PChar('_NET_SYSTEM_TRAY_S' + IntToStr(fScreenID)); selection_atom := XInternAtom(fDisplay, buf, false); fTrayParent := XGetSelectionOwner(fDisplay, selection_atom); XUngrabServer(fDisplay); Result := fTrayParent; end; destructor TGtk1TrayIconHandle.Destroy; begin if Assigned(FCanvas) and FCanvas.HandleAllocated then begin ReleaseDC(HWND(drawingarea), fcanvas.Handle); FCanvas.Free; end; if Assigned(drawingarea) then begin g_signal_handlers_destroy(G_OBJECT(drawingarea)); gtk_widget_destroy(drawingarea); end; if Assigned(plug) then gtk_widget_destroy(plug); inherited Destroy; end; {******************************************************************* * TGtk1TrayIconHandle.SetEmbedded () * * DESCRIPTION: * *******************************************************************} procedure TGtk1TrayIconHandle.SetEmbedded; var old_error: TXErrorHandler; begin fEmbedded := False; if TrayParent = None then Exit; // so we have a TWindow gtk_widget_realize(plug); old_error := XSetErrorHandler(@TempX11ErrorHandler); Sleep(80); xsync(fdisplay,true); XGrabServer(fDisplay); XSelectInput(fDisplay, TrayParent, StructureNotifyMask); XUngrabServer(fDisplay); XFlush(fDisplay); fWindow := GDK_WINDOW_XWINDOW (Pointer(PGtkWidget(plug)^.window)); Send_Message(TrayParent, SYSTEM_TRAY_REQUEST_DOCK, fWindow, 0, 0); GTK_WIDGET_SET_FLAGS(plug,GTK_VISIBLE); GTK_WIDGET_SET_FLAGS(plug,GTK_MAPPED); gtk_widget_show_all(plug); XSetErrorHandler(old_error); fEmbedded:=True; end; procedure TGtk1TrayIconHandle.Hide; begin gtk_widget_hide_all(drawingarea); fEmbedded := False; end; {******************************************************************* * TGtk1TrayIconHandle.CreateForm () * * DESCRIPTION: * *******************************************************************} procedure TGtk1TrayIconHandle.CreateForm(id: Integer); begin plug := gtk_plug_new(0); drawingarea := gtk_event_box_new; gtk_container_add(GTK_CONTAINER(plug), drawingarea); //gtk_widget_add_events(drawingarea, GDK_MOTION_NOTIFY); gtk_signal_connect_object_after(G_OBJECT(drawingarea), 'expose-event', TGtkSignalFunc(@TGtk1TrayIconHandle.NotifyExpose), G_OBJECT(Self)); gtk_signal_connect_object(G_OBJECT(drawingarea), 'motion-notify-event', TGtkSignalFunc(@TGtk1TrayIconHandle.NotifyMouseMove), G_OBJECT(Self)); gtk_signal_connect_object(G_OBJECT(drawingarea), 'button-press-event', TGtkSignalFunc(@TGtk1TrayIconHandle.NotifyMouseDown), G_OBJECT(Self)); gtk_signal_connect_object(G_OBJECT(drawingarea), 'button-release-event', TGtkSignalFunc(@TGtk1TrayIconHandle.NotifyMouseUp), G_OBJECT(Self)); // fEmbedded := False; GetCanvas; end; {******************************************************************* * TGtk1TrayIconHandle.GetPosition () * * DESCRIPTION: Returns the (x, y) position of the icon on the screen * *******************************************************************} function TGtk1TrayIconHandle.GetPosition: TPoint; var WindowHandle: PGDKWindow; begin Result := Point(0, 0); if not Assigned(plug) then Exit; WindowHandle := plug^.window; if not Assigned(WindowHandle) then Exit; gdk_window_get_origin(WindowHandle, @Result.X, @Result.Y); end; {******************************************************************* * TGtk1TrayIconHandle.SetMinSize () * * DESCRIPTION: Attemps to avoid problems on Gnome * *******************************************************************} procedure TGtk1TrayIconHandle.SetMinSize(AWidth, AHeight: Integer); begin gtk_widget_set_usize(drawingarea, AWidth, AHeight); end; {******************************************************************* * TGtk1TrayIconHandle.PaintForm () * * DESCRIPTION: Paint method of the Icon Window * *******************************************************************} procedure TGtk1TrayIconHandle.PaintForm(Sender: TObject); begin if fTrayIcon.ShowIcon then Canvas.Draw(0, 0, fTrayIcon.Icon); if Assigned(fTrayIcon.OnPaint) then fTrayIcon.OnPaint(Self); end; {******************************************************************* * TGtkWSCustomTrayIcon.Hide () * * DESCRIPTION: Hides the main tray icon of the program * * PARAMETERS: None * * RETURNS: True if sucessfull, otherwise False * *******************************************************************} class function TGtkWSCustomTrayIcon.Hide(const ATrayIcon: TCustomTrayIcon): Boolean; var TrayIconHandle: TGtk1TrayIconHandle; begin Result := False; TrayIconHandle := TGtk1TrayIconHandle(ATrayIcon.Handle); TrayIconHandle.Free; ATrayIcon.Handle := 0; Result := True; end; {******************************************************************* * TGtkWSCustomTrayIcon.Show () * * DESCRIPTION: Shows the main tray icon of the program * * PARAMETERS: None * * RETURNS: True if sucessfull, otherwise False * *******************************************************************} class function TGtkWSCustomTrayIcon.Show(const ATrayIcon: TCustomTrayIcon): Boolean; var TrayIconHandle: TGtk1TrayIconHandle; begin Result := False; TrayIconHandle := TGtk1TrayIconHandle.Create; TrayIconHandle.fTrayIcon := ATrayIcon; ATrayIcon.Handle := PtrInt(TrayIconHandle); TrayIconHandle.CreateForm(0); TrayIconHandle.SetMinSize(ATrayIcon.Icon.Width, ATrayIcon.Icon.Height); TrayIconHandle.SetEmbedded; Result := True; end; {******************************************************************* * TGtkWSCustomTrayIcon.InternalUpdate () * * DESCRIPTION: Makes modifications to the Icon while running * i.e. without hiding it and showing again * *******************************************************************} class procedure TGtkWSCustomTrayIcon.InternalUpdate(const ATrayIcon: TCustomTrayIcon); var TrayIconHandle: TGtk1TrayIconHandle; begin TrayIconHandle := TGtk1TrayIconHandle(ATrayIcon.Handle); if not Assigned(TrayIconHandle) then Exit; end; {******************************************************************* * TGtkWSCustomTrayIcon.GetPosition () * * DESCRIPTION: Returns the position of the tray icon on the display. * This function is utilized to show message boxes near * the icon * *******************************************************************} class function TGtkWSCustomTrayIcon.GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint; var TrayIconHandle: TGtk1TrayIconHandle; begin Result := Point(0, 0); TrayIconHandle := TGtk1TrayIconHandle(ATrayIcon.Handle); if not Assigned(TrayIconHandle) then Exit; Result := TrayIconHandle.GetPosition; end; class function TGtkWSCustomTrayIcon.GetCanvas(const ATrayIcon: TCustomTrayIcon): TCanvas; var TrayIconHandle: TGtk1TrayIconHandle; begin TrayIconHandle := TGtk1TrayIconHandle(ATrayIcon.Handle); if not Assigned(TrayIconHandle) then Exit(ATrayIcon.Icon.Canvas); Result := TrayIconHandle.Canvas; end;