added wscommontrayicon.pas from Felipe Monteiro de Carvalho

git-svn-id: trunk@8582 -

.gitattributes

@@ -452,6 +452,7 @@ components/tdbf/dbflaz.pas svneol=native#text/pascal
 components/tdbf/registerdbf.lrs svneol=native#text/pascal
 components/tdbf/registerdbf.pas svneol=native#text/pascal
 components/tdbf/tdbf.xpm -text svneol=native#image/x-xpixmap
+components/trayicon/clean.bat svneol=native#text/plain
 components/trayicon/examples/clean.bat svneol=native#text/plain
 components/trayicon/examples/clean.sh svneol=native#text/plain
 components/trayicon/examples/frmtest.dfm svneol=native#text/plain
@@ -460,6 +461,7 @@ components/trayicon/examples/frmtest.lrs svneol=native#text/plain
 components/trayicon/examples/frmtest.pas svneol=native#text/plain
 components/trayicon/examples/icon.ico -text svneol=unset#image/ico
 components/trayicon/examples/icon.xpm svneol=native#text/plain
+components/trayicon/examples/magnifier.or -text
 components/trayicon/examples/magnifier.res -text
 components/trayicon/examples/wndtray.cfg svneol=native#text/plain
 components/trayicon/examples/wndtray.dof svneol=native#text/plain
@@ -468,6 +470,7 @@ components/trayicon/examples/wndtray.lpi svneol=native#text/plain
 components/trayicon/trayicon.pas svneol=native#text/plain
 components/trayicon/trayiconlaz.lpk svneol=native#text/plain
 components/trayicon/trayiconlaz.pas svneol=native#text/plain
+components/trayicon/wscommontrayicon.pas svneol=native#text/plain
 components/trayicon/wsgtk2trayicon.pas svneol=native#text/plain
 components/trayicon/wsgtktrayicon.pas svneol=native#text/plain
 components/trayicon/wstrayicon.pas svneol=native#text/plain

components/trayicon/clean.bat

@@ -0,0 +1,6 @@
+del *.o
+del *.dcu
+del *.bak
+del *.~pas
+del *.~dpr
+del *.dof

components/trayicon/examples/frmtest.lrs

