From 7d0a2cfe64378a19a007c4ae94dae766592811b8 Mon Sep 17 00:00:00 2001 From: mattias Date: Tue, 17 Jan 2006 11:19:17 +0000 Subject: [PATCH] added trayicon package from Felipe Monteiro de Carvalho git-svn-id: trunk@8539 - --- .gitattributes | 22 ++ components/trayicon/examples/clean.bat | 9 + components/trayicon/examples/clean.sh | 2 + components/trayicon/examples/frmtest.dfm | 29 +++ components/trayicon/examples/frmtest.lfm | 34 +++ components/trayicon/examples/frmtest.lrs | 13 + components/trayicon/examples/frmtest.pas | 101 ++++++++ components/trayicon/examples/icon.ico | Bin 0 -> 478 bytes components/trayicon/examples/icon.xpm | 28 +++ components/trayicon/examples/magnifier.or | Bin 0 -> 30129 bytes components/trayicon/examples/magnifier.res | Bin 0 -> 29508 bytes components/trayicon/examples/wndtray.cfg | 42 ++++ components/trayicon/examples/wndtray.dof | 142 +++++++++++ components/trayicon/examples/wndtray.dpr | 22 ++ components/trayicon/examples/wndtray.lpi | 85 +++++++ components/trayicon/trayicon.pas | 186 ++++++++++++++ components/trayicon/trayiconlaz.lpk | 62 +++++ components/trayicon/trayiconlaz.pas | 21 ++ components/trayicon/wsgtk2trayicon.pas | 38 +++ components/trayicon/wsgtktrayicon.pas | 266 +++++++++++++++++++++ components/trayicon/wstrayicon.pas | 72 ++++++ components/trayicon/wswin32trayicon.pas | 263 ++++++++++++++++++++ packager/globallinks/trayiconlaz-0.lpl | 1 + 23 files changed, 1438 insertions(+) create mode 100644 components/trayicon/examples/clean.bat create mode 100755 components/trayicon/examples/clean.sh create mode 100644 components/trayicon/examples/frmtest.dfm create mode 100644 components/trayicon/examples/frmtest.lfm create mode 100644 components/trayicon/examples/frmtest.lrs create mode 100644 components/trayicon/examples/frmtest.pas create mode 100644 components/trayicon/examples/icon.ico create mode 100644 components/trayicon/examples/icon.xpm create mode 100644 components/trayicon/examples/magnifier.or create mode 100644 components/trayicon/examples/magnifier.res create mode 100644 components/trayicon/examples/wndtray.cfg create mode 100644 components/trayicon/examples/wndtray.dof create mode 100644 components/trayicon/examples/wndtray.dpr create mode 100644 components/trayicon/examples/wndtray.lpi create mode 100644 components/trayicon/trayicon.pas create mode 100644 components/trayicon/trayiconlaz.lpk create mode 100644 components/trayicon/trayiconlaz.pas create mode 100644 components/trayicon/wsgtk2trayicon.pas create mode 100644 components/trayicon/wsgtktrayicon.pas create mode 100644 components/trayicon/wstrayicon.pas create mode 100644 components/trayicon/wswin32trayicon.pas create mode 100644 packager/globallinks/trayiconlaz-0.lpl 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 0000000000000000000000000000000000000000..3fe34ad0842d726e411413d9aa48862e37c25efc GIT binary patch literal 478 zcmb_Y!3uyN6r0iq)Wv)6)FJ4X`e>W(bW-R3O8N9B J55JcG;{>6H7&ia_ literal 0 HcmV?d00001 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 0000000000000000000000000000000000000000..4b8d8b2c5715f1444eb5316003817c0a7850976e GIT binary patch literal 30129 zcmeI5O>9)x700h*Qb>zpDp4s_qiRwRp)GZ7FkdZFNiZa72_T>>Qd(-T`Dl%CY!jeD zWfrJH6;iXva*(>nrd1YMWJx6!S)?uflCtO`i!QS00;wz_kwsMZci#WKJT=kW7d8=9ov$Q9eOH+&!=M}>DcAQ+v{UKWp@|R% z(|J3`9}6pJ?>HO6Fz35;h8cU3_KNc%Y~%bjUVGEAjf{PlzS%whwQK$Q_5J<* z%=zS#Py9%ut$&XH?z`{i@SlGAY4BrkwU-y)E$;xFdu9LKyLa9Gxw*OH$B)BLm+Tk* z$jFHBmuUaJd-oJy?0@H-cZe_e#Mkkck$>TnKjLRu@(23~0r~0nU%!5Re0<#VbBXo~ zABuALqobpx_P3iwj!z1SAMBr;oZP>E|E5iwmY)9~ee{u2q$Paw=1mVV_)AoQzmBgZ z@WvZ&c!*0=v@MF5j0*~JOc5cjpr|bsqKFVXeoWEYwQEZ$YF$O_LR>{z1=U$36|E?e zir58ZkqUK16k-*{wpUs%Ap|=2AZR5D+?cCT@rYCydLjgxD8Lehh$xUqsDLHPQIe|p z#|<|<6g*ae3ptilPEo;f6Hyi6E~*o_Y>*3LNoxTw2m~rbl!}rvO70W^;}HjsU0{Ni zgIJ1H5N>frX>wnrsPve_kG=4ss)w>-L0uwgr3GII3W_ACD@p~vd*O9eju3Itg(4O> z?jY!LL8(g-KX$=YD5KmF`GOYQAucGA;1>;!E~WT66`oOYL|X6#K@rhMaH>?A;TKhS z0Yr;x2#R7|(wI9|;Oi0;NxTNKz@bZ8P{boiisGYdc_@C)5mj;)Ac7*-g}PE{1;5l0 zf&ybmtVb&Q|0U*v$V z4Jc)6iTKXE6jk8!@L)~{|6&zhM`HWQANc7EKL)1_GYA!Gx$txRtM;j^>#+g<%V@vw zRmyYt9poph=IqCE1pGJOe3Qk?15X=;4)_;%tU|~#Uidsp!G|Aq25rR`-?2PaK^J6+ zo~9~3Yzx}uU*I_v80-&D+9DtOeLIK&)&F=BFoE>rSX2R~3s*%x$&+twWYHqa-R#oLWPTAJBPHSigWYCFj=_cO z_@YahSp;VUkXV?B04Na^GCM|&@tMgjrQi&@%cTwBc%6wGT;di5w;6bhpM%OuW64=s zgkOQIOUd)$Hjg21=#dnU=u%wmQ33u#!I?nq@@;+GVBAF-r3HTgZv|O%v;iv~U6*SC zzjauj339x%S36dx9gfd`)EZrUpYZ9p>ZOea#jaGi)PXS+%2H9ui;qle9iRFbOIF{? z&zi}#R`9)0dab0Sx=_BG2^H|6_^P~Kd?aMRLii#C ze2}#q-14FdC!tv*e$qR>gHs&X8IysfDw<)&XOH#0wP@~>cAuForJ=KWW9wiOr=q}P}Hs#vPz-{ zCyzH5J&IT}=v7TuWzie67DJH1m!DlJT5t_TTK|xSmR9IuZI=oK3sG5-Zv4U{X@N9V z8A4y}i0`~}4ci(dBJHjVEn>_I84;;a!4n9flt{dt4BNp=Jc`gFU*w2XkkS=i2sZnI zbkW(rIc1J3LW@Yl5x8;)NB8VCpBYIPf5&;nfq#l6r&S9Q4<>uSK_RaXH~9t&7v0g|z$i=qfpJ(5#F6qK|C zf?O)PP)eExn<-Mz6$>RTDp=hV5NcFupqpuFrosaOOSnKKQ7%zB+H#>;&^?{vKof-y zTxh1k(>11uM5f(&_;?Ykko}Y+tpX2my9>FL9JhZN z@r(9*IaMKopJhx@=Z6$^dnB z&VH}aW1z=CkAWToZ85-hmigT~b`>16yJxwOKkN4Mab{PA-9T4`4NX^tJxy1IH=kV< zHm{#)VSn6J;Vnv6gFS3WfOqx748Zvgv8%$D^<5SHmp|P*cKgE;YF}5S zs~=_n&YQHZ3SYc-RVW3yuS%D9q^sbnV_j9zRq#*2eyQjkdkpj#=rPb^;Qx(*ZoN;) zJr~&n`F9a)8QG8OzdvJ#%_hDx(qk3Njvs^5UUqz3j#Vr>ehl8Tzcj&OihBI#D2mDH zc$j3G=H-9 z3A?$gFZpGL5bFGHL%Gzs$d!6sCyq43ojZ3p+XeQ%$@UjRl3rpE|6f4sEm3a7QV*+s z1FFl7uxfsKLBYVs^??WB{({Wc2c`#NsSniWA7pa>{($wbxeO%z?DB&LkH+-{17)9k zKX3Nk7>N4U>QJ!2$IAJ7n2-3o_Ax&WvM_y~%iWe(+no?rqS1arB>riYC7A$T-yJaj z1$L|}Yg?Y%Z->-)WqE#wcDd98sm-gd6GxgI<@qXLkb3=rg>QbNgn7%)7-(a{qap=LS4A(|uv886OdK=8z-0Z&3PCbadz7Ycd7UTxq z`AhTsvp;;hk?(VvIr5Sr{;Bjf07HR z&GawoV^b!~NCF)7v3WsoJ>SpsS?Fh29iA7It96I9Yp)LBn%E9TqDs6R#=;q{oeQVK6^>K%YT<=2$@naPgUO%Ol>G_DELS&h=eaN* z=0K?>_te5P=gZ8Pbwv95#m?$@L%8-bv5oCymWvYdYsd zV+*50$@otjBm8!f{Zdj0V~wq}HUDIStvRO}+nFKEaWIFNBfS%;Hk(%ur|E6us`VE8 zau%!4;q_VkY39v)?#&;S@2M!`2H#$z<}@Fr1s5r!@$N>P_9+oVG69+LE@WZ;hm_S8we|TJ$Mm(_oH4G{!t>0SAsZ$*n%r!>gnh3iePeV_f?#tDb0gO- za6Yq0n~+XMNMBE|e$jZ5F+=$QcvmXogHD=Chd*%zK~ z9AW+#GtJgGYGrGx2EJw86mzej^&;m<&bIP4aJK07h3&VFfM`6{a$eT(ZURk~3$|X3 zS6i)ix5eQ!y^A2uB^>IohgE-!`Ll^WHn{QO5R?p%x93K7KE*R$Ie)Me=KG zePPWS_3U@pw4LwcYCNZ(-%qoOaEz*Vg5zE?;s|+kFdU%&632bCP5!XrKmRoy{Rz_J ze*Ru^HK20^R~O6olS*#UpGl*!kMkrRSf-waoe(x8bB3r(LsSMkpG@k|E8!XNY<-+h z7`6S>i|4!*w=zRlnHgm+cwbKuUv*=)l4Ov04um`Niu#dR^YgCB>>uq|>^WZD7F z7D?D)R|c36F=vm+6;G zvG!qyuP~vH*XPoSR*7OUk4&E7W%II)VY7M9GRNK%J#5~l6fgUT!|)FA$|TdfodMIE z&AXmWNYB~4=S$`d*^Q}W^A6CD@!qDh@zrdW)lkVRoXn3*??1J9NUtu;`ywNmuXfSq zo$*=HW!+e(^=oW)U+4SI^{zVqs^~~$+ S`s0gm`#n3d>nn5DVd{UXG-1gA literal 0 HcmV?d00001 diff --git a/components/trayicon/examples/magnifier.res b/components/trayicon/examples/magnifier.res new file mode 100644 index 0000000000000000000000000000000000000000..7e9cbe18345aac63c93df189d60d37e819150226 GIT binary patch literal 29508 zcmeI5O>A7%700i!QPL`^vq+^@Vll0vG_BG!fC*4VY9Z#U4FnM@3!0V&@J^S(SYo{56` zjy><)ci(;gbI$*qd+vRn2to*^5x5Ob909d9ooHn_vGXxW4`?IOFPmS=-2Sy zdFP!B{yq2H1HK1Wd$jmw`4HedEBmiszi#%gtgM_kaRPqEWWVrdW@d!HMf-2uxS{xB z|J!fBO?<&8zJ@C>ltGC?dp$?ypOIu>xPW zph#jhkO>Z5(t;wEBq{Po)3Pak#t~I=CLn?$(}lW1=?A~i5rP6^h}R{JcH~z7_%;%{ z@B%@F#4D0Ij_S0h25ppS5v-1A9~5@b@xAX6@1@s+A>ShgRgEql(b0mail+?*lax9@ z%^4KgU`+*lqJqTm_>_X7@iQufpIO(yr>2d>e(~e+wWtk^pRr%$fUgZIWo?W2#=I0& z;Ip_eW{6*}!s?8-pZtNJ;qW~;ZJ0r*V57p%@UPmavae+Y{zquP@Kx$F_(S9;tY+-T zas>Q0-+YtF%Yvwl#1Q-o+^Z0>j2AvjE%@-m&S9YV;yadm6< zfx))0(iZvHZ`(x-sQzW8U;ydIF|Ptl6Yh$9k|%>Nkm_Sz1%Qa~)%N)C<1McSFZ2R5 z!J>i&mk7zD;=|_9@cRMJr~t~q4PP5JC8x(nQ9mlQ$0mFjY53A2`?VER@|f}cfD0MJ z4BX?>Mr6E#n<2k&^Y1%ZjIfGlu@D>qddoBT-gw$n2_~8e>n4+k*$0PM0y36ozySnb z%zJVemI3DyK*JQQkTF}xqD7XQ*@c%%pcA!}$! z@;$oct34{f-xQny)Gpih`v(0c(kLzX19(5k8lw$Z{%E>P3;6xR+DMT7&R=b>PCFbM zf2TEi-y_~<%M`+GdXKn0R9NYwK`|^8ZVh1!g|tvq68({3{o_+Vy>#ne@mV9e*AKoG zQmdtuTocNBnNT4&#aCsv;w&hY)>KnBimH`XUtKHkvCs@F1XPhPEU?yDhHrLyBlCb% zGb_$2saEvVD8v^g$If!nUB2abA*NMVt4pd>d3>Xhh71<0xor4mu)smK>SvWIk8dOx zxbT5BffECV2k-@MuvQ*3_})mNsmGAjFnk`TFjX8qeg?$j=k@BrYH-~(6_yF6$Y6bg z@tXKLR;#E6_aRUe7>_PfQ4Q|xSG+jlg)w9J5duEQnhs`pUWJiR z*6=$4!#8k>13PCjuuw%ArtjxjRLBMJvCzON6ci%x8J}0-LCV@Zg~$c*558ytoXRQi z%-c{ITE1U94Z|n67!T*rg5}hF@cp|I#^gaNdYH>n0Y4&N_!yrDm!b-^{4I|UKOzU? zVTP5z7OjV{M+Ah;YX7fd@>V!eP0i;UPT$tW&MV){3kz!5BY2$ zx6XedKACU$Beb95Ap1SOCudOpd*36jv*O&D?-6{%n|}qM6WOt2M_K6m?rDjhThXNrza6!u*ClyQsvy#Zq9Ht@9!e-&NcU>v3t4HDE))%_g{+fkVP*L<(Ne{n zLa%DRDvw^=`V2uAzW8iP(SmCzQhk6lwDdz4bH7k1Xo$*=bmJEuNeiT@3K9BhM{H-F zX~eBV5@|PGXc1#p=!iRWnDQX{c;>W&9n0#Jk&`65T8f|RcCLa^O0V0+H?%`9U~ z5n4nVj=+_9QK3S+*|KB1-A-Qu$8Ukr0%x{d;tO1vio$T0!Djj?j|hq~D!dnDRAC@8 zP>d<-!56eZ7eO&Ev?!}?=VM(4Rn~7RAj)C^OH4pAws2CEL6!AqR1gIvErB4H@-7sT zrp^i#77HaUDwy3A5NcFmpv$zBsjxu65-w0lluMM3fm|pHx22O0G*KABg)$X|6p={P zGrE7G2()rliKMwumZ)X0zCRxeO=@lMdaXH;0xP!=)QG!e+6ii%W-Y@J?3 z2H$7taQGgaHu!{qxooq5qN-(dIDEYDDr7(9NVC8~Jm^F&B**L@A%5O|E2k<%@H4^` zHGW7@!>7;H);lI z25JUs1_ok)?JncTcN{A?W{=NuA%E5F=g*;I6?O|_6*fF$74|%16<$uqDr|1Q(!&0E ztimhIScSKMu?idYvC2S;#Snvg-y=TU%6kMnKsC`MVeES)Ca?ZzOqI*j>OrkFeEnI2 zX~oPHJ|zzP{8}@R3d67MFXYYmsrj$wr_P^he(Lio&`)B7Ir(N^9g^57%v8S5WI03YigLjdPH%CQRn7+|cTe_1rXm!6_Je=-z#a_aoakW=SRAtAoA&L7W4VcSzw*PjeUo}9Y=WXRE_r)bms z`S)Gj|9`|J|NX%Up5;Bl{Rf-6|Nn@e(mxTV;_cAnnPO>jlRM3(P8?~5_4Rem@dkV2 zv^~bqbd?N7Z@k)~ta)jM?SBTVN9 z^=l^6>AHLS)~!3^{)U0F&%AF(`_`u2^=nNi*x+MZyBXS!zt_G9!3}S7d)%^NT)Vv< z!ZtKcqEiVu0_EUMtb_S4u)VHsdoP+Af%I(0d7uQ(&Vx8D;+XC{Sf^bq%|Pn&Y3jt0 z=1}usJ1|JIc`Jsuy?uI#nbh2Nb9&pWQOMeuhRvJP(=j`XuA_%bH>Yn#7@kfJ-`d{A zjlEvtRE(eI0L;g+-RFAiNetmvwVrrZ)hHP6rmip|C4jre<_*F1>~)sU z+;tag$n%DBwbq&Y@iQb`>0@2otiJ10suk__6il2?&%0$cUH>IK9ZrXZa4}sy(%KV_ zg_px(Sf$E59ZrU`+&dS}gi9P3xN3wa!aV&K_}QO+;@|v^B#aB(-NTdT!l|$VN+Uhf z2uqw_WyCzsM0vh-FwCUZFIo?WgQ<0*b#J&YJe1nMr2Q~gQGV6BFFep0^Fr%>dJm-j zU$=411q8UD$$T@QA`vyaZX@Dedu z!PZ5h6lMPEy>K4oJgxn3sH=sm_jOu}SMTq%mafipTEDycP-->9GEW`s^!~B+L|6uY z2_B**#d!{0ix$&YGGk71rx6}y#4_1%nq!nJt*5Z>m2@2$J)98Yn25QTdyAaU_GlB* ziw^1g3G4T*C+UkQKL_s;XJIdf-*O$%ULvcP`HA_xf<1A}Z|J*_o;n=n!gFNq55prI z=Qy7ZLcZLZW$XeTpHKeAnXs6=h^R5YmEE&pHdz|y%F&Kjac*4d;6yVg!lSKYj6cc9 zXseG}(VS|4AG2;!j?tY64_-Y6V&t)r@v?z;r_mI1AgXKeQeRF=iJ*Yb5mO z|3${dyx5$DSD35&!~NuKlqaz8FwZXFZLA}4*3Q!R7#SL)5yE%*H2AdJ-{5naR_~f0 zS-UGV8ap{pg}6hQ;2lF(ao-hpTf6u)_y|L_%J0A8GZQ@+li>!{{7`ykCte;4FK~Q} zygEiU9u3cM{S?Q?Y3Jp}WUNM;KlS&i|NJ-Vo=jHWZRekKAgAyM7kcDpX_bkYx7^8u z$2rf#UYsRoh)f83(wGC(!~;~Ncz!X}z~{qvz>9P9e2Q+IJ&}!A1y_jmkHe4nIiF&# z)!`ht%f#zKiuiJhQq-~B$%+N;E8`vtI}AH!%>r5e4Ck0dQ5L~h_IoVWjPPxq>-sRu zm=J%Q>$SFo#CC6ABm9+YjO)e2tYHo6QzNZ@2bdF$@FYmFwwELfMq zK3a!~QS6KJ{b=|e^(j`2$o_nqHC-O#dM#V#7=JQVh8WLfYNzsk7#^Ps-^9OSVP$&%xV fpRP9>vnYh!%)h`25}90pzqkhYoc!9<-=_WtT^L(n literal 0 HcmV?d00001 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