mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2026-02-24 18:58:25 +01:00
Removed the old TrayIcon component.
git-svn-id: trunk@12150 -
This commit is contained in:
sekelsenmat
parent
8733c0037d
commit
de6c24679b
22
.gitattributes
vendored
22
.gitattributes
vendored
@ -933,28 +933,6 @@ components/tdbf/languages/registerdbf.ru.po svneol=native#text/plain
|
||||
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/createbundle.sh -text
|
||||
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/magnifier.res -text
|
||||
components/trayicon/examples/wndtray.dpr svneol=native#text/plain
|
||||
components/trayicon/examples/wndtray.lpi svneol=native#text/plain
|
||||
components/trayicon/trayicon.lrs 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/ttrayicon.xpm 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/wsqttrayicon.pas svneol=native#text/plain
|
||||
components/trayicon/wstrayicon.pas svneol=native#text/plain
|
||||
components/trayicon/wswin32trayicon.pas svneol=native#text/plain
|
||||
components/trayicon/wsx11trayicon.pas svneol=native#text/plain
|
||||
components/turbopower_ipro/Makefile svneol=native#text/plain
|
||||
components/turbopower_ipro/Makefile.fpc svneol=native#text/plain
|
||||
components/turbopower_ipro/ipanim.pas svneol=native#text/pascal
|
||||
|
||||
4
.gitignore
vendored
4
.gitignore
vendored
@ -164,10 +164,6 @@ components/tdbf/*.bak
|
||||
components/tdbf/languages/*.bak
|
||||
components/tdbf/languages/units
|
||||
components/tdbf/units
|
||||
components/trayicon/*.bak
|
||||
components/trayicon/examples/*.bak
|
||||
components/trayicon/examples/units
|
||||
components/trayicon/units
|
||||
components/turbopower_ipro/*.bak
|
||||
components/turbopower_ipro/languages/*.bak
|
||||
components/turbopower_ipro/languages/units
|
||||
|
||||
@ -1,7 +0,0 @@
|
||||
del *.o
|
||||
del *.dcu
|
||||
del *.bak
|
||||
del *.~pas
|
||||
del *.~dpr
|
||||
del *.dof
|
||||
del *.ppu
|
||||
@ -1,54 +0,0 @@
|
||||
#!/bin/sh
|
||||
# Force Bourne shell in case tcsh is default.
|
||||
#
|
||||
|
||||
appname=Wndtray
|
||||
appfolder=$appname.app
|
||||
macosfolder=$appfolder/Contents/MacOS
|
||||
plistfile=$appfolder/Contents/Info.plist
|
||||
appfile=wndtray
|
||||
#
|
||||
if ! [ -e $appfile ]
|
||||
then
|
||||
echo "$appfile does not exist"
|
||||
elif [ -e $appfolder ]
|
||||
then
|
||||
echo "$appfolder already exists"
|
||||
else
|
||||
echo "Creating $appfolder..."
|
||||
mkdir $appfolder
|
||||
mkdir $appfolder/Contents
|
||||
mkdir $appfolder/Contents/MacOS
|
||||
mkdir $appfolder/Contents/Resources
|
||||
#
|
||||
# Instead of copying executable into .app folder after each compile,
|
||||
# simply create a symbolic link to executable.
|
||||
ln -s ../../../$appname $macosfolder/$appname
|
||||
# Copy the resource files to the correct place
|
||||
cp icon.ico $appfolder/Contents/Resources
|
||||
#
|
||||
# Create PkgInfo file.
|
||||
echo "APPL????" >$appfolder/Contents/PkgInfo
|
||||
#
|
||||
# Create information property list file (Info.plist).
|
||||
echo '<?xml version="1.0" encoding="UTF-8"?>' >$plistfile
|
||||
echo '<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">' >>$plistfile
|
||||
echo '<plist version="1.0">' >>$plistfile
|
||||
echo '<dict>' >>$plistfile
|
||||
echo ' <key>CFBundleDevelopmentRegion</key>' >>$plistfile
|
||||
echo ' <string>English</string>' >>$plistfile
|
||||
echo ' <key>CFBundleExecutable</key>' >>$plistfile
|
||||
echo ' <string>'$appname'</string>' >>$plistfile
|
||||
echo ' <key>CFBundleInfoDictionaryVersion</key>' >>$plistfile
|
||||
echo ' <string>6.0</string>' >>$plistfile
|
||||
echo ' <key>CFBundlePackageType</key>' >>$plistfile
|
||||
echo ' <string>APPL</string>' >>$plistfile
|
||||
echo ' <key>CFBundleSignature</key>' >>$plistfile
|
||||
echo ' <string>????</string>' >>$plistfile
|
||||
echo ' <key>CFBundleVersion</key>' >>$plistfile
|
||||
echo ' <string>1.0</string>' >>$plistfile
|
||||
echo ' <key>CSResourcesFileMapped</key>' >>$plistfile
|
||||
echo ' <true/>' >>$plistfile
|
||||
echo '</dict>' >>$plistfile
|
||||
echo '</plist>' >>$plistfile
|
||||
fi
|
||||
@ -1,29 +0,0 @@
|
||||
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
|
||||
@ -1,56 +0,0 @@
|
||||
object Form1: TForm1
|
||||
Left = 290
|
||||
Height = 300
|
||||
Top = 175
|
||||
Width = 400
|
||||
HorzScrollBar.Page = 399
|
||||
VertScrollBar.Page = 299
|
||||
ActiveControl = Button1
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 300
|
||||
ClientWidth = 400
|
||||
OnCreate = FormCreate
|
||||
object Button1: TButton
|
||||
Left = 56
|
||||
Height = 33
|
||||
Top = 56
|
||||
Width = 94
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Show'
|
||||
OnClick = Button1Click
|
||||
TabOrder = 0
|
||||
end
|
||||
object Button2: TButton
|
||||
Left = 56
|
||||
Height = 33
|
||||
Top = 112
|
||||
Width = 94
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Hide'
|
||||
OnClick = Button2Click
|
||||
TabOrder = 1
|
||||
end
|
||||
object Button3: TButton
|
||||
Left = 224
|
||||
Height = 33
|
||||
Top = 56
|
||||
Width = 94
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Paint Test'
|
||||
OnClick = Button3Click
|
||||
TabOrder = 2
|
||||
end
|
||||
object PopupMenu: TPopupMenu
|
||||
left = 180
|
||||
top = 260
|
||||
object MenuItem1: TMenuItem
|
||||
Caption = 'New Item1'
|
||||
end
|
||||
object MenuItem3: TMenuItem
|
||||
Caption = 'New Item3'
|
||||
end
|
||||
object MenuItem2: TMenuItem
|
||||
Caption = 'New Item2'
|
||||
end
|
||||
end
|
||||
end
|
||||
@ -1,17 +0,0 @@
|
||||
LazarusResources.Add('TForm1','FORMDATA',[
|
||||
'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'"'#1#6'Height'#3','#1#3'Top'#3#175#0#5'Wi'
|
||||
+'dth'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'#3'+'#1#13
|
||||
+'ActiveControl'#7#7'Button1'#7'Caption'#6#5'Form1'#12'ClientHeight'#3','#1#11
|
||||
+'ClientWidth'#3#144#1#8'OnCreate'#7#10'FormCreate'#0#7'TButton'#7'Button1'#4
|
||||
+'Left'#2'8'#6'Height'#2'!'#3'Top'#2'8'#5'Width'#2'^'#25'BorderSpacing.InnerB'
|
||||
+'order'#2#4#7'Caption'#6#4'Show'#7'OnClick'#7#12'Button1Click'#8'TabOrder'#2
|
||||
+#0#0#0#7'TButton'#7'Button2'#4'Left'#2'8'#6'Height'#2'!'#3'Top'#2'p'#5'Width'
|
||||
+#2'^'#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#4'Hide'#7'OnClick'#7#12
|
||||
+'Button2Click'#8'TabOrder'#2#1#0#0#7'TButton'#7'Button3'#4'Left'#3#224#0#6'H'
|
||||
+'eight'#2'!'#3'Top'#2'8'#5'Width'#2'^'#25'BorderSpacing.InnerBorder'#2#4#7'C'
|
||||
+'aption'#6#10'Paint Test'#7'OnClick'#7#12'Button3Click'#8'TabOrder'#2#2#0#0
|
||||
+#10'TPopupMenu'#9'PopupMenu'#4'left'#3#180#0#3'top'#3#4#1#0#9'TMenuItem'#9'M'
|
||||
+'enuItem1'#7'Caption'#6#9'New Item1'#0#0#9'TMenuItem'#9'MenuItem3'#7'Caption'
|
||||
+#6#9'New Item3'#0#0#9'TMenuItem'#9'MenuItem2'#7'Caption'#6#9'New Item2'#0#0#0
|
||||
+#0
|
||||
]);
|
||||
@ -1,168 +0,0 @@
|
||||
{
|
||||
frmtest.dpr
|
||||
|
||||
*****************************************************************************
|
||||
* *
|
||||
* This demonstration program is public domain, which means no copyright, *
|
||||
* 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 *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
||||
* *
|
||||
*****************************************************************************
|
||||
|
||||
Author: Felipe Monteiro de Carvalho
|
||||
}
|
||||
unit frmtest;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode delphi}{$H+}
|
||||
{$endif}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
{$ifdef fpc}
|
||||
LResources,
|
||||
{$endif}
|
||||
Forms, Controls, Graphics, Dialogs, Buttons, StdCtrls, Menus, TrayIcon;
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
Button1: TButton;
|
||||
Button2: TButton;
|
||||
Button3: TButton;
|
||||
MenuItem1: TMenuItem;
|
||||
MenuItem2: TMenuItem;
|
||||
MenuItem3: TMenuItem;
|
||||
PopupMenu: TPopupMenu;
|
||||
procedure Button1Click(Sender: TObject);
|
||||
procedure Button2Click(Sender: TObject);
|
||||
procedure Button3Click(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 fpc}
|
||||
{$R frmtest.dfm}
|
||||
{$endif}
|
||||
|
||||
implementation
|
||||
|
||||
{$ifdef Windows}
|
||||
uses Windows;
|
||||
{$endif}
|
||||
{$IFDEF Darwin}
|
||||
uses FPCMacOSAll;
|
||||
{$ENDIF}
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.Button1Click(Sender: TObject);
|
||||
begin
|
||||
SystrayIcon.Show;
|
||||
end;
|
||||
|
||||
procedure TForm1.Button2Click(Sender: TObject);
|
||||
begin
|
||||
SystrayIcon.Hide;
|
||||
end;
|
||||
|
||||
procedure TForm1.Button3Click(Sender: TObject);
|
||||
var
|
||||
MyImage, SecondImage: TIcon;
|
||||
begin
|
||||
MyImage := TIcon.Create;
|
||||
SecondImage := TIcon.Create;
|
||||
|
||||
MyImage.LoadFromFile('icon.ico');
|
||||
SecondImage.Height := 22;
|
||||
SecondImage.Width := 22;
|
||||
SecondImage.Canvas.Draw(0, 0, MyImage);
|
||||
Canvas.Draw(0, 0, SecondImage);
|
||||
|
||||
SecondImage.Free;
|
||||
MyImage.Free;
|
||||
end;
|
||||
|
||||
procedure TForm1.FormCreate(Sender: TObject);
|
||||
const
|
||||
IDI_ICON1 = 101;
|
||||
IDI_ICON2 = 115;
|
||||
BundleResourceFolder = '/Contents/Resources/';
|
||||
var
|
||||
{$IFDEF Darwin}
|
||||
pathRef: CFURLRef;
|
||||
pathCFStr: CFStringRef;
|
||||
pathStr: shortstring;
|
||||
{$ENDIF}
|
||||
pathMedia: string;
|
||||
begin
|
||||
pathMedia := '';
|
||||
|
||||
// Under Mac OS X we need to get the location of the bundle
|
||||
{$IFDEF Darwin}
|
||||
pathRef := CFBundleCopyBundleURL(CFBundleGetMainBundle());
|
||||
pathCFStr := CFURLCopyFileSystemPath(pathRef, kCFURLPOSIXPathStyle);
|
||||
CFStringGetPascalString(pathCFStr, @pathStr, 255, CFStringGetSystemEncoding());
|
||||
CFRelease(pathRef);
|
||||
CFRelease(pathCFStr);
|
||||
|
||||
pathMedia := pathStr + BundleResourceFolder;
|
||||
{$ENDIF}
|
||||
|
||||
{$ifdef Windows}
|
||||
SystrayIcon.Icon.Handle := LoadIcon(hInstance, MAKEINTRESOURCE(IDI_ICON1));
|
||||
|
||||
// Loading from a file should also work
|
||||
// SystrayIcon.Icon.LoadFromFile('icon.ico');
|
||||
{$else}
|
||||
SystrayIcon.Icon.LoadFromFile(pathMedia + 'icon.ico');
|
||||
{$endif}
|
||||
|
||||
SystrayIcon.ShowHint := True;
|
||||
SystrayIcon.Hint := 'my tool tip';
|
||||
|
||||
SystrayIcon.OnClick := HandleClick;
|
||||
|
||||
// SystrayIcon.OnPaint := DoPaint;
|
||||
|
||||
SystrayIcon.PopUpMenu := PopupMenu;
|
||||
end;
|
||||
|
||||
procedure TForm1.HandleClick(Sender: TObject);
|
||||
begin
|
||||
Application.MessageBox('Text', 'Caption', 0);
|
||||
end;
|
||||
|
||||
procedure TForm1.DoPaint(Sender: TObject);
|
||||
var
|
||||
MyImage: TIcon;
|
||||
begin
|
||||
MyImage := TIcon.Create;
|
||||
MyImage.LoadFromFile('icon.ico');
|
||||
SystrayIcon.Canvas.Draw(0, 0, MyImage);
|
||||
MyImage.Free;
|
||||
WriteLn('Paint');
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$ifdef fpc}
|
||||
{$I frmtest.lrs}
|
||||
{$endif}
|
||||
|
||||
end.
|
||||
|
||||
Binary file not shown.
|
Before Width: | Height: | Size: 478 B |
Binary file not shown.
@ -1,41 +0,0 @@
|
||||
{
|
||||
wndtray.dpr
|
||||
|
||||
*****************************************************************************
|
||||
* *
|
||||
* This demonstration program is public domain, witch means no copyright, *
|
||||
* 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 *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
||||
* *
|
||||
*****************************************************************************
|
||||
|
||||
Author: Felipe Monteiro de Carvalho
|
||||
}
|
||||
program wndtray;
|
||||
|
||||
{$ifdef fpc}
|
||||
{$mode objfpc}{$H+}
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
{$ifdef fpc}
|
||||
Interfaces,
|
||||
{$endif}
|
||||
Forms,
|
||||
frmtest in 'frmtest.pas';
|
||||
|
||||
{ add your units here }
|
||||
|
||||
{$ifdef Windows}
|
||||
{$R magnifier.res}
|
||||
{$endif}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
@ -1,71 +0,0 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<PathDelim Value="/"/>
|
||||
<Version Value="5"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<SaveClosedFiles Value="False"/>
|
||||
<SaveOnlyProjectUnits Value="True"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<IconPath Value="./"/>
|
||||
<TargetFileExt Value=""/>
|
||||
</General>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="3">
|
||||
<Unit0>
|
||||
<Filename Value="wndtray.dpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="wndtray"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="frmtest.pas"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ResourceFilename Value="frmtest.lrs"/>
|
||||
<UnitName Value="frmtest"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="wscommontrayicon.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="wscommontrayicon"/>
|
||||
</Unit2>
|
||||
</Units>
|
||||
</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>
|
||||
<Linking>
|
||||
<Options>
|
||||
<LinkerOptions Value="-framework Qt4Intf -framework carbon -lobjc"/>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</CONFIG>
|
||||
@ -1,14 +0,0 @@
|
||||
LazarusResources.Add('ttrayicon','XPM',[
|
||||
'/* XPM */'#10'static char *trayicon[]={'#10'"23 23 5 1",'#10'". c None",'#10
|
||||
+'"c c #000000",'#10'"a c #808080",'#10'"b c #ffff00",'#10'"# c #ffffff",'#10
|
||||
+'".......................",'#10'".......................",'#10'"............'
|
||||
+'...........",'#10'".......................",'#10'".......................",'
|
||||
+#10'".......................",'#10'".......................",'#10'".........'
|
||||
+'..............",'#10'".......................",'#10'"......................'
|
||||
+'.",'#10'".......................",'#10'".......................",'#10'"....'
|
||||
+'...................",'#10'".......................",'#10'"#################'
|
||||
+'######",'#10'".......................",'#10'"...........aaaaaaaaaa..",'#10
|
||||
+'"...........a..bb....#..",'#10'"...........a.bbb.c.c#..",'#10'"...........a'
|
||||
+'.bbb.c.c#..",'#10'"...........a..bb....#..",'#10'"...........a#########..",'
|
||||
+#10'"......................."};'#10
|
||||
]);
|
||||
@ -1,264 +0,0 @@
|
||||
{
|
||||
trayicon.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
|
||||
|
||||
Special thanks for: Danny Milosavljevic and the Lazarus Team
|
||||
|
||||
This unit contains the SystrayIcon object and the TTrayIcon visual component.
|
||||
|
||||
Documentation for the component can be found here:
|
||||
http://wiki.lazarus.freepascal.org/index.php/TrayIcon
|
||||
}
|
||||
{Version 0.2}
|
||||
unit TrayIcon;
|
||||
|
||||
{$ifdef FPC}
|
||||
{$mode delphi}{$H+}
|
||||
{$endif}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{$ifdef fpc}
|
||||
LResources,
|
||||
{$else}
|
||||
Windows,
|
||||
{$endif}
|
||||
Classes, SysUtils, WSTrayIcon, Menus, Graphics, Forms, Controls, Dialogs;
|
||||
|
||||
type
|
||||
|
||||
{ TTrayIcon }
|
||||
|
||||
TTrayIcon = class(TComponent)
|
||||
private
|
||||
{ Private declarations }
|
||||
vPopUpMenu: TPopupMenu;
|
||||
vIcon: TIcon;
|
||||
vHint: string;
|
||||
vVisible, vShowIcon, vShowHint: Boolean;
|
||||
vOnPaint, vOnClick, vOnDblClick: TNotifyEvent;
|
||||
vOnMouseDown, vOnMouseUp: TMouseEvent;
|
||||
vOnMouseMove: TMouseMoveEvent;
|
||||
vwsTrayIcon: TWSTrayIcon;
|
||||
function GetCanvas: TCanvas;
|
||||
procedure SetVisible(Value: Boolean);
|
||||
protected
|
||||
{ Protected declarations }
|
||||
public
|
||||
{ Public declarations }
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
function Hide: Boolean;
|
||||
function Show: Boolean;
|
||||
procedure UpdateWS;
|
||||
function GetPosition: TPoint;
|
||||
property Canvas: TCanvas read GetCanvas;
|
||||
published
|
||||
{ Published declarations }
|
||||
property PopUpMenu: TPopupMenu read vPopUpMenu write vPopUpMenu;
|
||||
property Icon: TIcon read vIcon write vIcon;
|
||||
property Hint: string read vHint write vHint;
|
||||
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;
|
||||
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;
|
||||
|
||||
var
|
||||
SystrayIcon: TTrayIcon;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
{ TTrayIcon }
|
||||
|
||||
{*******************************************************************
|
||||
* TTrayIcon.Create ()
|
||||
*
|
||||
* DESCRIPTION: Creates a object from the TTrayIconClass class
|
||||
*
|
||||
* PARAMETERS: AOwner - The owner of the component (this may be nil)
|
||||
*
|
||||
* RETURNS: A pointer to the newly created object
|
||||
*
|
||||
*******************************************************************}
|
||||
constructor TTrayIcon.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
|
||||
vIcon := TIcon.Create;
|
||||
|
||||
vShowIcon := True;
|
||||
|
||||
vWSTrayIcon := TWSTrayIcon.Create;
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* TTrayIcon.Destroy ()
|
||||
*
|
||||
* DESCRIPTION: Destroys a object derived from the TTrayIconClass class
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
destructor TTrayIcon.Destroy;
|
||||
begin
|
||||
vIcon.Free;
|
||||
|
||||
vwsTrayIcon.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* TTrayIcon.Hide ()
|
||||
*
|
||||
* DESCRIPTION: Hides the Icon
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: If successfull
|
||||
*
|
||||
*******************************************************************}
|
||||
function TTrayIcon.Hide: Boolean;
|
||||
begin
|
||||
vVisible := False;
|
||||
|
||||
UpdateWS;
|
||||
|
||||
Result := vwsTrayIcon.Hide;
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* TTrayIcon.Show ()
|
||||
*
|
||||
* DESCRIPTION: Shows the Icon
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: If successfull
|
||||
*
|
||||
*******************************************************************}
|
||||
function TTrayIcon.Show: Boolean;
|
||||
begin
|
||||
vVisible := True;
|
||||
|
||||
UpdateWS;
|
||||
|
||||
Result := vwsTrayIcon.Show;
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* TTrayIcon.SetVisible ()
|
||||
*
|
||||
* DESCRIPTION: Setter method of the Visible property
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: If successfull
|
||||
*
|
||||
*******************************************************************}
|
||||
procedure TTrayIcon.SetVisible(Value: Boolean);
|
||||
begin
|
||||
if Value then Show
|
||||
else Hide;
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* TTrayIcon.UpdateWS ()
|
||||
*
|
||||
* DESCRIPTION: Updates the widgetset object
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
procedure TTrayIcon.UpdateWS;
|
||||
begin
|
||||
vwsTrayIcon.Icon.Assign(vIcon);
|
||||
vwsTrayIcon.PopUpMenu := vPopUpMenu;
|
||||
vwsTrayIcon.ShowHint := vShowHint;
|
||||
vwsTrayIcon.ShowIcon := vShowIcon;
|
||||
vwsTrayIcon.Hint := vHint;
|
||||
|
||||
// Update events
|
||||
vwsTrayIcon.OnClick := vOnClick;
|
||||
vwsTrayIcon.OnPaint := vOnPaint;
|
||||
vwsTrayIcon.OnDblClick := vOnDblClick;
|
||||
vwsTrayIcon.OnMouseDown := vOnMouseDown;
|
||||
vwsTrayIcon.OnMouseUp := vOnMouseUp;
|
||||
vwsTrayIcon.OnMouseMove := vOnMouseMove;
|
||||
|
||||
// Allows the widgetset to update itself internally
|
||||
vwsTrayIcon.InternalUpdate;
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* TTrayIcon.GetPosition ()
|
||||
*
|
||||
* DESCRIPTION: Returns the position of the tray icon on the display.
|
||||
* This function is utilized to show message boxes near
|
||||
* the icon
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
function TTrayIcon.GetPosition: TPoint;
|
||||
begin
|
||||
Result := vwsTrayIcon.GetPosition;
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* TTrayIcon.GetCanvas ()
|
||||
*
|
||||
* DESCRIPTION: Getter method of the Canvas property
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: The canvas of the underlaying Widgetset component
|
||||
*
|
||||
*******************************************************************}
|
||||
function TTrayIcon.GetCanvas: TCanvas;
|
||||
begin
|
||||
Result := vwsTrayIcon.Canvas;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterComponents('Additional', [TTrayIcon]);
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$I trayicon.lrs}
|
||||
SystrayIcon := TTrayIcon.Create(nil);
|
||||
|
||||
finalization
|
||||
|
||||
SystrayIcon.Free;
|
||||
|
||||
end.
|
||||
|
||||
@ -1,84 +0,0 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<Package Version="2">
|
||||
<Name Value="TrayIconLaz"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="5"/>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value="$(LazarusDir)/components/opengl/gtk2x11/"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)/$(LCLWidgetType)"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<Generate Value="Faster"/>
|
||||
</CodeGeneration>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Version Minor="2"/>
|
||||
<Files Count="10">
|
||||
<Item1>
|
||||
<Filename Value="wswin32trayicon.pas"/>
|
||||
<AddToUsesPkgSection Value="False"/>
|
||||
<UnitName Value="WSWin32TrayIcon"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Filename Value="trayicon.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="TrayIcon"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Filename Value="wsgtk2trayicon.pas"/>
|
||||
<AddToUsesPkgSection Value="False"/>
|
||||
<UnitName Value="WSGtk2TrayIcon"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<Filename Value="wsgtktrayicon.pas"/>
|
||||
<AddToUsesPkgSection Value="False"/>
|
||||
<UnitName Value="wsgtktrayicon"/>
|
||||
</Item4>
|
||||
<Item5>
|
||||
<Filename Value="wstrayicon.pas"/>
|
||||
<UnitName Value="wstrayicon"/>
|
||||
</Item5>
|
||||
<Item6>
|
||||
<Filename Value="wsx11trayicon.pas"/>
|
||||
<AddToUsesPkgSection Value="False"/>
|
||||
<UnitName Value="wsx11trayicon"/>
|
||||
</Item6>
|
||||
<Item7>
|
||||
<Filename Value="wscommontrayicon.pas"/>
|
||||
<UnitName Value="WSCommonTrayIcon"/>
|
||||
</Item7>
|
||||
<Item8>
|
||||
<Filename Value="README.txt"/>
|
||||
<Type Value="Text"/>
|
||||
</Item8>
|
||||
<Item9>
|
||||
<Filename Value="ttrayicon.xpm"/>
|
||||
<Type Value="Text"/>
|
||||
</Item9>
|
||||
<Item10>
|
||||
<Filename Value="trayicon.lrs"/>
|
||||
<Type Value="LRS"/>
|
||||
</Item10>
|
||||
</Files>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<RequiredPkgs Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="FCL"/>
|
||||
<MinVersion Major="1" Valid="True"/>
|
||||
</Item2>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)/"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IgnoreBinaries Value="False"/>
|
||||
</PublishOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
@ -1,21 +0,0 @@
|
||||
{ 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, WSCommonTrayIcon, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
RegisterUnit('TrayIcon', @TrayIcon.Register);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterPackage('TrayIconLaz', @Register);
|
||||
end.
|
||||
@ -1,31 +0,0 @@
|
||||
/* XPM */
|
||||
static char *trayicon[]={
|
||||
"23 23 5 1",
|
||||
". c None",
|
||||
"c c #000000",
|
||||
"a c #808080",
|
||||
"b c #ffff00",
|
||||
"# c #ffffff",
|
||||
".......................",
|
||||
".......................",
|
||||
".......................",
|
||||
".......................",
|
||||
".......................",
|
||||
".......................",
|
||||
".......................",
|
||||
".......................",
|
||||
".......................",
|
||||
".......................",
|
||||
".......................",
|
||||
".......................",
|
||||
".......................",
|
||||
".......................",
|
||||
"#######################",
|
||||
".......................",
|
||||
"...........aaaaaaaaaa..",
|
||||
"...........a..bb....#..",
|
||||
"...........a.bbb.c.c#..",
|
||||
"...........a.bbb.c.c#..",
|
||||
"...........a..bb....#..",
|
||||
"...........a#########..",
|
||||
"......................."};
|
||||
@ -1,110 +0,0 @@
|
||||
{
|
||||
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}
|
||||
|
||||
{*******************************************************************
|
||||
* Compatibility code for Delphi for Windows.
|
||||
*******************************************************************}
|
||||
{$ifndef FPC}
|
||||
{$define Windows}
|
||||
{$endif}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{$IFDEF Windows}
|
||||
Windows,
|
||||
{$ENDIF}
|
||||
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;
|
||||
function Hide: Boolean; virtual; abstract;
|
||||
function Show: Boolean; virtual; abstract;
|
||||
function GetPosition: TPoint; 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
|
||||
Hide;
|
||||
|
||||
Icon.Free;
|
||||
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -1,523 +0,0 @@
|
||||
{
|
||||
wsgtk2trayicon.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
|
||||
|
||||
Special thanks for: Danny Milosavljevic and the Lazarus Team
|
||||
|
||||
Gtk2 specific code.
|
||||
}
|
||||
unit WSGtk2TrayIcon;
|
||||
|
||||
{$ifdef FPC}
|
||||
{$mode delphi}{$H+}
|
||||
{$endif}
|
||||
|
||||
{$PACKRECORDS C}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Graphics, Classes, ExtCtrls, SysUtils, Forms, Controls, Dialogs, Menus,
|
||||
WSCommonTrayIcon, x, xlib, xutil, gtk2, gdk2, gdk2x, glib2, gtkdef, gtkproc;
|
||||
|
||||
type
|
||||
|
||||
{ TWidgetTrayIcon }
|
||||
|
||||
TWidgetTrayIcon = class(TCustomWidgetTrayIcon)
|
||||
private
|
||||
fOwner: TComponent;
|
||||
fEmbedded: Boolean;
|
||||
fMsgCount: Integer;
|
||||
Tips: PGtkTooltips;
|
||||
procedure CreateForm(id: Integer);
|
||||
procedure RemoveForm(id: Integer);
|
||||
function GetCanvas: TCanvas;
|
||||
protected
|
||||
public
|
||||
function Hide: Boolean; override;
|
||||
function Show: Boolean; override;
|
||||
property Canvas: TCanvas read GetCanvas;
|
||||
procedure InternalUpdate; override;
|
||||
procedure PaintForm(Sender: TObject);
|
||||
function GetPosition: TPoint; override;
|
||||
published
|
||||
end;
|
||||
|
||||
const
|
||||
SYSTEM_TRAY_REQUEST_DOCK = 0;
|
||||
SYSTEM_TRAY_BEGIN_MESSAGE = 1;
|
||||
SYSTEM_TRAY_CANCEL_MESSAGE = 2;
|
||||
|
||||
implementation
|
||||
|
||||
uses WSTrayIcon;
|
||||
|
||||
var
|
||||
fDisplay: PDisplay;
|
||||
fWindow: TWindow;
|
||||
fScreen: PScreen;
|
||||
fScreenID: longint;
|
||||
GtkForm: PGtkWidget;
|
||||
fTrayParent: TWindow;
|
||||
|
||||
{*******************************************************************
|
||||
* TempX11ErrorHandler ()
|
||||
*
|
||||
* DESCRIPTION: Temp ErrorHandler
|
||||
*
|
||||
* PARAMETERS: ?
|
||||
*
|
||||
* RETURNS: ?
|
||||
*
|
||||
*******************************************************************}
|
||||
function TempX11ErrorHandler(Display:PDisplay; ErrorEv:PXErrorEvent):longint;cdecl;
|
||||
begin
|
||||
WriteLn('Error: ' + IntToStr(ErrorEv^.error_code));
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* Send_Message ()
|
||||
*
|
||||
* DESCRIPTION: Sends a message to the X client
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
function SendMessage(window: TWindow; msg: Integer; data1, data2, data3: Integer): boolean;
|
||||
var
|
||||
Ev: TXEvent;
|
||||
fmt: Integer;
|
||||
begin
|
||||
FillChar(Ev, SizeOf(TXEvent), $0);
|
||||
|
||||
ev.xclient._type := ClientMessage;
|
||||
ev.xclient.window := window;
|
||||
ev.xclient.message_type := XInternAtom (fDisplay, '_NET_SYSTEM_TRAY_OPCODE', False );
|
||||
ev.xclient.format := 32;
|
||||
ev.xclient.data.l[0] := CurrentTime;
|
||||
ev.xclient.data.l[1] := msg;
|
||||
ev.xclient.data.l[2] := data1;
|
||||
ev.xclient.data.l[3] := data2;
|
||||
ev.xclient.data.l[4] := data3;
|
||||
|
||||
XSendEvent(fDisplay, fTrayParent, False, NoEventMask, @ev);
|
||||
XSync(fDisplay, False);
|
||||
Result := false;//(untrap_errors() = 0);
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* SetEmbedded ()
|
||||
*
|
||||
* DESCRIPTION: Docks the GtkPlug into the system tray
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
procedure SetEmbedded;
|
||||
var
|
||||
old_error: TXErrorHandler;
|
||||
buf: array [0..32] of char;
|
||||
selection_atom : TAtom;
|
||||
begin
|
||||
old_error := XSetErrorHandler(@TempX11ErrorHandler);
|
||||
|
||||
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
|
||||
SendMessage(fTrayParent, SYSTEM_TRAY_REQUEST_DOCK, fWindow, 0, 0);
|
||||
|
||||
XSetErrorHandler(old_error);
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* realize_cb ()
|
||||
*
|
||||
* DESCRIPTION: Callback function for the realize signal
|
||||
* Sets the systray icon after the widget is realized
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
procedure realize_cb(widget: PGtkWidget; user_data: gpointer); cdecl;
|
||||
var
|
||||
gdk_screen: PGdkScreen;
|
||||
begin
|
||||
fDisplay := GDK_WINDOW_XDISPLAY(GtkForm^.window);
|
||||
fWindow := GDK_WINDOW_XWINDOW(GtkForm^.window);
|
||||
|
||||
{ Doesn´t work
|
||||
|
||||
gdk_screen := gtk_widget_get_screen(GtkForm);
|
||||
fScreen := GDK_SCREEN_XSCREEN(gdk_screen); // get the real screen}
|
||||
|
||||
fScreen := XDefaultScreenOfDisplay(fDisplay);
|
||||
fScreenID := XScreenNumberOfScreen(fScreen); // and it's number
|
||||
|
||||
SetEmbedded;
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* button_release_cb ()
|
||||
*
|
||||
* DESCRIPTION: Callback function for Mouse Click
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
function button_release_cb(widget: PGtkWidget; event: PGdkEventButton;
|
||||
user_data: gpointer): gboolean; cdecl;
|
||||
var
|
||||
vwsTrayIcon: TWSTrayIcon;
|
||||
begin
|
||||
vwsTrayIcon := TWSTrayIcon(user_data);
|
||||
|
||||
Result := False;
|
||||
|
||||
case event^.button of
|
||||
1:
|
||||
begin
|
||||
if Assigned(vwsTrayIcon.OnClick) then vwsTrayIcon.OnClick(vwsTrayIcon);
|
||||
if Assigned(vwsTrayIcon.OnMouseUp) then
|
||||
vwsTrayIcon.OnMouseUp(vwsTrayIcon, mbLeft, [], Round(event^.X), Round(event^.Y));
|
||||
end;
|
||||
|
||||
2: if Assigned(vwsTrayIcon.OnMouseUp) then
|
||||
vwsTrayIcon.OnMouseUp(vwsTrayIcon, mbMiddle, [], Round(event^.X), Round(event^.Y));
|
||||
|
||||
3:
|
||||
begin
|
||||
if Assigned(vwsTrayIcon.OnMouseUp) then
|
||||
vwsTrayIcon.OnMouseUp(vwsTrayIcon, mbRight, [], Round(event^.X), Round(event^.Y));
|
||||
if Assigned(vwsTrayIcon.PopUpMenu) then
|
||||
vwsTrayIcon.PopUpMenu.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* button_press_cb ()
|
||||
*
|
||||
* DESCRIPTION: Callback function for Mouse Click
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
function button_press_cb(widget: PGtkWidget; event: PGdkEventButton;
|
||||
user_data: gpointer): gboolean; cdecl;
|
||||
var
|
||||
vwsTrayIcon: TWSTrayIcon;
|
||||
begin
|
||||
vwsTrayIcon := TWSTrayIcon(user_data);
|
||||
|
||||
Result := False;
|
||||
|
||||
if (event^._type = GDK_2BUTTON_PRESS) and Assigned(vwsTrayIcon.OnDblClick) then
|
||||
vwsTrayIcon.OnDblClick(vwsTrayIcon)
|
||||
else
|
||||
begin
|
||||
case event^.button of
|
||||
1: if Assigned(vwsTrayIcon.OnMouseDown) then
|
||||
vwsTrayIcon.OnMouseDown(vwsTrayIcon, mbLeft, [], Round(event^.X), Round(event^.Y));
|
||||
|
||||
2: if Assigned(vwsTrayIcon.OnMouseDown) then
|
||||
vwsTrayIcon.OnMouseDown(vwsTrayIcon, mbMiddle, [], Round(event^.X), Round(event^.Y));
|
||||
|
||||
3: if Assigned(vwsTrayIcon.OnMouseDown) then
|
||||
vwsTrayIcon.OnMouseDown(vwsTrayIcon, mbRight, [], Round(event^.X), Round(event^.Y));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* popup_cb ()
|
||||
*
|
||||
* DESCRIPTION: Callback function for the popup menu
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
function popup_cb(widget: PGtkWidget; user_data: gpointer): Boolean; cdecl;
|
||||
var
|
||||
vwsTrayIcon: TWSTrayIcon;
|
||||
begin
|
||||
vwsTrayIcon := TWSTrayIcon(user_data);
|
||||
|
||||
Result := True;
|
||||
|
||||
if Assigned(vwsTrayIcon.PopUpMenu) then
|
||||
vwsTrayIcon.PopUpMenu.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y);
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* motion_cb ()
|
||||
*
|
||||
* DESCRIPTION: Callback function for the OnMouseMove event
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
function motion_cb(widget: PGtkWidget; event: PGdkEventMotion; user_data: gpointer): Boolean; cdecl;
|
||||
var
|
||||
vwsTrayIcon: TWSTrayIcon;
|
||||
begin
|
||||
vwsTrayIcon := TWSTrayIcon(user_data);
|
||||
|
||||
Result := False;
|
||||
|
||||
if Assigned(vwsTrayIcon.OnMouseMove) then
|
||||
vwsTrayIcon.OnMouseMove(vwsTrayIcon, [], Round(event^.X), Round(event^.Y));
|
||||
end;
|
||||
|
||||
{ TWidgetTrayIcon }
|
||||
|
||||
{*******************************************************************
|
||||
* TWidgetTrayIcon.CreateForm ()
|
||||
*
|
||||
* DESCRIPTION:
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
procedure TWidgetTrayIcon.CreateForm(id: Integer);
|
||||
var
|
||||
AImage: PGtkWidget;
|
||||
AMask: PGdkBitmap;
|
||||
GDIObject: PgdiObject;
|
||||
begin
|
||||
{*******************************************************************
|
||||
* Creates the GtkPlug
|
||||
*******************************************************************}
|
||||
|
||||
fEmbedded := False;
|
||||
|
||||
GtkForm := gtk_plug_new(0);
|
||||
|
||||
Tips := gtk_tooltips_new;
|
||||
|
||||
g_object_ref(Tips);
|
||||
|
||||
gtk_object_sink(GTK_OBJECT(Tips));
|
||||
|
||||
gtk_tooltips_set_tip(GTK_TOOLTIPS(Tips), GtkForm, PChar(Hint), '');
|
||||
|
||||
{*******************************************************************
|
||||
* Connects the signals
|
||||
*******************************************************************}
|
||||
|
||||
gtk_widget_add_events(GtkForm, GDK_ALL_EVENTS_MASK);
|
||||
|
||||
g_signal_connect(GtkForm, 'realize', TGCallback(@realize_cb), Self);
|
||||
|
||||
g_signal_connect(GtkForm, 'popup-menu', TGCallback(@popup_cb), Self);
|
||||
|
||||
g_signal_connect(GtkForm, 'motion-notify-event', TGCallback(@motion_cb), Self);
|
||||
|
||||
g_signal_connect(GtkForm, 'button-press-event', TGCallback(@button_press_cb), Self);
|
||||
|
||||
g_signal_connect(GtkForm, 'button-release-event', TGCallback(@button_release_cb), Self);
|
||||
|
||||
{*******************************************************************
|
||||
* Draws the icon
|
||||
*******************************************************************}
|
||||
|
||||
GDIObject := PgdiObject(Icon.Handle);
|
||||
|
||||
GDIObject := PgdiObject(Icon.Handle);
|
||||
|
||||
AMask := CreateGdkMaskBitmap(
|
||||
GDIObject^.GDIPixmapObject.Mask,
|
||||
GDIObject^.GDIBitmapObject);
|
||||
|
||||
AImage := gtk_image_new_from_pixmap(GDIObject^.GDIPixmapObject.Image, AMask);
|
||||
|
||||
g_object_unref(AMask);
|
||||
|
||||
gtk_widget_show(AImage);
|
||||
|
||||
gtk_container_add(GTK_CONTAINER(GtkForm), AImage);
|
||||
|
||||
{*******************************************************************
|
||||
* Now shows the GtkPlug
|
||||
*******************************************************************}
|
||||
|
||||
gtk_widget_show(GtkForm);
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* TWidgetTrayIcon.RemoveForm ()
|
||||
*
|
||||
* DESCRIPTION:
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
procedure TWidgetTrayIcon.RemoveForm(id: Integer);
|
||||
begin
|
||||
gtk_widget_destroy(GtkForm);
|
||||
|
||||
GtkForm := nil;
|
||||
|
||||
g_object_unref(Tips);
|
||||
|
||||
Tips := nil;
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* TWidgetTrayIcon.GetCanvas ()
|
||||
*
|
||||
* DESCRIPTION:
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
function TWidgetTrayIcon.GetCanvas: TCanvas;
|
||||
begin
|
||||
Result := Icon.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
|
||||
Result := False;
|
||||
|
||||
if not vVisible then Exit;
|
||||
|
||||
RemoveForm(0);
|
||||
|
||||
vVisible := False;
|
||||
|
||||
Result := True;
|
||||
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
|
||||
Result := False;
|
||||
|
||||
if vVisible then Exit;
|
||||
|
||||
CreateForm(0);
|
||||
|
||||
fEmbedded := True;
|
||||
|
||||
vVisible := True;
|
||||
|
||||
Result := True;
|
||||
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);
|
||||
|
||||
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(Tips) then gtk_tooltips_set_tip(GTK_TOOLTIPS(Tips), GtkForm, PChar(Hint), '');
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* TWidgetTrayIcon.GetPosition ()
|
||||
*
|
||||
* DESCRIPTION: Returns the position of the tray icon on the display.
|
||||
* This function is utilized to show message boxes near
|
||||
* the icon
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
function TWidgetTrayIcon.GetPosition: TPoint;
|
||||
begin
|
||||
Result.X := 0;
|
||||
Result.Y := 0;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -1,360 +0,0 @@
|
||||
{
|
||||
wsgtktrayicon.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
|
||||
|
||||
Special thanks for: Danny Milosavljevic and the Lazarus Team
|
||||
|
||||
Gtk1 specific code. Works on gnome also.
|
||||
}
|
||||
unit wsgtktrayicon;
|
||||
|
||||
{$ifdef FPC}
|
||||
{$mode delphi}{$H+}
|
||||
{$endif}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Graphics, Classes, ExtCtrls, SysUtils, Forms, Controls, Dialogs,
|
||||
Menus, wscommontrayicon, x, xlib, xutil, gtk, gdk;
|
||||
|
||||
type
|
||||
|
||||
{ TWidgetTrayIcon }
|
||||
|
||||
TWidgetTrayIcon = class(TCustomWidgetTrayIcon)
|
||||
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
|
||||
function Hide: Boolean; override;
|
||||
function Show: Boolean; override;
|
||||
property Canvas: TCanvas read GetCanvas;
|
||||
procedure InternalUpdate; override;
|
||||
function GetPosition: TPoint; override;
|
||||
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
|
||||
WriteLn('Error: ' + IntToStr(ErrorEv^.error_code));
|
||||
Result:=0;
|
||||
end;
|
||||
|
||||
|
||||
{ TWidgetTrayIcon }
|
||||
|
||||
{*******************************************************************
|
||||
* TWidgetTrayIcon.SetEmbedded ()
|
||||
*
|
||||
* DESCRIPTION:
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
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;
|
||||
|
||||
{*******************************************************************
|
||||
* 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;
|
||||
begin
|
||||
FillChar(Ev, SizeOf(TXEvent), $0);
|
||||
|
||||
ev.xclient._type := ClientMessage;
|
||||
ev.xclient.window := window;
|
||||
ev.xclient.message_type := XInternAtom (fDisplay, '_NET_SYSTEM_TRAY_OPCODE', False );
|
||||
ev.xclient.format := 32;
|
||||
ev.xclient.data.l[0] := CurrentTime;
|
||||
ev.xclient.data.l[1] := msg;
|
||||
ev.xclient.data.l[2] := data1;
|
||||
ev.xclient.data.l[3] := data2;
|
||||
ev.xclient.data.l[4] := data3;
|
||||
|
||||
XSendEvent(fDisplay, fTrayParent, False, NoEventMask, @ev);
|
||||
XSync(fDisplay, False);
|
||||
Result := false;//(untrap_errors() = 0);
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* TWidgetTrayIcon.CreateForm ()
|
||||
*
|
||||
* DESCRIPTION:
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
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;
|
||||
|
||||
{*******************************************************************
|
||||
* 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;
|
||||
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
|
||||
Result := False;
|
||||
|
||||
if not vVisible then Exit;
|
||||
|
||||
RemoveForm(0);
|
||||
|
||||
vVisible := False;
|
||||
|
||||
Result := True;
|
||||
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
|
||||
Result := False;
|
||||
|
||||
if vVisible then Exit;
|
||||
|
||||
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.OnDblClick := Self.OnDblClick;
|
||||
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;
|
||||
begin
|
||||
FillChar(size_hints, SizeOf(TXSizeHints), $0);
|
||||
|
||||
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;
|
||||
|
||||
{*******************************************************************
|
||||
* 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);
|
||||
|
||||
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;
|
||||
|
||||
{*******************************************************************
|
||||
* TWidgetTrayIcon.GetPosition ()
|
||||
*
|
||||
* DESCRIPTION: Returns the position of the tray icon on the display.
|
||||
* This function is utilized to show message boxes near
|
||||
* the icon
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
function TWidgetTrayIcon.GetPosition: TPoint;
|
||||
begin
|
||||
Result.X := 0;
|
||||
Result.Y := 0;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -1,207 +0,0 @@
|
||||
{
|
||||
wsqttrayicon.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
|
||||
|
||||
Special thanks for: Danny Milosavljevic and the Lazarus Team
|
||||
|
||||
Qt specific code.
|
||||
}
|
||||
unit wsqttrayicon;
|
||||
|
||||
{$ifdef FPC}
|
||||
{$mode objfpc}{$H+}
|
||||
{$endif}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{$ifdef USE_QT_4_3}
|
||||
qt43,
|
||||
{$else}
|
||||
qt4,
|
||||
{$endif}
|
||||
Classes, SysUtils, Graphics, ExtCtrls, Menus, Controls, Lclintf,
|
||||
wscommontrayicon, qtobjects, qtwidgets;
|
||||
|
||||
type
|
||||
|
||||
{ TWidgetTrayIcon }
|
||||
|
||||
TWidgetTrayIcon = class(TCustomWidgetTrayIcon)
|
||||
private
|
||||
IconHandle: QIconH;
|
||||
SystemTrayIcon: TQtSystemTrayIcon;
|
||||
function CreateIcon: QIconH;
|
||||
function GetCanvas: TCanvas;
|
||||
protected
|
||||
public
|
||||
hIcon, hSmallIcon: Cardinal;
|
||||
function Hide: Boolean; override;
|
||||
function Show: Boolean; override;
|
||||
property Canvas: TCanvas read GetCanvas;
|
||||
procedure InternalUpdate; override;
|
||||
function GetPosition: TPoint; override;
|
||||
published
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses WSTrayIcon;
|
||||
|
||||
{ TWidgetTrayIcon }
|
||||
|
||||
{*******************************************************************
|
||||
* TWidgetTrayIcon.CreateIcon ()
|
||||
*
|
||||
* DESCRIPTION: Converts a TIcon to a QIconH
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
function TWidgetTrayIcon.CreateIcon: QIconH;
|
||||
var
|
||||
Pixmap: QPixmapH;
|
||||
begin
|
||||
if Icon.Handle <> 0 then
|
||||
begin
|
||||
Pixmap := QPixmap_create();
|
||||
QPixmap_fromImage(Pixmap, TQtImage(Icon.Handle).Handle);
|
||||
|
||||
Result := QIcon_create(Pixmap);
|
||||
QPixmap_destroy(Pixmap);
|
||||
end
|
||||
else
|
||||
Result := QIcon_create();
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* TWidgetTrayIcon.GetCanvas ()
|
||||
*
|
||||
* DESCRIPTION:
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
function TWidgetTrayIcon.GetCanvas: TCanvas;
|
||||
begin
|
||||
Result := Icon.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
|
||||
Result := False;
|
||||
|
||||
if not vVisible then Exit;
|
||||
|
||||
SystemTrayIcon.hide;
|
||||
|
||||
SystemTrayIcon.Free;
|
||||
|
||||
QIcon_destroy(IconHandle);
|
||||
|
||||
vVisible := False;
|
||||
|
||||
Result := True;
|
||||
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
|
||||
Text: WideString;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
if vVisible then Exit;
|
||||
|
||||
IconHandle := CreateIcon;
|
||||
|
||||
SystemTrayIcon := TQtSystemTrayIcon.create(IconHandle);
|
||||
|
||||
Text := UTF8Decode(Hint);
|
||||
SystemTrayIcon.setToolTip(Text);
|
||||
|
||||
if Assigned(PopUpMenu) then
|
||||
if TQtMenu(PopUpMenu.Handle).Widget <> nil then
|
||||
SystemTrayIcon.setContextMenu(QMenuH(TQtMenu(PopUpMenu.Handle).Widget));
|
||||
|
||||
SystemTrayIcon.show;
|
||||
|
||||
vVisible := True;
|
||||
|
||||
Result := True;
|
||||
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
|
||||
{ PopUpMenu }
|
||||
if Assigned(PopUpMenu) then
|
||||
if TQtMenu(PopUpMenu.Handle).Widget <> nil then
|
||||
SystemTrayIcon.setContextMenu(QMenuH(TQtMenu(PopUpMenu.Handle).Widget));
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* TWidgetTrayIcon.GetPosition ()
|
||||
*
|
||||
* DESCRIPTION: Returns the position of the tray icon on the display.
|
||||
* This function is utilized to show message boxes near
|
||||
* the icon
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
function TWidgetTrayIcon.GetPosition: TPoint;
|
||||
begin
|
||||
Result.X := 0;
|
||||
Result.Y := 0;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -1,104 +0,0 @@
|
||||
{
|
||||
wstrayicon.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
|
||||
|
||||
Special thanks for: Danny Milosavljevic and the Lazarus Team
|
||||
|
||||
This unit calls the appropriate widgetset code.
|
||||
}
|
||||
unit wstrayicon;
|
||||
|
||||
{$ifdef FPC}
|
||||
{$mode delphi}{$H+}
|
||||
{$endif}
|
||||
|
||||
interface
|
||||
|
||||
{*******************************************************************
|
||||
* Compatibility code for Delphi for Windows.
|
||||
*******************************************************************}
|
||||
{$ifndef FPC}
|
||||
{$define Windows}
|
||||
{$endif}
|
||||
|
||||
uses
|
||||
|
||||
{$ifdef Windows}
|
||||
|
||||
{$ifdef WinCE}
|
||||
|
||||
wswincetrayicon,
|
||||
|
||||
{$else}
|
||||
|
||||
{$ifdef LCLQt}
|
||||
wsqttrayicon,
|
||||
{$else}
|
||||
wswin32trayicon,
|
||||
{$endif}
|
||||
|
||||
{$endif}
|
||||
|
||||
{$endif}
|
||||
{$ifdef UNIX}
|
||||
|
||||
{$ifdef DARWIN}
|
||||
|
||||
{$ifdef LCLQt}
|
||||
wsqttrayicon,
|
||||
{$else}
|
||||
wscarbontrayicon,
|
||||
{$endif}
|
||||
|
||||
{$else}
|
||||
|
||||
{$ifdef LCLGtk}
|
||||
wsgtktrayicon,
|
||||
{$endif}
|
||||
|
||||
{$ifdef LCLGtk2}
|
||||
wsgtk2trayicon,
|
||||
{$endif}
|
||||
|
||||
{$ifdef LCLQt}
|
||||
wsqttrayicon,
|
||||
{$endif}
|
||||
|
||||
{$ifdef LCLFPGUI}
|
||||
wsx11trayicon,
|
||||
{$endif}
|
||||
|
||||
{$endif}
|
||||
|
||||
{$endif}
|
||||
|
||||
Classes, SysUtils;
|
||||
|
||||
type
|
||||
|
||||
{ TWSTrayIcon }
|
||||
|
||||
TWSTrayIcon = class(TWidgetTrayIcon)
|
||||
private
|
||||
protected
|
||||
public
|
||||
published
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -1,318 +0,0 @@
|
||||
{
|
||||
wswin32trayicon.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
|
||||
|
||||
Special thanks for: Danny Milosavljevic and the Lazarus Team
|
||||
|
||||
Win32 specific code.
|
||||
}
|
||||
unit WSWin32TrayIcon;
|
||||
|
||||
{$ifdef FPC}
|
||||
{$mode delphi}{$H+}
|
||||
{$endif}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Classes, SysUtils, Graphics, Menus, Forms, Controls,
|
||||
WSCommonTrayIcon;
|
||||
|
||||
type
|
||||
|
||||
{ TWidgetTrayIcon }
|
||||
|
||||
TWidgetTrayIcon = class(TCustomWidgetTrayIcon)
|
||||
private
|
||||
WindowHandle: HWND;
|
||||
function GetCanvas: TCanvas;
|
||||
protected
|
||||
public
|
||||
constructor Create; override;
|
||||
destructor Destroy; override;
|
||||
function Hide: Boolean; override;
|
||||
function Show: Boolean; override;
|
||||
property Canvas: TCanvas read GetCanvas;
|
||||
procedure InternalUpdate; override;
|
||||
function GetPosition: TPoint; override;
|
||||
published
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses WSTrayIcon, ShellAPI, Messages;
|
||||
|
||||
const
|
||||
szClassName = 'TTrayIconClass';
|
||||
szAppTitle = 'apptitle';
|
||||
|
||||
var
|
||||
vwsTrayIcon: TWidgetTrayIcon;
|
||||
|
||||
{*******************************************************************
|
||||
* 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
|
||||
* //* 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
|
||||
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
|
||||
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_));
|
||||
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
|
||||
{$ifdef FPC}
|
||||
Result := Icon.Canvas;
|
||||
{$endif}
|
||||
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;
|
||||
|
||||
vwsTrayIcon := Self;
|
||||
|
||||
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.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;
|
||||
|
||||
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
|
||||
if not vVisible then Exit;
|
||||
|
||||
// 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);
|
||||
|
||||
vVisible := False;
|
||||
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;
|
||||
buffer: PChar;
|
||||
begin
|
||||
if vVisible then Exit;
|
||||
|
||||
// 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 ShowHint then tnid.uFlags := tnid.uFlags or NIF_TIP;
|
||||
tnid.uCallbackMessage := WM_USER + uID;
|
||||
tnid.hIcon := Icon.Handle;
|
||||
buffer := PChar(Hint);
|
||||
StrCopy(@tnid.szTip, buffer);
|
||||
|
||||
// Create Taskbar icon
|
||||
Result := Shell_NotifyIconA(NIM_ADD, @tnid);
|
||||
|
||||
vVisible := True;
|
||||
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
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* TWidgetTrayIcon.GetPosition ()
|
||||
*
|
||||
* DESCRIPTION: Returns the position of the tray icon on the display.
|
||||
* This function is utilized to show message boxes near
|
||||
* the icon
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
function TWidgetTrayIcon.GetPosition: TPoint;
|
||||
begin
|
||||
Result.X := 0;
|
||||
Result.Y := 0;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -1,593 +0,0 @@
|
||||
{
|
||||
wsx11trayicon.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
|
||||
|
||||
Special thanks for: Danny Milosavljevic and the Lazarus Team
|
||||
|
||||
X11 specific code.
|
||||
}
|
||||
unit wsx11trayicon;
|
||||
|
||||
{$ifdef FPC}
|
||||
{$mode objfpc}{$H+}
|
||||
{$endif}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Graphics, ExtCtrls, Menus, Controls, Lclintf,
|
||||
wscommontrayicon, X, XLib, XUtil;
|
||||
|
||||
type
|
||||
|
||||
{ TWidgetTrayIcon }
|
||||
|
||||
TWidgetTrayIcon = class(TCustomWidgetTrayIcon)
|
||||
private
|
||||
fDisplay: PDisplay;
|
||||
fWindow: TWindow;
|
||||
fScreen: PScreen;
|
||||
fScreenID: longint;
|
||||
fTrayParent: TWindow;
|
||||
fOwner: TComponent;
|
||||
fEmbedded: Boolean;
|
||||
fMsgCount: Integer;
|
||||
|
||||
fDrawable: TWindow;
|
||||
fWindowID: TWindow;
|
||||
fVisual: PVisual;
|
||||
fDepth, fWidth, fHeight: Integer;
|
||||
fRootWindow: TWindow;
|
||||
gc: Xlib.TGC;
|
||||
fImage: xlib.PXImage;
|
||||
|
||||
fTimer: TTimer;
|
||||
|
||||
procedure SetEmbedded;
|
||||
procedure InitWM;
|
||||
procedure SetMinSize(AWidth, AHeight: Integer);
|
||||
function Send_Message(window: TWindow; msg: Integer;data1, data2,data3: Integer): boolean;
|
||||
function AttachIcon: TWindow;
|
||||
function GetCanvas: TCanvas;
|
||||
procedure OnEventTimer(Sender: TObject);
|
||||
procedure RePaint;
|
||||
protected
|
||||
public
|
||||
hIcon, hSmallIcon: Cardinal;
|
||||
ShowToolTip: Boolean;
|
||||
ToolTip: string;
|
||||
function Hide: Boolean; override;
|
||||
function Show: Boolean; override;
|
||||
property Canvas: TCanvas read GetCanvas;
|
||||
procedure InternalUpdate; override;
|
||||
function GetPosition: TPoint; override;
|
||||
published
|
||||
end;
|
||||
|
||||
const
|
||||
SYSTEM_TRAY_REQUEST_DOCK = 0;
|
||||
SYSTEM_TRAY_BEGIN_MESSAGE = 1;
|
||||
SYSTEM_TRAY_CANCEL_MESSAGE = 2;
|
||||
|
||||
implementation
|
||||
|
||||
uses WSTrayIcon;
|
||||
|
||||
// Temp ErrorHandler
|
||||
function TempX11ErrorHandler(Display:PDisplay; ErrorEv:PXErrorEvent): longint; cdecl;
|
||||
begin
|
||||
WriteLn('Error: ' + IntToStr(ErrorEv^.error_code));
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
// Processes X11 events
|
||||
function ProcessEvent(display:PDisplay; event:PXEvent; p : TXPointer): TBool; cdecl;
|
||||
begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
{ TWidgetTrayIcon }
|
||||
|
||||
{*******************************************************************
|
||||
* TWidgetTrayIcon.SetEmbedded ()
|
||||
*
|
||||
* DESCRIPTION:
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
procedure TWidgetTrayIcon.SetEmbedded;
|
||||
var
|
||||
Event: TXEvent;
|
||||
buf: array[0..19] of char;
|
||||
GCVals: TXGCValues;
|
||||
begin
|
||||
fDisplay := XOpenDisplay(nil);
|
||||
fScreen := XDefaultScreenOfDisplay(fDisplay);
|
||||
fVisual := DefaultVisualOfScreen(fScreen);
|
||||
fDepth:= DefaultDepthOfScreen(fScreen);
|
||||
fRootWindow := RootWindow(fDisplay, DefaultScreen(fDisplay));
|
||||
fWindowID := XCreateSimpleWindow(fDisplay, XRootWindow(fDisplay, 0), 0, 0, 34, 34, 0,
|
||||
fScreen^.black_pixel, fScreen^.white_pixel);
|
||||
fDrawable := fWindowID;
|
||||
|
||||
GCVals.background := WhitePixel(fDisplay, DefaultScreen(fDisplay));
|
||||
GCVals.foreground := BlackPixel(fDisplay, DefaultScreen(fDisplay));
|
||||
XSelectInput(fDisplay, fWindowID, ButtonPressMask or ButtonReleaseMask or PointerMotionMask
|
||||
or EnterWindowMask or LeaveWindowMask or VisibilityChangeMask or ExposureMask
|
||||
or SubstructureNotifyMask or ResizeRedirectMask);
|
||||
|
||||
|
||||
gc := XCreateGC(fDisplay, fWindowID, GCForeground or GCBackground, @GCVals);
|
||||
|
||||
buf := 'TEST';
|
||||
XChangeProperty(fDisplay, fWindowID, XInternAtom(fDisplay,'_NET_WM_NAME', false), XInternAtom(fDisplay, 'UTF8_STRING', False), 8, PropModeAppend, @buf, 4);
|
||||
XChangeProperty(fDisplay, fWindowID, XInternAtom(fDisplay,'_NET_WM_VISIBLE_NAME', false), XInternAtom(fDisplay, 'UTF8_STRING', False), 8, PropModeAppend, @buf, 4);
|
||||
buf := 'CONTEXT';
|
||||
XChangeProperty(fDisplay, fWindowID, XInternAtom(fDisplay, '_MB_SYSTEM_TRAY_CONTEXT', False), XInternAtom(fDisplay, 'UTF8_STRING', False), 8, PropModeAppend, @buf, 7);
|
||||
|
||||
XSync (fdisplay, False);
|
||||
AttachIcon;
|
||||
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;
|
||||
fmt: Integer;
|
||||
begin
|
||||
FillChar(Ev, SizeOf(TXEvent), $0);
|
||||
|
||||
ev.xclient._type := ClientMessage;
|
||||
ev.xclient.window := window;
|
||||
ev.xclient.message_type := XInternAtom (fDisplay, '_NET_SYSTEM_TRAY_OPCODE', False );
|
||||
ev.xclient.format := 32;
|
||||
ev.xclient.data.l[0] := CurrentTime;
|
||||
ev.xclient.data.l[1] := msg;
|
||||
ev.xclient.data.l[2] := data1;
|
||||
ev.xclient.data.l[3] := data2;
|
||||
ev.xclient.data.l[4] := data3;
|
||||
|
||||
XSendEvent(fDisplay, fTrayParent, False, NoEventMask, @ev);
|
||||
XSync(fDisplay, False);
|
||||
Result := false;//(untrap_errors() = 0);
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* TWidgetTrayIcon.InitWM ()
|
||||
*
|
||||
* DESCRIPTION: Initializes the Window Manager hints
|
||||
*
|
||||
* PARAMETERS:
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
procedure TWidgetTrayIcon.InitWM;
|
||||
var
|
||||
// set the class hint
|
||||
classhint: TXClassHint;
|
||||
hints: PXWMHints;
|
||||
begin
|
||||
classhint.res_name := pchar('TTrayIcon');
|
||||
classhint.res_class := pchar('TTrayIcon');
|
||||
|
||||
XSetClassHint(fDisplay, fWindowID, @classhint);
|
||||
|
||||
// set the Window Manager hints
|
||||
|
||||
hints := XGetWMHints(fDisplay, fWindowID); // init hints
|
||||
if Hints <> nil then begin
|
||||
hints^.flags := WindowGroupHint or IconWindowHint or StateHint; // set the window group hint
|
||||
hints^.window_group := fWindowID; // set the window hint
|
||||
hints^.initial_state := NormalState;//WithdrawnState; // initial state
|
||||
hints^.icon_window := fWindowID; // in WM, this should be winId() of separate widget
|
||||
hints^.icon_x := 0;
|
||||
hints^.icon_y := 0;
|
||||
XSetWMHints(fDisplay, fWindowID, hints); // set the window hints for WM to use.
|
||||
XFree( hints );
|
||||
end;
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* TWidgetTrayIcon.SetMinSize ()
|
||||
*
|
||||
* DESCRIPTION: Attemps to avoid problems on Gnome
|
||||
*
|
||||
* PARAMETERS:
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
procedure TWidgetTrayIcon.SetMinSize(AWidth, AHeight: Integer);
|
||||
var
|
||||
size_hints: TXSizeHints;
|
||||
begin
|
||||
FillChar(size_hints, SizeOf(TXSizeHints), $0);
|
||||
|
||||
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;
|
||||
|
||||
{*******************************************************************
|
||||
* TWidgetTrayIcon.AttachIcon ()
|
||||
*
|
||||
* DESCRIPTION: Attachs a icon to the Tray
|
||||
*
|
||||
* PARAMETERS:
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
function TWidgetTrayIcon.AttachIcon: TWindow;
|
||||
var
|
||||
buf: array [0..32] of char;
|
||||
selection_atom : TAtom;
|
||||
Manager_Window: TWindow;
|
||||
old_error: TXErrorHandler;
|
||||
data: array [0..3] of longint;
|
||||
begin
|
||||
old_error := XSetErrorHandler(@TempX11ErrorHandler);
|
||||
initWM;
|
||||
|
||||
fScreenID := XScreenNumberOfScreen(fScreen);
|
||||
buf := PChar('_NET_SYSTEM_TRAY_S' + IntToStr(fScreenID));
|
||||
|
||||
selection_atom := XInternAtom(fDisplay, buf, false);
|
||||
XGrabServer(fDisplay);
|
||||
Manager_Window := XGetSelectionOwner(fDisplay, selection_atom);
|
||||
if Manager_Window <> None then
|
||||
begin
|
||||
XSelectInput(fDisplay, Manager_Window, StructureNotifyMask);
|
||||
Result := Manager_Window;
|
||||
fTrayParent := Result;
|
||||
end;
|
||||
XUngrabServer(fDisplay);
|
||||
XFlush(fDisplay);
|
||||
data[0] := 34;
|
||||
data[1] := 34;
|
||||
data[2] := 34;
|
||||
data[3] := 34;
|
||||
|
||||
if ( manager_window <> None ) then
|
||||
send_message(Manager_Window, SYSTEM_TRAY_REQUEST_DOCK, fWindowID, 0, 0);
|
||||
SetMinSize(Icon.Width, Icon.Height);
|
||||
XChangeProperty(fDisplay, fWindowID, XInternAtom( fdisplay, '_NET_WM_ICON_GEOMETRY',False),
|
||||
TAtom(6), 32, PropModeReplace, @data, 4);
|
||||
// XResizeWindow(fDisplay, fWindowID, 22, 22);
|
||||
XSetErrorHandler(old_error);
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* TWidgetTrayIcon.GetCanvas ()
|
||||
*
|
||||
* DESCRIPTION:
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
function TWidgetTrayIcon.GetCanvas: TCanvas;
|
||||
begin
|
||||
Result := Icon.Canvas;
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* TWidgetTrayIcon.OnEventTimer ()
|
||||
*
|
||||
* DESCRIPTION: Processes X messages
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
procedure TWidgetTrayIcon.OnEventTimer(Sender: TObject);
|
||||
var
|
||||
ev: TXEvent;
|
||||
sShift: TShiftState;
|
||||
Btn: TMouseButton;
|
||||
BtnPressEv: PXButtonPressedEvent;
|
||||
BtnReleaseEv : PXButtonReleasedEvent;
|
||||
MouseMotionEv: PXMotionEvent;
|
||||
ResizeEv : PXResizeRequestEvent;
|
||||
ClientEv: PXClientMessageEvent;
|
||||
begin
|
||||
if (fDisplay = nil) then Exit;
|
||||
|
||||
while XCheckIfEvent(fDisplay, @ev, @ProcessEvent, nil) do
|
||||
begin
|
||||
sShift := [];
|
||||
|
||||
case ev._type of
|
||||
ButtonRelease:
|
||||
begin
|
||||
BtnReleaseEv := PXButtonReleasedEvent(@ev);
|
||||
case BtnReleaseEv^.button of
|
||||
1:
|
||||
begin
|
||||
if Assigned(OnClick) then OnClick(Self);
|
||||
if Assigned(OnMouseUp) then
|
||||
OnMouseUp(Self, mbLeft, [], Round(BtnReleaseEv^.X), Round(BtnReleaseEv^.Y));
|
||||
end;
|
||||
|
||||
2: if Assigned(OnMouseUp) then
|
||||
OnMouseUp(Self, mbMiddle, [], Round(BtnReleaseEv^.X), Round(BtnReleaseEv^.Y));
|
||||
|
||||
3:
|
||||
begin
|
||||
if Assigned(OnMouseUp) then
|
||||
OnMouseUp(Self, mbRight, [], Round(BtnReleaseEv^.X), Round(BtnReleaseEv^.Y));
|
||||
if Assigned(PopUpMenu) then
|
||||
PopUpMenu.PopUp(Mouse.CursorPos.X, Mouse.CursorPos.Y);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
ButtonPress:
|
||||
begin
|
||||
BtnPressEv := PXButtonPressedEvent(@ev);
|
||||
case BtnPressEv^.button of
|
||||
1: if Assigned(OnMouseDown) then
|
||||
OnMouseDown(Self, mbLeft, [], Round(BtnPressEv^.X), Round(BtnPressEv^.Y));
|
||||
|
||||
2: if Assigned(OnMouseDown) then
|
||||
OnMouseDown(Self, mbMiddle, [], Round(BtnPressEv^.X), Round(BtnPressEv^.Y));
|
||||
|
||||
3: if Assigned(OnMouseDown) then
|
||||
OnMouseDown(Self, mbRight, [], Round(BtnPressEv^.X), Round(BtnPressEv^.Y));
|
||||
end;
|
||||
end;
|
||||
Expose, GraphicsExpose, VisibilityNotify, VisibilityUnobscured, VisibilityPartiallyObscured:
|
||||
begin
|
||||
Repaint;
|
||||
end;
|
||||
{ EnterNotify:
|
||||
begin
|
||||
if Assigned(MouseEnter) then MouseEnter(Self);
|
||||
end;
|
||||
LeaveNotify:
|
||||
begin
|
||||
if Assigned(MouseLeave) then MouseLeave(Self);
|
||||
end;}
|
||||
MotionNotify:
|
||||
begin
|
||||
MouseMotionEv := PXMotionEvent(@ev);
|
||||
|
||||
if Button1Mask in [MouseMotionEv^.state] then sShift += [ssLeft];
|
||||
if Button2Mask in [MouseMotionEv^.state] then sShift += [ssMiddle];
|
||||
if Button3Mask in [MouseMotionEv^.state] then sShift += [ssRight];
|
||||
|
||||
if Assigned(OnMouseMove) then
|
||||
OnMouseMove(Self, sShift, Round(MouseMotionEv^.X), Round(MouseMotionEv^.Y));
|
||||
end;
|
||||
ResizeRequest:
|
||||
begin
|
||||
ResizeEv := PXResizeRequestEvent(@ev);
|
||||
fWidth := ResizeEv^.width;
|
||||
fHeight := ResizeEv^.height;
|
||||
|
||||
if fImage <> nil then
|
||||
begin
|
||||
XClearWindow(fDisplay,fWindowID);
|
||||
XFree(fImage);
|
||||
fImage := nil;
|
||||
end;
|
||||
|
||||
if vVisible then Repaint;
|
||||
end;
|
||||
CLientMessage:
|
||||
begin
|
||||
ClientEv := PXClientMessageEvent(@Ev);
|
||||
end;
|
||||
else
|
||||
// Writeln('Unprocessed X11 event for the tray icon: ', ev._type);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* TWidgetTrayIcon.RePaint ()
|
||||
*
|
||||
* DESCRIPTION: Paints the icon
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
procedure TWidgetTrayIcon.RePaint;
|
||||
|
||||
function SwapColor(Color: TColor): TColor;
|
||||
var
|
||||
fcolor: Array [0..3] of byte;
|
||||
tmp: byte;
|
||||
begin
|
||||
move(color, fcolor, sizeof(fcolor));
|
||||
tmp := fcolor[0];
|
||||
fcolor[0] := fcolor[2];
|
||||
fcolor[2] := tmp;
|
||||
result := TColor(fColor);
|
||||
end;
|
||||
|
||||
var
|
||||
bitmap_pad: integer;
|
||||
Pixel: TColor;
|
||||
x,y: Integer;
|
||||
fTop, fLeft: Integer;
|
||||
begin
|
||||
if (fImage = nil) then
|
||||
begin
|
||||
if fDepth > 16 then bitmap_pad := 32
|
||||
else if fDepth > 8 then bitmap_pad := 16
|
||||
else bitmap_pad := 8;
|
||||
fImage := XCreateImage(fDisplay, fVisual, fDepth, ZPixmap, 0, nil,
|
||||
34, 34, bitmap_pad, 0);
|
||||
fImage^.data := AllocMem(fImage^.bytes_per_line * fHeight * 4);
|
||||
fleft := 0;
|
||||
ftop := 0;
|
||||
if fWidth > Icon.Width then fLeft := (fWidth - Icon.Width) div 2;
|
||||
if fHeight > Icon.Height then fTop := (fHeight- Icon.Height) div 2;
|
||||
for Y := 0 to fHeight do
|
||||
begin
|
||||
for X := 0 to fwidth do
|
||||
begin
|
||||
// Causes an error in gdk_colormap_get_visual
|
||||
if (y-ftop > Icon.Height)
|
||||
or (x-fleft > Icon.Width)
|
||||
or (X < fLeft) or (X > fLeft + fWidth)
|
||||
or (Y < fTop) or (Y > fTop + fHeight)
|
||||
then
|
||||
pixel := SwapColor(Icon.TransparentColor)
|
||||
else
|
||||
pixel := SwapColor(Icon.Canvas.Pixels[x-fLeft, y-fTop]);
|
||||
|
||||
XPutPixel(fImage, X, Y, (pixel));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
XPutImage(fDisplay, fDrawable, gc, fImage, 0, 0, 0, 0, fWidth, fHeight);
|
||||
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
|
||||
Result := False;
|
||||
|
||||
if not vVisible then Exit;
|
||||
|
||||
fTimer.OnTimer := nil;
|
||||
fTimer.Enabled := False;
|
||||
fTimer.Free;
|
||||
|
||||
XFree(fImage);
|
||||
fImage := nil;
|
||||
|
||||
if fWindowID <> 0 then XDestroyWindow(fDisplay, fWindowID);
|
||||
fWindowID := 0;
|
||||
XFreeGC(fDisplay, gc);
|
||||
XCloseDisplay(fDisplay);
|
||||
fDisplay := nil;
|
||||
|
||||
vVisible := False;
|
||||
|
||||
Result := True;
|
||||
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
|
||||
Result := False;
|
||||
|
||||
if vVisible then Exit;
|
||||
|
||||
{ Timer to process messages }
|
||||
|
||||
fTimer := TTimer.Create(fOwner);
|
||||
fTimer.Interval := 10;
|
||||
fTimer.OnTimer := @OnEventTimer;
|
||||
fTimer.Enabled := True;
|
||||
|
||||
{ Painting code }
|
||||
|
||||
fWidth := 24;
|
||||
fHeight := 24;
|
||||
fImage := nil;
|
||||
|
||||
{ Creates the tray window }
|
||||
|
||||
SetEmbedded;
|
||||
|
||||
{ needed for gnome }
|
||||
|
||||
// SetMinSize(22, 22);
|
||||
|
||||
fEmbedded := True;
|
||||
|
||||
vVisible := True;
|
||||
|
||||
Result := True;
|
||||
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
|
||||
|
||||
end;
|
||||
|
||||
{*******************************************************************
|
||||
* TWidgetTrayIcon.GetPosition ()
|
||||
*
|
||||
* DESCRIPTION: Returns the position of the tray icon on the display.
|
||||
* This function is utilized to show message boxes near
|
||||
* the icon
|
||||
*
|
||||
* PARAMETERS: None
|
||||
*
|
||||
* RETURNS: Nothing
|
||||
*
|
||||
*******************************************************************}
|
||||
function TWidgetTrayIcon.GetPosition: TPoint;
|
||||
begin
|
||||
Result.X := 0;
|
||||
Result.Y := 0;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user