@@ -1,5 +1,3 @@
-{ This is an automatically generated lazarus resource file }
-
 LazarusResources.Add('TForm1','FORMDATA',[
   'TPF0'#6'TForm1'#5'Form1'#13'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'
   +#12'ClientHeight'#3','#1#11'ClientWidth'#3#144#1#8'OnCreate'#7#10'FormCreate'

components/trayicon/examples/frmtest.pas

@@ -3,8 +3,8 @@
 
  *****************************************************************************
  *                                                                           *
- *  This demonstration program is public domain, which means no copyright,   *
+ *  This demonstration program is public domain, witch means no copyright,   *
- *  but also no warranty!                                                    *
+ * but also no warranty!                                                      *
  *                                                                           *
  *  This program is distributed in the hope that it will be useful,          *
  *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
@@ -107,8 +107,8 @@ begin
   SystrayIcon.Icon.LoadFromFile('icon.ico');
 {$endif}
 
-  SystrayIcon.ShowToolTip := True;
+  SystrayIcon.ShowHint := True;
-  SystrayIcon.ToolTip := 'my tool tip';
+  SystrayIcon.Hint := 'my tool tip';
 
   SystrayIcon.OnClick := HandleClick;
 //  SystrayIcon.OnPaint := DoPaint;

components/trayicon/examples/wndtray.dpr

@@ -3,8 +3,8 @@
 
  *****************************************************************************
  *                                                                           *
- *  This demonstration program is public domain, which means no copyright,   *
+ *  This demonstration program is public domain, witch means no copyright,   *
- *  but also no warranty!                                                    *
+ * but also no warranty!                                                      *
  *                                                                           *
  *  This program is distributed in the hope that it will be useful,          *
  *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
@@ -25,7 +25,7 @@ uses
   Interfaces,
 {$endif}
   Forms,
-  frmtest in 'frmtest.pas', TrayIconLaz;
+  frmtest in 'frmtest.pas';
 
 { add your units here }
 

components/trayicon/examples/wndtray.lpi

@@ -11,22 +11,22 @@
       <MainUnit Value="0"/>
       <IconPath Value="./"/>
       <TargetFileExt Value=""/>
-      <ActiveEditorIndexAtStart Value="4"/>
+      <ActiveEditorIndexAtStart Value="1"/>
     </General>
     <LazDoc Paths=""/>
-    <Units Count="2">
+    <Units Count="3">
       <Unit0>
-        <CursorPos X="40" Y="28"/>
+        <CursorPos X="15" Y="7"/>
         <EditorIndex Value="0"/>
         <Filename Value="wndtray.dpr"/>
         <IsPartOfProject Value="True"/>
         <Loaded Value="True"/>
         <TopLine Value="1"/>
         <UnitName Value="wndtray"/>
-        <UsageCount Value="45"/>
+        <UsageCount Value="56"/>
       </Unit0>
       <Unit1>
-        <CursorPos X="25" Y="84"/>
+        <CursorPos X="28" Y="24"/>
         <EditorIndex Value="1"/>
         <Filename Value="frmtest.pas"/>
         <ComponentName Value="Form1"/>
@@ -34,10 +34,18 @@
         <IsPartOfProject Value="True"/>
         <Loaded Value="True"/>
         <ResourceFilename Value="frmtest.lrs"/>
-        <TopLine Value="58"/>
+        <TopLine Value="1"/>
         <UnitName Value="frmtest"/>
-        <UsageCount Value="45"/>
+        <UsageCount Value="56"/>
       </Unit1>
+      <Unit2>
+        <CursorPos X="12" Y="12"/>
+        <Filename Value="wscommontrayicon.pas"/>
+        <IsPartOfProject Value="True"/>
+        <TopLine Value="1"/>
+        <UnitName Value="wscommontrayicon"/>
+        <UsageCount Value="23"/>
+      </Unit2>
     </Units>
     <PublishOptions>
       <Version Value="2"/>
@@ -51,17 +59,18 @@
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
-    <RequiredPackages Count="2">
+    <RequiredPackages Count="1">
       <Item1>
-        <PackageName Value="TrayIconLaz"/>
-      </Item1>
-      <Item2>
         <PackageName Value="LCL"/>
-      </Item2>
+      </Item1>
     </RequiredPackages>
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="5"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="$(LazarusDir)/lcl/units/$(TargetCPU)-$(TargetOS)/;$(LazarusDir)/lcl/units/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType)/;../"/>
+      <SrcPath Value="$(LazarusDir)/lcl/;$(LazarusDir)/lcl/interfaces/$(LCLWidgetType)/;../"/>
+    </SearchPaths>
     <CodeGeneration>
       <Generate Value="Faster"/>
     </CodeGeneration>

components/trayicon/trayicon.pas

@@ -15,6 +15,9 @@
  Authors: Felipe Monteiro de Carvalho and Andrew Haines
 
  This unit contains the SystrayIcon object.
+ 
+ Documentation for the component can be found here:
+ http://wiki.lazarus.freepascal.org/index.php/TrayIcon
 }
 {Version 0.2}
 unit TrayIcon;
@@ -36,13 +39,12 @@ type
     private
       vPopUpMenu: TPopupMenu;
       vIcon: TIcon;
-      vToolTip: string;
+      vHint: string;
-      vVisible, vShowIcon, vShowToolTip: Boolean;
+      vVisible, vShowIcon, vShowHint: Boolean;
       vOnPaint, vOnClick, vOnDblClick: TNotifyEvent;
       vOnMouseDown, vOnMouseUp: TMouseEvent;
       vOnMouseMove: TMouseMoveEvent;
       function GetCanvas: TCanvas;
-      procedure UpdateWS;
       procedure SetVisible(Value: Boolean);
     protected
     public
@@ -50,12 +52,13 @@ type
       destructor Destroy; override;
       function Hide: Boolean;
       function Show: Boolean;
+      procedure UpdateWS;
       property Canvas: TCanvas read GetCanvas;
     published
       property PopUpMenu: TPopupMenu read vPopUpMenu write vPopUpMenu;
       property Icon: TIcon read vIcon write vIcon;
-      property ToolTip: string read vToolTip write vToolTip;
+      property Hint: string read vHint write vHint;
-      property ShowToolTip: Boolean read vShowToolTip write vShowToolTip;
+      property ShowHint: Boolean read vShowHint write vShowHint;
       property ShowIcon: Boolean read vShowIcon write vShowIcon;
       property Visible: Boolean read vVisible write SetVisible;
       property OnClick: TNotifyEvent read vOnClick write vOnClick;
@@ -177,9 +180,9 @@ procedure TTrayIconClass.UpdateWS;
 begin
   vwsTrayIcon.Icon.Assign(vIcon);
   vwsTrayIcon.PopUpMenu := vPopUpMenu;
-  vwsTrayIcon.ShowToolTip := vShowToolTip;
+  vwsTrayIcon.ShowHint := vShowHint;
   vwsTrayIcon.ShowIcon := vShowIcon;
-  StrCopy(PChar(vwsTrayIcon.ToolTip), PChar(vToolTip));
+  vwsTrayIcon.Hint := vHint;
 
   // Update events
   vwsTrayIcon.OnClick := vOnClick;
@@ -188,6 +191,9 @@ begin
   vwsTrayIcon.OnMouseDown := vOnMouseDown;
   vwsTrayIcon.OnMouseUp := vOnMouseUp;
   vwsTrayIcon.OnMouseMove := vOnMouseMove;
+  
+  // Allows the widgetset to update itself internally
+  vwsTrayIcon.InternalUpdate;
 end;
 
 {*******************************************************************

components/trayicon/wscommontrayicon.pas

@@ -0,0 +1,94 @@
+{
+ wscommontrayicon.pas
+
+ *****************************************************************************
+ *                                                                           *
+ *  See the file COPYING.modifiedLGPL, included in this distribution,        *
+ *  for details about the copyright.                                         *
+ *                                                                           *
+ *  This program is distributed in the hope that it will be useful,          *
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
+ *                                                                           *
+ *****************************************************************************
+
+ Authors: Felipe Monteiro de Carvalho and Andrew Haines
+
+ Common code to all widgetsets.
+}
+unit wscommontrayicon;
+
+{$ifdef FPC}
+  {$mode delphi}{$H+}
+  {$PACKRECORDS C}
+{$endif}
+
+interface
+
+uses
+  Graphics, Classes, SysUtils, Controls, Menus;
+
+type
+  { TCustomWidgetTrayIcon }
+
+  TCustomWidgetTrayIcon = class(TObject)
+    private
+    protected
+      vVisible: Boolean;
+    public
+      uID: Cardinal;
+      Icon: TIcon;
+      ShowIcon, ShowHint: Boolean;
+      PopUpMenu: TPopUpMenu;
+      Hint: string;
+      OnPaint, OnClick, OnDblClick: TNotifyEvent;
+      OnMouseDown, OnMouseUp: TMouseEvent;
+      OnMouseMove: TMouseMoveEvent;
+      constructor Create;  virtual;
+      destructor Destroy; override;
+      procedure InternalUpdate; virtual; abstract;
+    published
+  end;
+
+implementation
+
+{ TCustomWidgetTrayIcon }
+
+{*******************************************************************
+*  TCustomWidgetTrayIcon.Create ()
+*
+*  DESCRIPTION:    Creates a object from the TWidgetTrayIcon class
+*
+*  PARAMETERS:     None
+*
+*  RETURNS:        A pointer to the newly created object
+*
+*******************************************************************}
+constructor TCustomWidgetTrayIcon.Create;
+begin
+  inherited Create;
+
+  Icon := TIcon.Create;
+
+  uID := 3;
+end;
+
+{*******************************************************************
+*  TCustomWidgetTrayIcon.Destroy ()
+*
+*  DESCRIPTION:    Destroys a object derived from the TWidgetTrayIcon class
+*
+*  PARAMETERS:     None
+*
+*  RETURNS:        Nothing
+*
+*******************************************************************}
+destructor TCustomWidgetTrayIcon.Destroy;
+begin
+  Icon.Free;
+
+  inherited Destroy;
+end;
+
+end.
+

components/trayicon/wsgtk2trayicon.pas

@@ -22,17 +22,19 @@ unit wsgtk2trayicon;
   {$mode delphi}{$H+}
 {$endif}
 
+{$PACKRECORDS C}
+  
 interface
 
 uses
-  Graphics, Classes, ExtCtrls, SysUtils, StdCtrls, Forms, Controls, Dialogs,
+  Graphics, Classes, ExtCtrls, SysUtils, Forms, Controls, Dialogs,
-  Menus, x, xlib, xutil, gtk2, gdk2;
+  Menus, wscommontrayicon, x, xlib, xutil, gtk2, gdk2, gtkproc;
 
 type
 
   { TWidgetTrayIcon }
 
-  TWidgetTrayIcon = class(TObject)
+  TWidgetTrayIcon = class(TCustomWidgetTrayIcon)
     private
       fDisplay: PDisplay;
       fWindow: TWindow;
@@ -44,7 +46,7 @@ type
       fEmbedded: Boolean;
       fMsgCount: Integer;
       procedure SetEmbedded;
-      function Send_Message(window: TWindow; msg: Integer;data1, data2,data3: Integer): boolean;
+      function Send_Message(window: TWindow; msg: Integer; data1, data2, data3: Integer): boolean;
       procedure SetMinSize(AWidth, AHeight: Integer);
       procedure PaintForm(Sender: TObject);
       procedure CreateForm(id: Integer);
@@ -52,19 +54,10 @@ type
       function GetCanvas: TCanvas;
     protected
     public
-      uID: Cardinal;
-      Icon: TIcon;
-      ShowIcon, ShowToolTip: Boolean;
-      PopUpMenu: TPopUpMenu;
-      ToolTip: string;
-      OnPaint, OnClick, OnDblClick: TNotifyEvent;
-      OnMouseDown, OnMouseUp: TMouseEvent;
-      OnMouseMove: TMouseMoveEvent;
-      constructor Create;
-      destructor Destroy; override;
       function Hide: Boolean;
       function Show: Boolean;
       property Canvas: TCanvas read GetCanvas;
+      procedure InternalUpdate; override;
     published
   end;
 
@@ -75,7 +68,26 @@ const
 
 implementation
 
-// Temp ErrorHandler
+type
+  PX11GdkDrawable = ^TX11GdkDrawable;
+
+  TX11GdkDrawable = record
+    parent_instance: TGdkWindow;
+    wrapper: PGdkDrawable;
+    colormap: PGdkColorMap;
+    xid:x.TWindow;
+  end;
+
+{*******************************************************************
+*  TempX11ErrorHandler ()
+*
+*  DESCRIPTION:    Temp ErrorHandler
+*
+*  PARAMETERS:     ?
+*
+*  RETURNS:        ?
+*
+*******************************************************************}
 function TempX11ErrorHandler(Display:PDisplay; ErrorEv:PXErrorEvent):longint;cdecl;
 begin
   WriteLn('Error: ' + IntToStr(ErrorEv^.error_code));
@@ -85,41 +97,15 @@ end;
 { TWidgetTrayIcon }
 
 {*******************************************************************
-*  TWidgetTrayIcon.Create ()
+*  TWidgetTrayIcon.SetEmbedded ()
 *
-*  DESCRIPTION:    Creates a object from the TWidgetTrayIcon class
+*  DESCRIPTION:
-*
-*  PARAMETERS:     None
-*
-*  RETURNS:        A pointer to the newly created object
-*
-*******************************************************************}
-constructor TWidgetTrayIcon.Create;
-begin
-  inherited Create;
-
-  Icon := TIcon.Create;
-
-  uID := 3;
-end;
-
-{*******************************************************************
-*  TWidgetTrayIcon.Destroy ()
-*
-*  DESCRIPTION:    Destroys a object derived from the TWidgetTrayIcon class
 *
 *  PARAMETERS:     None
 *
 *  RETURNS:        Nothing
 *
 *******************************************************************}
-destructor TWidgetTrayIcon.Destroy;
-begin
-  Icon.Free;
-
-  inherited Destroy;
-end;
-
 procedure TWidgetTrayIcon.SetEmbedded;
 var
   old_error: TXErrorHandler;
@@ -146,7 +132,17 @@ begin
   XSetErrorHandler(old_error);
 end;
 
-function TWidgetTrayIcon.Send_Message(window: TWindow; msg: Integer;data1, data2,data3: Integer): boolean;
+{*******************************************************************
+*  TWidgetTrayIcon.Send_Message ()
+*
+*  DESCRIPTION:    Sends a message to the X client
+*
+*  PARAMETERS:     None
+*
+*  RETURNS:        Nothing
+*
+*******************************************************************}
+function TWidgetTrayIcon.Send_Message(window: TWindow; msg: Integer; data1, data2, data3: Integer): boolean;
 var
   Ev: TXEvent;
   fmt: Integer;
@@ -165,7 +161,19 @@ begin
   Result := false;//(untrap_errors() = 0);
 end;
 
+{*******************************************************************
+*  TWidgetTrayIcon.CreateForm ()
+*
+*  DESCRIPTION:
+*
+*  PARAMETERS:     None
+*
+*  RETURNS:        Nothing
+*
+*******************************************************************}
 procedure TWidgetTrayIcon.CreateForm(id: Integer);
+var
+  Widget: PGtkWidget;
 begin
   GtkForm := TForm.Create(nil);
   fEmbedded := False;
@@ -185,17 +193,40 @@ begin
 
   Application.ProcessMessages;
 
-  fDisplay := (PGdkWindowPrivate(PGtkWidget(GtkForm.Handle)^.window))^.xdisplay;
+  fDisplay := GDK_DISPLAY;
-  fWindow := GDK_WINDOW_XWINDOW (Pointer(PGtkWidget(GtkForm.Handle)^.window));
+//  SHowMessage(IntToStr(Integer(fDisplay)));
+  Widget := PGtkWidget(GtkForm.Handle);
+  fWindow := PX11GdkDrawable(PGdkWindowObject(Widget^.window)^.impl)^.xid;
+
   fScreen := XDefaultScreenOfDisplay(fDisplay); // get the screen
   fScreenID := XScreenNumberOfScreen(fScreen); // and it's number
 end;
 
+{*******************************************************************
+*  TWidgetTrayIcon.RemoveForm ()
+*
+*  DESCRIPTION:
+*
+*  PARAMETERS:     None
+*
+*  RETURNS:        Nothing
+*
+*******************************************************************}
 procedure TWidgetTrayIcon.RemoveForm(id: Integer);
 begin
   GtkForm.Free;
 end;
 
+{*******************************************************************
+*  TWidgetTrayIcon.GetCanvas ()
+*
+*  DESCRIPTION:
+*
+*  PARAMETERS:     None
+*
+*  RETURNS:        Nothing
+*
+*******************************************************************}
 function TWidgetTrayIcon.GetCanvas: TCanvas;
 begin
   Result := GtkForm.Canvas;
@@ -213,7 +244,15 @@ end;
 *******************************************************************}
 function TWidgetTrayIcon.Hide: Boolean;
 begin
+  Result := False;
+
+  if not vVisible then Exit;
+
   RemoveForm(0);
+
+  vVisible := False;
+  
+  Result := True;
 end;
 
 {*******************************************************************
@@ -228,6 +267,10 @@ end;
 *******************************************************************}
 function TWidgetTrayIcon.Show: Boolean;
 begin
+  Result := False;
+
+  if vVisible then Exit;
+  
   CreateForm(0);
 
   SetEmbedded;
@@ -247,8 +290,22 @@ begin
   GtkForm.PopupMenu := Self.PopUpMenu;
 
   fEmbedded := True;
+
+  vVisible := True;
+
+  Result := True;
 end;
 
+{*******************************************************************
+*  TWidgetTrayIcon.SetMinSize ()
+*
+*  DESCRIPTION:    Attemps to avoid problems on Gnome
+*
+*  PARAMETERS:
+*
+*  RETURNS:        Nothing
+*
+*******************************************************************}
 procedure TWidgetTrayIcon.SetMinSize(AWidth, AHeight: Integer);
 var
   size_hints: TXSizeHints;
@@ -261,6 +318,16 @@ begin
   XSetStandardProperties(fDisplay, fWindow, nil, nil, None, nil, 0, @size_hints);
 end;
 
+{*******************************************************************
+*  TWidgetTrayIcon.PaintForm ()
+*
+*  DESCRIPTION:    Paint method of the Icon Window
+*
+*  PARAMETERS:     Sender of the event
+*
+*  RETURNS:        Nothing
+*
+*******************************************************************}
 procedure TWidgetTrayIcon.PaintForm(Sender: TObject);
 begin
   if ShowIcon then GtkForm.Canvas.Draw(0, 0, Icon);
@@ -268,5 +335,21 @@ begin
   if Assigned(OnPaint) then OnPaint(Self);
 end;
 
+{*******************************************************************
+*  TWidgetTrayIcon.InternalUpdate ()
+*
+*  DESCRIPTION:    Makes modifications to the Icon while running
+*                  i.e. without hiding it and showing again
+*
+*  PARAMETERS:     None
+*
+*  RETURNS:        Nothing
+*
+*******************************************************************}
+procedure TWidgetTrayIcon.InternalUpdate;
+begin
+  if Assigned(GtkForm) then GtkForm.PopupMenu := Self.PopUpMenu;
+end;
+
 end.
 

components/trayicon/wsgtktrayicon.pas

@@ -14,7 +14,7 @@
 
  Authors: Felipe Monteiro de Carvalho and Andrew Haines
 
- Gtk1 and Gnome specific code.
+ Gtk1 specific code. Works on gnome also.
 }
 unit wsgtktrayicon;
 
