diff --git a/.gitattributes b/.gitattributes index 0b373bbff0..841efd03b7 100644 --- a/.gitattributes +++ b/.gitattributes @@ -448,6 +448,27 @@ 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/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 +components/trayicon/examples/frmtest.lfm svneol=native#text/plain +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 +components/trayicon/examples/wndtray.dpr svneol=native#text/plain +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/wsgtk2trayicon.pas svneol=native#text/plain +components/trayicon/wsgtktrayicon.pas svneol=native#text/plain +components/trayicon/wstrayicon.pas svneol=native#text/plain +components/trayicon/wswin32trayicon.pas svneol=native#text/plain components/turbopower_ipro/ipanim.pas svneol=native#text/pascal components/turbopower_ipro/ipconst.pas svneol=native#text/pascal components/turbopower_ipro/ipdefct.inc svneol=native#text/pascal @@ -2141,6 +2162,7 @@ packager/globallinks/lazopenglcontext-0.lpl svneol=native#text/plain packager/globallinks/macosfiles-0.lpl svneol=native#text/plain packager/globallinks/prettyformat-0.lpl svneol=native#text/plain packager/globallinks/projtemplates-0.lpl svneol=native#text/plain +packager/globallinks/trayiconlaz-0.lpl svneol=native#text/plain packager/installpkgsetdlg.lfm svneol=native#text/plain packager/installpkgsetdlg.lrs svneol=native#text/pascal packager/installpkgsetdlg.pas svneol=native#text/pascal diff --git a/components/trayicon/examples/clean.bat b/components/trayicon/examples/clean.bat new file mode 100644 index 0000000000..ee4134f011 --- /dev/null +++ b/components/trayicon/examples/clean.bat @@ -0,0 +1,9 @@ +del *.o +del *.or +del *.dcu +del *.ppu +del *.bak +del *.~pas +del *.~dpr +del *.dpr~ +del *.dof diff --git a/components/trayicon/examples/clean.sh b/components/trayicon/examples/clean.sh new file mode 100755 index 0000000000..e2bf828f3d --- /dev/null +++ b/components/trayicon/examples/clean.sh @@ -0,0 +1,2 @@ +#!/bin/bash +rm -f $1*.or diff --git a/components/trayicon/examples/frmtest.dfm b/components/trayicon/examples/frmtest.dfm new file mode 100644 index 0000000000..af01df1dbb --- /dev/null +++ b/components/trayicon/examples/frmtest.dfm @@ -0,0 +1,29 @@ +object Form1: TForm1 + Caption = 'Form1' + ClientHeight = 300 + ClientWidth = 400 + OnCreate = FormCreate + PixelsPerInch = 96 + Left = 290 + Height = 300 + Top = 175 + Width = 400 + object Button1: TButton + Caption = 'Show' + OnClick = Button1Click + TabOrder = 0 + Left = 75 + Height = 25 + Top = 56 + Width = 75 + end + object Button2: TButton + Caption = 'Hide' + OnClick = Button2Click + TabOrder = 1 + Left = 75 + Height = 25 + Top = 95 + Width = 75 + end +end diff --git a/components/trayicon/examples/frmtest.lfm b/components/trayicon/examples/frmtest.lfm new file mode 100644 index 0000000000..e700234b6a --- /dev/null +++ b/components/trayicon/examples/frmtest.lfm @@ -0,0 +1,34 @@ +object Form1: TForm1 + ActiveControl = Button1 + Caption = 'Form1' + ClientHeight = 300 + ClientWidth = 400 + OnCreate = FormCreate + PixelsPerInch = 78 + HorzScrollBar.Page = 399 + VertScrollBar.Page = 299 + Left = 290 + Height = 300 + Top = 175 + Width = 400 + object Button1: TButton + BorderSpacing.InnerBorder = 2 + Caption = 'Show' + OnClick = Button1Click + TabOrder = 0 + Left = 75 + Height = 25 + Top = 56 + Width = 75 + end + object Button2: TButton + BorderSpacing.InnerBorder = 2 + Caption = 'Hide' + OnClick = Button2Click + TabOrder = 1 + Left = 75 + Height = 25 + Top = 95 + Width = 75 + end +end diff --git a/components/trayicon/examples/frmtest.lrs b/components/trayicon/examples/frmtest.lrs new file mode 100644 index 0000000000..fa309f030e --- /dev/null +++ b/components/trayicon/examples/frmtest.lrs @@ -0,0 +1,13 @@ +{ 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' + +#13'PixelsPerInch'#2'N'#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page' + +#3'+'#1#4'Left'#3'"'#1#6'Height'#3','#1#3'Top'#3#175#0#5'Width'#3#144#1#0#7 + +'TButton'#7'Button1'#25'BorderSpacing.InnerBorder'#2#2#7'Caption'#6#4'Show'#7 + +'OnClick'#7#12'Button1Click'#8'TabOrder'#2#0#4'Left'#2'K'#6'Height'#2#25#3'T' + +'op'#2'8'#5'Width'#2'K'#0#0#7'TButton'#7'Button2'#25'BorderSpacing.InnerBord' + +'er'#2#2#7'Caption'#6#4'Hide'#7'OnClick'#7#12'Button2Click'#8'TabOrder'#2#1#4 + +'Left'#2'K'#6'Height'#2#25#3'Top'#2'_'#5'Width'#2'K'#0#0#0 +]); diff --git a/components/trayicon/examples/frmtest.pas b/components/trayicon/examples/frmtest.pas new file mode 100644 index 0000000000..6e2c065438 --- /dev/null +++ b/components/trayicon/examples/frmtest.pas @@ -0,0 +1,101 @@ +unit frmtest; + +{$ifdef fpc} + {$mode delphi}{$H+} +{$endif} + +interface + +uses + Classes, SysUtils, +{$ifdef LCL} + LResources, +{$endif} + Forms, Controls, Graphics, Dialogs, Buttons, StdCtrls; + +type + + { TForm1 } + + TForm1 = class(TForm) + Button1: TButton; + Button2: TButton; + procedure Button1Click(Sender: TObject); + procedure Button2Click(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure HandleClick(Sender: TObject); + private + { private declarations } + procedure DoPaint(Sender: TObject); + public + { public declarations } + end; + +var + Form1: TForm1; + +{$ifndef LCL} + {$R frmtest.dfm} +{$endif} + +implementation + +uses +{$ifdef win32} + Windows, +{$endif} + TrayIcon; + +{ TForm1 } + +procedure TForm1.Button1Click(Sender: TObject); +begin + SystrayIcon.Show; +end; + +procedure TForm1.Button2Click(Sender: TObject); +begin + SystrayIcon.Hide; +end; + +procedure TForm1.FormCreate(Sender: TObject); +const + IDI_ICON1 = 101; + IDI_ICON2 = 115; +begin +{$ifdef win32} + SystrayIcon.Icon.Handle := LoadIcon(hInstance, MAKEINTRESOURCE(IDI_ICON1)); +{$else} + SystrayIcon.Icon.LoadFromFile('icon.ico'); +{$endif} + + SystrayIcon.ShowToolTip := True; + SystrayIcon.ToolTip := 'my tool tip'; + + SystrayIcon.OnClick := HandleClick; + SystrayIcon.OnPaint := DoPaint; +end; + +procedure TForm1.HandleClick(Sender: TObject); +begin + Application.MessageBox('Text', 'Caption', 0); +end; + +procedure TForm1.DoPaint(Sender: TObject); +var + MyImage: TPixmap; +begin + MyImage := TPixmap.Create; + MyImage.LoadFromFile('icon.xpm'); + SystrayIcon.Canvas.Draw(0, 0, MyImage); + MyImage.Free; + WriteLn('Paint'); +end; + +initialization +{$ifdef LCL} + {$I frmtest.lrs} +{$endif} + +end. + diff --git a/components/trayicon/examples/icon.ico b/components/trayicon/examples/icon.ico new file mode 100644 index 0000000000..3fe34ad084 Binary files /dev/null and b/components/trayicon/examples/icon.ico differ diff --git a/components/trayicon/examples/icon.xpm b/components/trayicon/examples/icon.xpm new file mode 100644 index 0000000000..f13fca420b --- /dev/null +++ b/components/trayicon/examples/icon.xpm @@ -0,0 +1,28 @@ +/* XPM */ +static char * icon_xpm[] = { +"22 22 3 1", +" c #000000", +". c #D2C600", +"+ c #A02FFF", +" ................", +" ................", +" .................", +" .................", +" .................", +" ..................", +" .....++++++++....", +" ..+++++++++++++++", +" ..+++++++++++++++", +" ..+++++++++++++++", +" ..+++++++++++++++", +" ....+++++++++++++++", +" ....+++++++++++++++", +" .....++++++++++++++", +" .....++++++++++++++", +" .....+++++++++++++", +" .......++++++++++++", +" .........+++++++++++", +" .........+++++++++++", +" .........+++++++++++", +" .........+++++++++++", +" .........+++++++++++"}; diff --git a/components/trayicon/examples/magnifier.or b/components/trayicon/examples/magnifier.or new file mode 100644 index 0000000000..4b8d8b2c57 Binary files /dev/null and b/components/trayicon/examples/magnifier.or differ diff --git a/components/trayicon/examples/magnifier.res b/components/trayicon/examples/magnifier.res new file mode 100644 index 0000000000..7e9cbe1834 Binary files /dev/null and b/components/trayicon/examples/magnifier.res differ diff --git a/components/trayicon/examples/wndtray.cfg b/components/trayicon/examples/wndtray.cfg new file mode 100644 index 0000000000..f21cd871c6 --- /dev/null +++ b/components/trayicon/examples/wndtray.cfg @@ -0,0 +1,42 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J- +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R- +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$YD +-$Z1 +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-LE"c:\arquivos de programas\borland\delphi7\Projects\Bpl" +-LN"c:\arquivos de programas\borland\delphi7\Projects\Bpl" +-U"../" +-O"../" +-I"../" +-R"../" +-w-UNSAFE_TYPE +-w-UNSAFE_CODE +-w-UNSAFE_CAST diff --git a/components/trayicon/examples/wndtray.dof b/components/trayicon/examples/wndtray.dof new file mode 100644 index 0000000000..96873e7cba --- /dev/null +++ b/components/trayicon/examples/wndtray.dof @@ -0,0 +1,142 @@ +[FileVersion] +Version=7.0 +[Compiler] +A=8 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=0 +K=0 +L=1 +M=0 +N=1 +O=1 +P=1 +Q=0 +R=0 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=1 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +NamespacePrefix= +SymbolDeprecated=1 +SymbolLibrary=1 +SymbolPlatform=1 +UnitLibrary=1 +UnitPlatform=1 +UnitDeprecated=1 +HResultCompat=1 +HidingMember=1 +HiddenVirtual=1 +Garbage=1 +BoundsError=1 +ZeroNilCompat=1 +StringConstTruncated=1 +ForLoopVarVarPar=1 +TypedConstVarPar=1 +AsgToTypedConst=1 +CaseLabelRange=1 +ForVariable=1 +ConstructingAbstract=1 +ComparisonFalse=1 +ComparisonTrue=1 +ComparingSignedUnsigned=1 +CombiningSignedUnsigned=1 +UnsupportedConstruct=1 +FileOpen=1 +FileOpenUnitSrc=1 +BadGlobalSymbol=1 +DuplicateConstructorDestructor=1 +InvalidDirective=1 +PackageNoLink=1 +PackageThreadVar=1 +ImplicitImport=1 +HPPEMITIgnored=1 +NoRetVal=1 +UseBeforeDef=1 +ForLoopVarUndef=1 +UnitNameMismatch=1 +NoCFGFileFound=1 +MessageDirective=1 +ImplicitVariants=1 +UnicodeToLocale=1 +LocaleToUnicode=1 +ImagebaseMultiple=1 +SuspiciousTypecast=1 +PrivatePropAccessor=1 +UnsafeType=0 +UnsafeCode=0 +UnsafeCast=0 +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription= +[Directories] +OutputDir= +UnitOutputDir= +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath=../ +Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOfficeXP +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Language] +ActiveLang= +ProjectLang= +RootDir= +[Version Info] +IncludeVerInfo=0 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1046 +CodePage=1252 +[Version Info Keys] +CompanyName= +FileDescription= +FileVersion=1.0.0.0 +InternalName= +LegalCopyright= +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=1.0.0.0 +Comments= +[HistoryLists\hlUnitAliases] +Count=1 +Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[HistoryLists\hlSearchPath] +Count=1 +Item0=../ diff --git a/components/trayicon/examples/wndtray.dpr b/components/trayicon/examples/wndtray.dpr new file mode 100644 index 0000000000..94fbeceea9 --- /dev/null +++ b/components/trayicon/examples/wndtray.dpr @@ -0,0 +1,22 @@ +program wndtray; + +{$ifdef fpc} + {$mode objfpc}{$H+} +{$endif} + +uses +{$ifdef fpc} + Interfaces, +{$endif} + Forms, + frmtest in 'frmtest.pas', TrayIconLaz; + +{ add your units here } + +{$R magnifier.res} + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. diff --git a/components/trayicon/examples/wndtray.lpi b/components/trayicon/examples/wndtray.lpi new file mode 100644 index 0000000000..4696686515 --- /dev/null +++ b/components/trayicon/examples/wndtray.lpi @@ -0,0 +1,85 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/trayicon/trayicon.pas b/components/trayicon/trayicon.pas new file mode 100644 index 0000000000..c615a0fe23 --- /dev/null +++ b/components/trayicon/trayicon.pas @@ -0,0 +1,186 @@ +{ + ***************************************************************************** + * * + * 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. * + * * + ***************************************************************************** +} +unit TrayIcon; + +{$ifdef FPC} + {$mode delphi}{$H+} +{$endif} + +interface + +uses + Classes, SysUtils, WSTrayIcon, Menus, Graphics, Forms, Controls; + +type + { TCustomTrayIcon } + + TCustomTrayIcon = class(TComponent) + private + vPopUpMenu: TPopupMenu; + vIcon: TIcon; + vToolTip: string; + vVisible, vShowToolTip: Boolean; + vOnPaint, vOnClick, vOnDblClick: TNotifyEvent; + vOnMouseDown, vOnMouseUp: TMouseEvent; + vOnMouseMove: TMouseMoveEvent; + function GetCanvas: TCanvas; + procedure UpdateWS; + procedure SetVisible(Value: Boolean); + protected + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function Hide: Boolean; + function Show: Boolean; + property Canvas: TCanvas read GetCanvas; + property PopUpMenu: TPopupMenu read vPopUpMenu write vPopUpMenu; + property Icon: TIcon read vIcon write vIcon; + property ToolTip: string read vToolTip write vToolTip; + property ShowToolTip: Boolean read vShowToolTip write vShowToolTip; + property Visible: Boolean read vVisible write SetVisible; + property OnClick: TNotifyEvent read vOnClick write vOnClick; + property OnDblClick: TNotifyEvent read vOnDblClick write vOnDblClick; + property OnMouseDown: TMouseEvent read vOnMouseDown write vOnMouseDown; + property OnMouseUp: TMouseEvent read vOnMouseUp write vOnMouseUp; + property OnMouseMove: TMouseMoveEvent read vOnMouseMove write vOnMouseMove; + property OnPaint: TNotifyEvent read vOnPaint write vOnPaint; + end; + + { TTrayIcon } + + TTrayIcon = class(TCustomTrayIcon) + published + property PopUpMenu; + property Icon; + property ToolTip; + property ShowToolTip; + property Visible; + property OnClick; + property OnDblClick; + property OnMouseDown; + property OnMouseUp; + property OnMouseMove; + property OnPaint; + end; + +var + SystrayIcon: TCustomTrayIcon; + +procedure Register; + +implementation + +procedure Register; +begin + RegisterComponents('Misc',[TTrayIcon]); +end; + +{ TCustomTrayIcon } + +{******************************************************************* +* TCustomTrayIcon.Create () +* +* DESCRIPTION: Creates a object from the TAplicativo class +* +* PARAMETERS: AOwner - The owner of the component (this may be nil) +* +* RETURNS: A pointer to the newly created object +* +*******************************************************************} +constructor TCustomTrayIcon.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + + vIcon := TIcon.Create; +end; + +{******************************************************************* +* TCustomTrayIcon.Destroy () +* +* DESCRIPTION: Destroys a object derived from the TAplicativo class +* +* PARAMETERS: None +* +* RETURNS: Nothing +* +*******************************************************************} +destructor TCustomTrayIcon.Destroy; +begin + vIcon.Free; + + inherited Destroy; +end; + +{******************************************************************* +* TGlass.Hide () +* +* DESCRIPTION: Hides the Icon +* +* PARAMETERS: None +* +* RETURNS: Nothing +* +*******************************************************************} +function TCustomTrayIcon.Hide: Boolean; +begin + UpdateWS; + + Result := vwsTrayIcon.Hide; +end; + +function TCustomTrayIcon.Show: Boolean; +begin + UpdateWS; + + Result := vwsTrayIcon.Show; +end; + +procedure TCustomTrayIcon.SetVisible(Value: Boolean); +begin + vVisible := Value; + + if vVisible then Show + else Hide; +end; + +procedure TCustomTrayIcon.UpdateWS; +begin + vwsTrayIcon.Icon.Assign(vIcon); + vwsTrayIcon.PopUpMenu := vPopUpMenu; + vwsTrayIcon.ShowToolTip := vShowToolTip; + StrCopy(PChar(vwsTrayIcon.ToolTip), PChar(vToolTip)); + + // Update events + vwsTrayIcon.OnClick := vOnClick; + vwsTrayIcon.OnPaint := vOnPaint; + vwsTrayIcon.OnDblClick := vOnDblClick; + vwsTrayIcon.OnMouseDown := vOnMouseDown; + vwsTrayIcon.OnMouseUp := vOnMouseUp; + vwsTrayIcon.OnMouseMove := vOnMouseMove; +end; + +function TCustomTrayIcon.GetCanvas: TCanvas; +begin + Result := vwsTrayIcon.Canvas; +end; + +initialization + + SystrayIcon := TTrayIcon.Create(nil); + +finalization + + SystrayIcon.Free; + +end. + diff --git a/components/trayicon/trayiconlaz.lpk b/components/trayicon/trayiconlaz.lpk new file mode 100644 index 0000000000..27ea1b2ec8 --- /dev/null +++ b/components/trayicon/trayiconlaz.lpk @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/trayicon/trayiconlaz.pas b/components/trayicon/trayiconlaz.pas new file mode 100644 index 0000000000..5eb0f4c8b4 --- /dev/null +++ b/components/trayicon/trayiconlaz.pas @@ -0,0 +1,21 @@ +{ This file was automatically created by Lazarus. Do not edit! +This source is only used to compile and install the package. + } + +unit TrayIconLaz; + +interface + +uses + TrayIcon, WSTrayIcon, LazarusPackageIntf; + +implementation + +procedure Register; +begin + RegisterUnit('TrayIcon', @TrayIcon.Register); +end; + +initialization + RegisterPackage('TrayIconLaz', @Register); +end. diff --git a/components/trayicon/wsgtk2trayicon.pas b/components/trayicon/wsgtk2trayicon.pas new file mode 100644 index 0000000000..c165642a0a --- /dev/null +++ b/components/trayicon/wsgtk2trayicon.pas @@ -0,0 +1,38 @@ +{ + ***************************************************************************** + * * + * 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. * + * * + ***************************************************************************** +} +unit WSGtk2TrayIcon; + +{$ifdef FPC} + {$mode objfpc}{$H+} +{$endif} + +interface + +uses + Classes, SysUtils; + +type + + { TWidgetTrayIcon } + + TWidgetTrayIcon = class(TObject) + private + protected + public + published + end; + +implementation + +end. + diff --git a/components/trayicon/wsgtktrayicon.pas b/components/trayicon/wsgtktrayicon.pas new file mode 100644 index 0000000000..49dce527fc --- /dev/null +++ b/components/trayicon/wsgtktrayicon.pas @@ -0,0 +1,266 @@ +{ + ***************************************************************************** + * * + * 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. * + * * + ***************************************************************************** +} +unit WSGtkTrayIcon; + +{$ifdef FPC} + {$mode delphi}{$H+} +{$endif} + +interface + +uses + Graphics, Classes, LCLProc, ExtCtrls, SysUtils, StdCtrls, Forms, Controls, + Dialogs, Menus, x, xlib, xutil, gtk, gdk; + +type + + { TWidgetTrayIcon } + + TWidgetTrayIcon = class(TObject) + private + fDisplay: PDisplay; + fWindow: TWindow; + fScreen: PScreen; + fScreenID: longint; + fTrayParent: TWindow; + fOwner: TComponent; + GtkForm: TForm; + fEmbedded: Boolean; + fMsgCount: Integer; + procedure SetEmbedded; + 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); + procedure RemoveForm(id: Integer); + 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; + published + end; + +const + SYSTEM_TRAY_REQUEST_DOCK = 0; + SYSTEM_TRAY_BEGIN_MESSAGE = 1; + SYSTEM_TRAY_CANCEL_MESSAGE = 2; + +implementation + +// Temp ErrorHandler +function TempX11ErrorHandler(Display:PDisplay; ErrorEv:PXErrorEvent):longint;cdecl; +begin + DebugLn('Error: ' + IntToStr(ErrorEv^.error_code)); +end; + + +{ TWidgetTrayIcon } + +{******************************************************************* +* TWidgetTrayIcon.Create () +* +* DESCRIPTION: Creates a object from the TWidgetTrayIcon class +* +* 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; + buf: array [0..32] of char; + selection_atom : TAtom; +begin + old_error := XSetErrorHandler(@TempX11ErrorHandler); + Sleep(80); + xsync(fdisplay,true); + buf := PChar('_NET_SYSTEM_TRAY_S' + IntToStr(fScreenID)); + selection_atom := XInternAtom(fDisplay, buf, false); + XGrabServer(fDisplay); + fTrayParent := XGetSelectionOwner(fDisplay, selection_atom); + if fTrayParent <> None then + begin + XSelectInput(fDisplay, fTrayParent, StructureNotifyMask); + end; + XUngrabServer(fDisplay); + XFlush(fDisplay); + + if fTrayParent <> None then + Send_Message(fTrayParent, SYSTEM_TRAY_REQUEST_DOCK, fWindow, 0, 0); + + XSetErrorHandler(old_error); +end; + +function TWidgetTrayIcon.Send_Message(window: TWindow; msg: Integer;data1, data2,data3: Integer): boolean; +var + Ev: TXEvent; + fmt: Integer; +begin + 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; + +procedure TWidgetTrayIcon.CreateForm(id: Integer); +begin + GtkForm := TForm.Create(nil); + fEmbedded := False; + //fWindow := GDK_WINDOW_XWINDOW (Pointer(PGtkWidget(GtkForm.Handle)^.window)); + //SHowMessage(IntToStr(Integer(fWindow))); + //GtkForm.Parent := TWinConTrol(fOwner); + GtkForm.WindowState := wsMinimized; + GtkForm.BorderStyle := bsNone; //without this gnome will make a 1 pixel wide window! + //GtkForm.Canvas.AutoRedraw := True; //not working :( + + // needed because some things aparently don't get fully initialized until + // visible at least once! This is Gtk related NOT LCL related. + GtkForm.Visible :=True; + GtkForm.Width := 22; + GtkForm.Height := 22; + GtkForm.Visible := False; + + Application.ProcessMessages; + + fDisplay := GDK_WINDOW_XDISPLAY (Pointer(PGtkWidget(GtkForm.Handle)^.window)); + fWindow := GDK_WINDOW_XWINDOW (Pointer(PGtkWidget(GtkForm.Handle)^.window)); + fScreen := XDefaultScreenOfDisplay(fDisplay); // get the screen + fScreenID := XScreenNumberOfScreen(fScreen); // and it's number +end; + +procedure TWidgetTrayIcon.RemoveForm(id: Integer); +begin + GtkForm.Free; +end; + +function TWidgetTrayIcon.GetCanvas: TCanvas; +begin + Result := GtkForm.Canvas; +end; + +{******************************************************************* +* TWidgetTrayIcon.Hide () +* +* DESCRIPTION: Hides the main tray icon of the program +* +* PARAMETERS: None +* +* RETURNS: True if sucessfull, otherwise False +* +*******************************************************************} +function TWidgetTrayIcon.Hide: Boolean; +begin + RemoveForm(0); +end; + +{******************************************************************* +* TWidgetTrayIcon.Show () +* +* DESCRIPTION: Shows the main tray icon of the program +* +* PARAMETERS: None +* +* RETURNS: True if sucessfull, otherwise False +* +*******************************************************************} +function TWidgetTrayIcon.Show: Boolean; +begin + CreateForm(0); + + SetEmbedded; + + GTK_WIDGET_SET_FLAGS(PGtkWidget(GtkForm.Handle),GTK_VISIBLE); + GTK_WIDGET_SET_FLAGS(PGtkWidget(GtkForm.Handle),GTK_MAPPED); + + GtkForm.Width := 22; //needed for gnome + GtkForm.Height := 22; + SetMinSize(Icon.Width, Icon.Height); + + GtkForm.OnMouseDown := Self.OnMouseDown; + GtkForm.OnMouseMove := Self.OnMouseMove; + GtkForm.OnMouseUp := Self.OnMouseUp; + GtkForm.OnClick := Self.OnClick; + GtkForm.OnPaint := PaintForm; + GtkForm.PopupMenu := Self.PopUpMenu; + + fEmbedded := True; +end; + +procedure TWidgetTrayIcon.SetMinSize(AWidth, AHeight: Integer); +var + size_hints: TXSizeHints; +begin + size_hints.flags := PSize or PMinSize or PMaxSize; + size_hints.min_width := AWidth; + size_hints.max_width := 100; + size_hints.min_height := AHeight; + size_hints.max_height := 100; + XSetStandardProperties(fDisplay, fWindow, nil, nil, None, nil, 0, @size_hints); +end; + +procedure TWidgetTrayIcon.PaintForm(Sender: TObject); +begin + if ShowIcon then GtkForm.Canvas.Draw(0, 0, Icon); + + if Assigned(OnPaint) then OnPaint(Self); +end; + +end. + diff --git a/components/trayicon/wstrayicon.pas b/components/trayicon/wstrayicon.pas new file mode 100644 index 0000000000..0f052e402e --- /dev/null +++ b/components/trayicon/wstrayicon.pas @@ -0,0 +1,72 @@ +{ + ***************************************************************************** + * * + * 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. * + * * + ***************************************************************************** +} +unit WSTrayIcon; + +{$ifdef FPC} + {$mode objfpc}{$H+} +{$endif} + +interface + +{******************************************************************* +* Compatibility code for Delphi for Windows. +*******************************************************************} +{$ifndef FPC} + {$define Win32} +{$endif} + + +uses +{$ifdef LCLWin32} + wswin32trayicon, +{$endif} +{$ifdef LCLGtk} + wsgtktrayicon, +{$endif} +{$ifdef LCLGtk2} + wsgtk2trayicon, +{$endif} +{$ifdef LCLGnome} + wsgtktrayicon, +{$endif} + Classes, SysUtils; + +type + + { TWSTrayIcon } + + TWSTrayIcon = class(TWidgetTrayIcon) + private + protected + public + published + end; + +var + vwsTrayIcon: TWidgetTrayIcon; + vwsTrayIconCreated: Boolean; + +implementation + +initialization + + vwsTrayIconCreated := False; + vwsTrayIcon := TWidgetTrayIcon.Create; + vwsTrayIconCreated := True; + +finalization + + vwsTrayIcon.Free; + +end. + diff --git a/components/trayicon/wswin32trayicon.pas b/components/trayicon/wswin32trayicon.pas new file mode 100644 index 0000000000..5debacf1f5 --- /dev/null +++ b/components/trayicon/wswin32trayicon.pas @@ -0,0 +1,263 @@ +{ + ***************************************************************************** + * * + * 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. * + * * + ***************************************************************************** +} +unit WSWin32TrayIcon; + +{$ifdef FPC} + {$mode delphi}{$H+} +{$endif} + +interface + +uses + Graphics, Classes, SysUtils, Menus, Forms, Controls; + +type + + { TWidgetTrayIcon } + + TWidgetTrayIcon = class(TObject) + private + WindowHandle: Cardinal; + function GetCanvas: TCanvas; + protected + public + uID: Cardinal; + 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; + published + end; + +implementation + +uses WSTrayIcon, Windows, ShellAPI, Messages; + +const + szClassName = 'TTrayIconClass'; + szAppTitle = 'apptytle'; + +{******************************************************************* +* TrayWndProc () +* +* DESCRIPTION: Window procedure that processes messages for the +* systray icon +* +* PARAMETERS: Standard Mouse Messages have this parameters: +* +* fwKeys = wParam; // key flags +* xPos = LOWORD(lParam); // horizontal position of cursor +* yPos = HIWORD(lParam); // vertical position of cursor +* +* RETURNS: A pointer to the newly created object +* +*******************************************************************} +function TrayWndProc(Handle: HWND; iMsg: UINT; WParam_: WPARAM; LParam_:LPARAM):LRESULT; stdcall; +begin + {******************************************************************* + * The separate check on vwsTrayIconCreated is necessary because + * vwsTrayIcon.uID may not have being initialized yet + *******************************************************************} + if vwsTrayIconCreated then + if iMsg = WM_USER + vwsTrayIcon.uID then + begin + case LParam_ of + WM_RBUTTONUP: + 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_)); + end; + WM_RBUTTONDOWN: if Assigned(vwsTrayIcon.OnMouseDown) then vwsTrayIcon.OnMouseDown(Application, + mbRight, KeysToShiftState(WParam_), LOWORD(lParam_), HIWORD(lParam_)); + WM_RBUTTONDBLCLK: if Assigned(vwsTrayIcon.OnDblClick) then vwsTrayIcon.OnDblClick(Application); + + WM_MBUTTONDOWN: if Assigned(vwsTrayIcon.OnMouseDown) then vwsTrayIcon.OnMouseDown(Application, + mbMiddle, KeysToShiftState(WParam_), LOWORD(lParam_), HIWORD(lParam_)); + WM_MBUTTONUP: if Assigned(vwsTrayIcon.OnMouseUp) then vwsTrayIcon.OnMouseUp(Application, + mbMiddle, KeysToShiftState(WParam_), LOWORD(lParam_), HIWORD(lParam_)); + + WM_LBUTTONUP: + begin + if Assigned(vwsTrayIcon.OnMouseUp) then vwsTrayIcon.OnMouseUp(Application, + mbLeft, KeysToShiftState(WParam_), LOWORD(lParam_), HIWORD(lParam_)); + if Assigned(vwsTrayIcon.OnClick) then vwsTrayIcon.OnClick(Application); + end; + WM_LBUTTONDOWN: if Assigned(vwsTrayIcon.OnMouseDown) then vwsTrayIcon.OnMouseDown(Application, + mbLeft, KeysToShiftState(WParam_), LOWORD(lParam_), HIWORD(lParam_)); + WM_LBUTTONDBLCLK: if Assigned(vwsTrayIcon.OnDblClick) then vwsTrayIcon.OnDblClick(Application); + + WM_MOUSEMOVE: if Assigned(vwsTrayIcon.OnMouseMove) then + vwsTrayIcon.OnMouseMove(Application, KeysToShiftState(WParam_), LOWORD(lParam_), HIWORD(lParam_)); + end; + + Result := 1; + Exit; + end; + + Result := DefWindowProc(Handle, iMsg, WParam_, LParam_); +end; + +{ TWidgetTrayIcon } + +function TWidgetTrayIcon.GetCanvas: TCanvas; +begin + Result := Icon.Canvas; +end; + +{******************************************************************* +* TWidgetTrayIcon.Create () +* +* DESCRIPTION: Creates a object from the TWidgetTrayIcon class +* +* PARAMETERS: None +* +* RETURNS: A pointer to the newly created object +* +*******************************************************************} +constructor TWidgetTrayIcon.Create; +var + Window: TWndClassEx; +begin + inherited Create; + + Icon := TIcon.Create; + + uID := 3; + + ZeroMemory(@Window, SizeOf(TWndClassEx)); + Window.cbSize := SizeOf(TWndClassEx); + Window.style := CS_OWNDC; + Window.lpfnWndProc := @TrayWndProc; + Window.cbClsExtra := 0; + Window.cbWndExtra := 0; + Window.hInstance := hInstance; +// Window.hIcon := Icon.Picture.Icon.Handle; + Window.hCursor := LoadCursor(0, IDC_ARROW); + Window.hbrBackground := HBRUSH(GetStockObject(NULL_BRUSH)); + Window.lpszMenuName := nil; + Window.lpszClassName := szClassName; +// Window.hIconSm := hSmallIcon; + + Windows.RegisterClassEx(Window); + + WindowHandle := CreateWindowEx( + 0, //* Ensure that there will be no button in the bar */ + szClassName, //* Name of the registered class */ + szAppTitle, //* Title of the window */ + 0, //* Style of the window */ + 0, //* x-position (at beginning) */ + 0, //* y-position (at beginning) */ + CW_USEDEFAULT, //* window width */ + CW_USEDEFAULT, //* window height */ + 0, //* handle to parent or owner window */ + 0, //* handle to menu */ + hInstance, //* handle to application instance */ + nil); //* pointer to window-creation data */ +end; + +{******************************************************************* +* TWidgetTrayIcon.Destroy () +* +* DESCRIPTION: Destroys a object derived from the TWidgetTrayIcon class +* +* PARAMETERS: None +* +* RETURNS: Nothing +* +*******************************************************************} +destructor TWidgetTrayIcon.Destroy; +begin + // Destroys the helper Windows + Hide; + PostMessage(WindowHandle, WM_CLOSE, 0, 0); + PostMessage(WindowHandle, WM_DESTROY, 0, 0); + + Application.ProcessMessages; + + Icon.Free; + + inherited Destroy; +end; + +{******************************************************************* +* TWidgetTrayIcon.Hide () +* +* DESCRIPTION: Hides the main tray icon of the program +* +* PARAMETERS: None +* +* RETURNS: True if sucessfull, otherwise False +* +*******************************************************************} +function TWidgetTrayIcon.Hide: Boolean; +var + tnid: TNotifyIconData; +begin + // Fill TNotifyIconData + tnid.cbSize := SizeOf(TNotifyIconData); +{$IFNDEF FPC} + tnid.Wnd := WindowHandle; +{$ELSE} + tnid.hWnd := WindowHandle; +{$ENDIF} + tnid.uID := uID; + + // Remove the icon + Result := Shell_NotifyIconA(NIM_DELETE, @tnid); +end; + +{******************************************************************* +* TWidgetTrayIcon.Show () +* +* DESCRIPTION: Shows the main tray icon of the program +* +* PARAMETERS: None +* +* RETURNS: True if sucessfull, otherwise False +* +*******************************************************************} +function TWidgetTrayIcon.Show: Boolean; +var + tnid: TNotifyIconData; +begin + // Fill TNotifyIconData + FillChar(tnid, SizeOf(tnid), 0); + tnid.cbSize := SizeOf(TNotifyIconData); +{$IFNDEF FPC} + tnid.Wnd := WindowHandle; +{$ELSE} + tnid.hWnd := WindowHandle; +{$ENDIF} + tnid.uID := uID; + tnid.uFlags := NIF_MESSAGE or NIF_ICON; + if ShowToolTip then tnid.uFlags := tnid.uFlags or NIF_TIP; + tnid.uCallbackMessage := WM_USER + uID; + tnid.hIcon := Icon.Handle; + Move(ToolTip, tnid.szTip, SizeOf(tnid.szTip)); + + // Create Taskbar icon + Result := Shell_NotifyIconA(NIM_ADD, @tnid); +end; + +end. + diff --git a/packager/globallinks/trayiconlaz-0.lpl b/packager/globallinks/trayiconlaz-0.lpl new file mode 100644 index 0000000000..458459851b --- /dev/null +++ b/packager/globallinks/trayiconlaz-0.lpl @@ -0,0 +1 @@ +$(LazarusDir)/components/trayicon/trayiconlaz.lpk