@@ -25,14 +25,14 @@ unit wsgtktrayicon;
 interface
 
 uses
-  Graphics, Classes, ExtCtrls, SysUtils, StdCtrls, Forms, Controls, Dialogs,
+  Graphics, Classes, ExtCtrls, SysUtils, Forms, Controls, Dialogs,
-  Menus, x, xlib, xutil, gtk, gdk;
+  Menus, wscommontrayicon, x, xlib, xutil, gtk, gdk;
 
 type
 
   { TWidgetTrayIcon }
 
-  TWidgetTrayIcon = class(TObject)
+  TWidgetTrayIcon = class(TCustomWidgetTrayIcon)
     private
       fDisplay: PDisplay;
       fWindow: TWindow;
@@ -52,19 +52,10 @@ type
       function GetCanvas: TCanvas;
     protected
     public
-      uID: Cardinal;
-      Icon: TIcon;
-      ShowIcon, ShowToolTip: Boolean;
-      PopUpMenu: TPopUpMenu;
-      ToolTip: string;
-      OnPaint, OnClick, OnDblClick: TNotifyEvent;
-      OnMouseDown, OnMouseUp: TMouseEvent;
-      OnMouseMove: TMouseMoveEvent;
-      constructor Create;
-      destructor Destroy; override;
       function Hide: Boolean;
       function Show: Boolean;
       property Canvas: TCanvas read GetCanvas;
+      procedure InternalUpdate; override;
     published
   end;
 
@@ -79,47 +70,22 @@ implementation
 function TempX11ErrorHandler(Display:PDisplay; ErrorEv:PXErrorEvent):longint;cdecl;
 begin
   WriteLn('Error: ' + IntToStr(ErrorEv^.error_code));
+  Result:=0;
 end;
 
 
 { TWidgetTrayIcon }
 
 {*******************************************************************
-*  TWidgetTrayIcon.Create ()
+*  TWidgetTrayIcon.SetEmbedded ()
 *
-*  DESCRIPTION:    Creates a object from the TWidgetTrayIcon class
+*  DESCRIPTION:
-*
-*  PARAMETERS:     None
-*
-*  RETURNS:        A pointer to the newly created object
-*
-*******************************************************************}
-constructor TWidgetTrayIcon.Create;
-begin
-  inherited Create;
-
-  Icon := TIcon.Create;
-
-  uID := 3;
-end;
-
-{*******************************************************************
-*  TWidgetTrayIcon.Destroy ()
-*
-*  DESCRIPTION:    Destroys a object derived from the TWidgetTrayIcon class
 *
 *  PARAMETERS:     None
 *
 *  RETURNS:        Nothing
 *
 *******************************************************************}
-destructor TWidgetTrayIcon.Destroy;
-begin
-  Icon.Free;
-
-  inherited Destroy;
-end;
-
 procedure TWidgetTrayIcon.SetEmbedded;
 var
   old_error: TXErrorHandler;
@@ -146,6 +112,16 @@ begin
   XSetErrorHandler(old_error);
 end;
 
+{*******************************************************************
+*  TWidgetTrayIcon.Send_Message ()
+*
+*  DESCRIPTION:    Sends a message to the X client
+*
+*  PARAMETERS:     None
+*
+*  RETURNS:        Nothing
+*
+*******************************************************************}
 function TWidgetTrayIcon.Send_Message(window: TWindow; msg: Integer;data1, data2,data3: Integer): boolean;
 var
   Ev: TXEvent;
@@ -165,6 +141,16 @@ begin
   Result := false;//(untrap_errors() = 0);
 end;
 
+{*******************************************************************
+*  TWidgetTrayIcon.CreateForm ()
+*
+*  DESCRIPTION:
+*
+*  PARAMETERS:     None
+*
+*  RETURNS:        Nothing
+*
+*******************************************************************}
 procedure TWidgetTrayIcon.CreateForm(id: Integer);
 begin
   GtkForm := TForm.Create(nil);
@@ -186,16 +172,37 @@ begin
   Application.ProcessMessages;
 
   fDisplay := GDK_WINDOW_XDISPLAY(Pointer(PGtkWidget(GtkForm.Handle)^.window));
+//  SHowMessage(IntToStr(Integer(fDisplay)));
   fWindow := GDK_WINDOW_XWINDOW (Pointer(PGtkWidget(GtkForm.Handle)^.window));
   fScreen := XDefaultScreenOfDisplay(fDisplay); // get the screen
   fScreenID := XScreenNumberOfScreen(fScreen); // and it's number
 end;
 
+{*******************************************************************
+*  TWidgetTrayIcon.RemoveForm ()
+*
+*  DESCRIPTION:
+*
+*  PARAMETERS:     None
+*
+*  RETURNS:        Nothing
+*
+*******************************************************************}
 procedure TWidgetTrayIcon.RemoveForm(id: Integer);
 begin
   GtkForm.Free;
 end;
 
+{*******************************************************************
+*  TWidgetTrayIcon.GetCanvas ()
+*
+*  DESCRIPTION:
+*
+*  PARAMETERS:     None
+*
+*  RETURNS:        Nothing
+*
+*******************************************************************}
 function TWidgetTrayIcon.GetCanvas: TCanvas;
 begin
   Result := GtkForm.Canvas;
@@ -213,7 +220,15 @@ end;
 *******************************************************************}
 function TWidgetTrayIcon.Hide: Boolean;
 begin
+  Result := False;
+
+  if not vVisible then Exit;
+
   RemoveForm(0);
+
+  vVisible := False;
+
+  Result := True;
 end;
 
 {*******************************************************************
@@ -228,6 +243,10 @@ end;
 *******************************************************************}
 function TWidgetTrayIcon.Show: Boolean;
 begin
+  Result := False;
+
+  if vVisible then Exit;
+
   CreateForm(0);
   
   SetEmbedded;
@@ -245,10 +264,25 @@ begin
   GtkForm.OnClick := Self.OnClick;
   GtkForm.OnPaint := PaintForm;
   GtkForm.PopupMenu := Self.PopUpMenu;
+  GtkForm.Hint := Self.Hint;
 
   fEmbedded := True;
+  
+  vVisible := True;
+
+  Result := True;
 end;
 
+{*******************************************************************
+*  TWidgetTrayIcon.SetMinSize ()
+*
+*  DESCRIPTION:    Attemps to avoid problems on Gnome
+*
+*  PARAMETERS:
+*
+*  RETURNS:        Nothing
+*
+*******************************************************************}
 procedure TWidgetTrayIcon.SetMinSize(AWidth, AHeight: Integer);
 var
   size_hints: TXSizeHints;
@@ -261,6 +295,16 @@ begin
   XSetStandardProperties(fDisplay, fWindow, nil, nil, None, nil, 0, @size_hints);
 end;
 
+{*******************************************************************
+*  TWidgetTrayIcon.PaintForm ()
+*
+*  DESCRIPTION:    Paint method of the Icon Window
+*
+*  PARAMETERS:     Sender of the event
+*
+*  RETURNS:        Nothing
+*
+*******************************************************************}
 procedure TWidgetTrayIcon.PaintForm(Sender: TObject);
 begin
   if ShowIcon then GtkForm.Canvas.Draw(0, 0, Icon);
@@ -268,5 +312,21 @@ begin
   if Assigned(OnPaint) then OnPaint(Self);
 end;
 
+{*******************************************************************
+*  TWidgetTrayIcon.InternalUpdate ()
+*
+*  DESCRIPTION:    Makes modifications to the Icon while running
+*                  i.e. without hiding it and showing again
+*
+*  PARAMETERS:     None
+*
+*  RETURNS:        Nothing
+*
+*******************************************************************}
+procedure TWidgetTrayIcon.InternalUpdate;
+begin
+  if Assigned(GtkForm) then GtkForm.PopupMenu := Self.PopUpMenu;
+end;
+
 end.
 

components/trayicon/wstrayicon.pas

@@ -43,7 +43,7 @@ uses
   wsgtktrayicon,
 {$endif}
 {$ifdef LCLGtk2}
-  wsgtk2trayicon, // not working yet
+  wsgtk2trayicon,
 {$endif}
   Classes, SysUtils;
 

components/trayicon/wswin32trayicon.pas

@@ -25,31 +25,24 @@ unit wswin32trayicon;
 interface
 
 uses
-  Graphics, Classes, SysUtils, Menus, Forms, Controls;
+  Graphics, Classes, SysUtils, Menus, Forms, Controls, wscommontrayicon;
 
 type
 
   { TWidgetTrayIcon }
 
-  TWidgetTrayIcon = class(TObject)
+  TWidgetTrayIcon = class(TCustomWidgetTrayIcon)
     private
       WindowHandle: Cardinal;
       function GetCanvas: TCanvas;
     protected
     public
-      uID: Cardinal;
+      constructor Create; override;
-      Icon: TIcon;
-      ShowIcon, ShowToolTip: Boolean;
-      PopUpMenu: TPopUpMenu;
-      ToolTip: array [0..63] of AnsiChar;
-      OnPaint, OnClick, OnDblClick: TNotifyEvent;
-      OnMouseDown, OnMouseUp: TMouseEvent;
-      OnMouseMove: TMouseMoveEvent;
-      constructor Create;
       destructor Destroy; override;
       function Hide: Boolean;
       function Show: Boolean;
       property Canvas: TCanvas read GetCanvas;
+      procedure InternalUpdate; override;
     published
   end;
 
@@ -72,11 +65,15 @@ const
 *                  fwKeys = wParam;        // key flags
 *                  xPos = LOWORD(lParam);  // horizontal position of cursor
 *                  yPos = HIWORD(lParam);  // vertical position of cursor
+*                                          //* Those positions seam to be wrong
+*                                          // Use Mouse.CursorPos instead
 *
 *  RETURNS:        A pointer to the newly created object
 *
 *******************************************************************}
 function TrayWndProc(Handle: HWND; iMsg: UINT; WParam_: WPARAM; LParam_:LPARAM):LRESULT; stdcall;
+var
+  pt: TPoint;
 begin
   {*******************************************************************
   *  The separate check on vwsTrayIconCreated is necessary because
@@ -91,7 +88,16 @@ begin
         if Assigned(vwsTrayIcon.OnMouseUp) then vwsTrayIcon.OnMouseUp(Application,
          mbRight, KeysToShiftState(WParam_), LOWORD(lParam_), HIWORD(lParam_));
         if Assigned(vwsTrayIcon.PopUpMenu) then
-         vwsTrayIcon.PopUpMenu.Popup(LOWORD(lParam_), HIWORD(lParam_));
+        begin
+          pt := Mouse.CursorPos;// Gets cursor position in screen coords
+
+          // Apparently SetForegroundWindow and PostMessage are necessary
+          // because we're invoking the shortcut menu from a notification icon
+          // This is an attempt to prevent from messing with the Z-order
+          SetForegroundWindow(Handle);
+          PostMessage(Handle, WM_NULL, 0, 0);
+          vwsTrayIcon.PopUpMenu.Popup(pt.x, pt.y);
+        end;
       end;
       WM_RBUTTONDOWN: if Assigned(vwsTrayIcon.OnMouseDown) then vwsTrayIcon.OnMouseDown(Application,
        mbRight, KeysToShiftState(WParam_), LOWORD(lParam_), HIWORD(lParam_));
@@ -127,7 +133,9 @@ end;
 
 function TWidgetTrayIcon.GetCanvas: TCanvas;
 begin
+{$ifdef FPC}
   Result := Icon.Canvas;
+{$endif}
 end;
 
 {*******************************************************************
@@ -146,10 +154,6 @@ var
 begin
   inherited Create;
 
-  Icon := TIcon.Create;
-
-  uID := 3;
-
   ZeroMemory(@Window, SizeOf(TWndClassEx));
   Window.cbSize := SizeOf(TWndClassEx);
   Window.style := CS_OWNDC;
@@ -157,7 +161,7 @@ begin
   Window.cbClsExtra := 0;
   Window.cbWndExtra := 0;
   Window.hInstance := hInstance;
-//  Window.hIcon := Icon.Picture.Icon.Handle;
+//  Window.hIcon := Icon.Handle;
   Window.hCursor := LoadCursor(0, IDC_ARROW);
   Window.hbrBackground := HBRUSH(GetStockObject(NULL_BRUSH));
   Window.lpszMenuName := nil;
@@ -200,8 +204,6 @@ begin
 
   Application.ProcessMessages;
 
-  Icon.Free;
-
   inherited Destroy;
 end;
 
@@ -219,6 +221,8 @@ function TWidgetTrayIcon.Hide: Boolean;
 var
   tnid: TNotifyIconData;
 begin
+  if not vVisible then Exit;
+
   // Fill TNotifyIconData
   tnid.cbSize := SizeOf(TNotifyIconData);
 {$IFNDEF FPC}
@@ -230,6 +234,8 @@ begin
 
   // Remove the icon
   Result := Shell_NotifyIconA(NIM_DELETE, @tnid);
+
+  vVisible := False;
 end;
 
 {*******************************************************************
@@ -245,7 +251,10 @@ end;
 function TWidgetTrayIcon.Show: Boolean;
 var
   tnid: TNotifyIconData;
+  buffer: PChar;
 begin
+  if vVisible then Exit;
+
   // Fill TNotifyIconData
   FillChar(tnid, SizeOf(tnid), 0);
   tnid.cbSize := SizeOf(TNotifyIconData);
@@ -256,13 +265,20 @@ begin
 {$ENDIF}
   tnid.uID := uID;
   tnid.uFlags := NIF_MESSAGE or NIF_ICON;
-  if ShowToolTip then tnid.uFlags := tnid.uFlags or NIF_TIP;
+  if ShowHint then tnid.uFlags := tnid.uFlags or NIF_TIP;
   tnid.uCallbackMessage := WM_USER + uID;
   tnid.hIcon := Icon.Handle;
-  Move(ToolTip, tnid.szTip, SizeOf(tnid.szTip));
+  buffer := PChar(Hint);
+  StrCopy(@tnid.szTip, buffer);
 
   // Create Taskbar icon
   Result := Shell_NotifyIconA(NIM_ADD, @tnid);
+
+  vVisible := True;
+end;
+
+procedure TWidgetTrayIcon.InternalUpdate;
+begin
 end;
 
 end.