mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-17 22:09:28 +02:00
Improves the TTrayIcon example
git-svn-id: trunk@15174 -
This commit is contained in:
sekelsenmat
parent
0c3416a0e8
commit
c5ae780008
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -1879,7 +1879,6 @@ examples/trayicon/icon.ico -text
|
||||
examples/trayicon/magnifier.res -text
|
||||
examples/trayicon/wndtray.dpr -text
|
||||
examples/trayicon/wndtray.lpi -text
|
||||
examples/trayicon/wndtray.lps -text
|
||||
examples/treeview/README.txt svneol=native#text/plain
|
||||
examples/treeview/TV_Add_Remove.dpr svneol=native#text/pascal
|
||||
examples/treeview/TV_Add_Remove.res svneol=native#unset
|
||||
|
||||
@ -1,56 +1,57 @@
|
||||
object Form1: TForm1
|
||||
object frmTrayTest: TfrmTrayTest
|
||||
Left = 290
|
||||
Height = 300
|
||||
Height = 249
|
||||
Top = 175
|
||||
Width = 400
|
||||
HorzScrollBar.Page = 399
|
||||
VertScrollBar.Page = 299
|
||||
ActiveControl = Button1
|
||||
Caption = 'Form1'
|
||||
ClientHeight = 300
|
||||
ClientWidth = 400
|
||||
Width = 393
|
||||
HorzScrollBar.Page = 392
|
||||
VertScrollBar.Page = 248
|
||||
ActiveControl = btnShow
|
||||
Caption = 'TTrayIcon test application'
|
||||
ClientHeight = 249
|
||||
ClientWidth = 393
|
||||
OnCreate = FormCreate
|
||||
object Button1: TButton
|
||||
Left = 56
|
||||
LCLVersion = '0.9.25'
|
||||
object btnShow: TButton
|
||||
Left = 32
|
||||
Height = 33
|
||||
Top = 56
|
||||
Width = 94
|
||||
Top = 32
|
||||
Width = 136
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Show'
|
||||
OnClick = Button1Click
|
||||
OnClick = btnShowClick
|
||||
TabOrder = 0
|
||||
end
|
||||
object Button2: TButton
|
||||
Left = 56
|
||||
object btnHide: TButton
|
||||
Left = 32
|
||||
Height = 33
|
||||
Top = 112
|
||||
Width = 94
|
||||
Top = 88
|
||||
Width = 136
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Hide'
|
||||
OnClick = Button2Click
|
||||
OnClick = btnHideClick
|
||||
TabOrder = 1
|
||||
end
|
||||
object Button3: TButton
|
||||
Left = 224
|
||||
object btnPaintTest: TButton
|
||||
Left = 216
|
||||
Height = 33
|
||||
Top = 56
|
||||
Width = 94
|
||||
Top = 32
|
||||
Width = 136
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Paint Test'
|
||||
OnClick = Button3Click
|
||||
OnClick = btnPaintTestClick
|
||||
TabOrder = 2
|
||||
end
|
||||
object Button4: TButton
|
||||
Left = 56
|
||||
Height = 32
|
||||
Top = 168
|
||||
Width = 94
|
||||
object btnDisplayMessage: TButton
|
||||
Left = 216
|
||||
Height = 33
|
||||
Top = 88
|
||||
Width = 136
|
||||
Caption = 'Display Message'
|
||||
TabOrder = 3
|
||||
end
|
||||
object PopupMenu: TPopupMenu
|
||||
left = 180
|
||||
top = 260
|
||||
left = 136
|
||||
top = 184
|
||||
object MenuItem1: TMenuItem
|
||||
Caption = 'New Item1'
|
||||
end
|
||||
@ -62,7 +63,7 @@ object Form1: TForm1
|
||||
end
|
||||
end
|
||||
object SystrayIcon: TTrayIcon
|
||||
left = 221
|
||||
top = 145
|
||||
left = 181
|
||||
top = 184
|
||||
end
|
||||
end
|
||||
|
||||
@ -1,21 +1,22 @@
|
||||
{ This is an automatically generated lazarus resource file }
|
||||
|
||||
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#7
|
||||
+'TButton'#7'Button4'#4'Left'#2'8'#6'Height'#2' '#3'Top'#3#168#0#5'Width'#2'^'
|
||||
+#7'Caption'#6#15'Display Message'#8'TabOrder'#2#3#0#0#10'TPopupMenu'#9'Popup'
|
||||
+'Menu'#4'left'#3#180#0#3'top'#3#4#1#0#9'TMenuItem'#9'MenuItem1'#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#9'TTrayIcon'#11'Sys'
|
||||
+'trayIcon'#4'left'#3#221#0#3'top'#3#145#0#0#0#0
|
||||
]);
|
||||
|
||||
LazarusResources.Add('TfrmTrayTest','FORMDATA',[
|
||||
'TPF0'#12'TfrmTrayTest'#11'frmTrayTest'#4'Left'#3'"'#1#6'Height'#3#249#0#3'To'
|
||||
+'p'#3#175#0#5'Width'#3#137#1#18'HorzScrollBar.Page'#3#136#1#18'VertScrollBar'
|
||||
+'.Page'#3#248#0#13'ActiveControl'#7#7'btnShow'#7'Caption'#6#26'TTrayIcon tes'
|
||||
+'t application'#12'ClientHeight'#3#249#0#11'ClientWidth'#3#137#1#8'OnCreate'
|
||||
+#7#10'FormCreate'#10'LCLVersion'#6#6'0.9.25'#0#7'TButton'#7'btnShow'#4'Left'
|
||||
+#2' '#6'Height'#2'!'#3'Top'#2' '#5'Width'#3#136#0#25'BorderSpacing.InnerBord'
|
||||
+'er'#2#4#7'Caption'#6#4'Show'#7'OnClick'#7#12'btnShowClick'#8'TabOrder'#2#0#0
|
||||
+#0#7'TButton'#7'btnHide'#4'Left'#2' '#6'Height'#2'!'#3'Top'#2'X'#5'Width'#3
|
||||
+#136#0#25'BorderSpacing.InnerBorder'#2#4#7'Caption'#6#4'Hide'#7'OnClick'#7#12
|
||||
+'btnHideClick'#8'TabOrder'#2#1#0#0#7'TButton'#12'btnPaintTest'#4'Left'#3#216
|
||||
+#0#6'Height'#2'!'#3'Top'#2' '#5'Width'#3#136#0#25'BorderSpacing.InnerBorder'
|
||||
+#2#4#7'Caption'#6#10'Paint Test'#7'OnClick'#7#17'btnPaintTestClick'#8'TabOrd'
|
||||
+'er'#2#2#0#0#7'TButton'#17'btnDisplayMessage'#4'Left'#3#216#0#6'Height'#2'!'
|
||||
+#3'Top'#2'X'#5'Width'#3#136#0#7'Caption'#6#15'Display Message'#8'TabOrder'#2
|
||||
+#3#0#0#10'TPopupMenu'#9'PopupMenu'#4'left'#3#136#0#3'top'#3#184#0#0#9'TMenuI'
|
||||
+'tem'#9'MenuItem1'#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 It'
|
||||
+'em2'#0#0#0#9'TTrayIcon'#11'SystrayIcon'#4'left'#3#181#0#3'top'#3#184#0#0#0#0
|
||||
]);
|
||||
|
||||
@ -1,174 +1,179 @@
|
||||
{
|
||||
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,
|
||||
ExtCtrls;
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
Button1: TButton;
|
||||
Button2: TButton;
|
||||
Button3: TButton;
|
||||
Button4: TButton;
|
||||
MenuItem1: TMenuItem;
|
||||
MenuItem2: TMenuItem;
|
||||
MenuItem3: TMenuItem;
|
||||
PopupMenu: TPopupMenu;
|
||||
SystrayIcon: TTrayIcon;
|
||||
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.Visible := True;
|
||||
end;
|
||||
|
||||
procedure TForm1.Button2Click(Sender: TObject);
|
||||
begin
|
||||
SystrayIcon.Visible := False;
|
||||
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;
|
||||
{$IFDEF FPC}
|
||||
SecondImage.Canvas.Draw(0, 0, MyImage);
|
||||
{$ENDIF}
|
||||
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.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');
|
||||
{$IFDEF FPC}
|
||||
SystrayIcon.Canvas.Draw(0, 0, MyImage);
|
||||
{$ENDIF}
|
||||
MyImage.Free;
|
||||
WriteLn('Paint');
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$ifdef fpc}
|
||||
{$I frmtest.lrs}
|
||||
{$endif}
|
||||
|
||||
end.
|
||||
|
||||
{
|
||||
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,
|
||||
ExtCtrls;
|
||||
|
||||
type
|
||||
|
||||
{ TfrmTrayTest }
|
||||
|
||||
TfrmTrayTest = class(TForm)
|
||||
btnShow: TButton;
|
||||
btnHide: TButton;
|
||||
btnPaintTest: TButton;
|
||||
btnDisplayMessage: TButton;
|
||||
MenuItem1: TMenuItem;
|
||||
MenuItem2: TMenuItem;
|
||||
MenuItem3: TMenuItem;
|
||||
PopupMenu: TPopupMenu;
|
||||
SystrayIcon: TTrayIcon;
|
||||
procedure btnShowClick(Sender: TObject);
|
||||
procedure btnHideClick(Sender: TObject);
|
||||
procedure btnPaintTestClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure HandleClick(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
pathMedia: string;
|
||||
procedure DoPaint(Sender: TObject);
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
frmTrayTest: TfrmTrayTest;
|
||||
|
||||
{$ifndef fpc}
|
||||
{$R frmtest.dfm}
|
||||
{$endif}
|
||||
|
||||
implementation
|
||||
|
||||
{$ifdef Windows}
|
||||
uses Windows;
|
||||
{$endif}
|
||||
{$IFDEF Darwin}
|
||||
uses FPCMacOSAll;
|
||||
{$ENDIF}
|
||||
|
||||
{ TfrmTrayTest }
|
||||
|
||||
procedure TfrmTrayTest.btnShowClick(Sender: TObject);
|
||||
begin
|
||||
SystrayIcon.Visible := True;
|
||||
end;
|
||||
|
||||
procedure TfrmTrayTest.btnHideClick(Sender: TObject);
|
||||
begin
|
||||
SystrayIcon.Visible := False;
|
||||
end;
|
||||
|
||||
procedure TfrmTrayTest.btnPaintTestClick(Sender: TObject);
|
||||
var
|
||||
MyImage, SecondImage: TIcon;
|
||||
begin
|
||||
MyImage := TIcon.Create;
|
||||
SecondImage := TIcon.Create;
|
||||
|
||||
try
|
||||
MyImage.LoadFromFile(pathMedia + 'icon.ico');
|
||||
SecondImage.Height := 22;
|
||||
SecondImage.Width := 22;
|
||||
{$IFDEF FPC}
|
||||
SecondImage.Canvas.Draw(0, 0, MyImage);
|
||||
{$ENDIF}
|
||||
Canvas.Draw(0, 0, SecondImage);
|
||||
finally
|
||||
SecondImage.Free;
|
||||
MyImage.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfrmTrayTest.FormCreate(Sender: TObject);
|
||||
const
|
||||
IDI_ICON1 = 101;
|
||||
IDI_ICON2 = 115;
|
||||
BundleResourceFolder = '/Contents/Resources/';
|
||||
var
|
||||
{$IFDEF Darwin}
|
||||
pathRef: CFURLRef;
|
||||
pathCFStr: CFStringRef;
|
||||
pathStr: shortstring;
|
||||
{$ENDIF}
|
||||
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.Hint := 'my tool tip';
|
||||
|
||||
SystrayIcon.OnClick := HandleClick;
|
||||
|
||||
// SystrayIcon.OnPaint := DoPaint;
|
||||
|
||||
SystrayIcon.PopUpMenu := PopupMenu;
|
||||
end;
|
||||
|
||||
procedure TfrmTrayTest.HandleClick(Sender: TObject);
|
||||
begin
|
||||
Application.MessageBox('Text', 'Caption', 0);
|
||||
end;
|
||||
|
||||
procedure TfrmTrayTest.DoPaint(Sender: TObject);
|
||||
var
|
||||
MyImage: TIcon;
|
||||
begin
|
||||
MyImage := TIcon.Create;
|
||||
try
|
||||
MyImage.LoadFromFile(pathMedia + 'icon.ico');
|
||||
{$IFDEF FPC}
|
||||
SystrayIcon.Canvas.Draw(0, 0, MyImage);
|
||||
{$ENDIF}
|
||||
finally
|
||||
MyImage.Free;
|
||||
end;
|
||||
WriteLn('Paint');
|
||||
end;
|
||||
|
||||
initialization
|
||||
{$ifdef fpc}
|
||||
{$I frmtest.lrs}
|
||||
{$endif}
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -34,8 +34,8 @@ uses
|
||||
{$endif}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TfrmTrayTest, frmTrayTest);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
|
||||
@ -37,7 +37,7 @@
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="frmtest.pas"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<ComponentName Value="frmTrayTest"/>
|
||||
<HasResources Value="True"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
|
||||
@ -1,38 +0,0 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectSession>
|
||||
<PathDelim Value="/"/>
|
||||
<Version Value="6"/>
|
||||
<Units Count="3">
|
||||
<Unit0>
|
||||
<Filename Value="wndtray.dpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="wndtray"/>
|
||||
<UsageCount Value="23"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="frmtest.pas"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<ResourceFilename Value="frmtest.lrs"/>
|
||||
<UnitName Value="frmtest"/>
|
||||
<CursorPos X="69" Y="67"/>
|
||||
<TopLine Value="126"/>
|
||||
<EditorIndex Value="0"/>
|
||||
<UsageCount Value="23"/>
|
||||
<Loaded Value="True"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="wscommontrayicon.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="wscommontrayicon"/>
|
||||
<UsageCount Value="23"/>
|
||||
</Unit2>
|
||||
</Units>
|
||||
<General>
|
||||
<ActiveEditorIndexAtStart Value="0"/>
|
||||
</General>
|
||||
</ProjectSession>
|
||||
</CONFIG>
|
||||
@ -31,6 +31,9 @@ end;
|
||||
class function TCarbonWSCustomTrayIcon.Show(const ATrayIcon: TCustomTrayIcon): Boolean;
|
||||
var
|
||||
APrivateTrayIcon: TPrivateCocoaCarbonTrayIcon;
|
||||
ASize: NSSize;
|
||||
ACGSize: CGRect absolute ASize;
|
||||
AcurrentContext: NSGraphicsContext;
|
||||
begin
|
||||
Result := False;
|
||||
|
||||
@ -50,11 +53,18 @@ begin
|
||||
graphicsPort], *(CGRect*)&rect, imageRef);
|
||||
[image unlockFocus];}
|
||||
|
||||
// APrivateTrayIcon.image := NSImage.initWithSize_rect_size
|
||||
ASize.width := TCarbonBitmap(ATrayIcon.Icon.Handle).Width;
|
||||
ASize.height := TCarbonBitmap(ATrayIcon.Icon.Handle).Height;
|
||||
|
||||
APrivateTrayIcon.image := NSImage.initWithSize(ASize);
|
||||
APrivateTrayIcon.image.lockFocus;
|
||||
AcurrentContext := NSGraphicsContext.currentContext();
|
||||
CGContextDrawImage(AcurrentContext.graphicsPort, ACGSize, TCarbonBitmap(ATrayIcon.Icon.Handle).CGImage);
|
||||
APrivateTrayIcon.image.unlockFocus;
|
||||
|
||||
{ Shows the icon }
|
||||
|
||||
if APrivateTrayIcon.item <> nil then Exit;
|
||||
if APrivateTrayIcon.item <> nil then Exit(True);
|
||||
|
||||
APrivateTrayIcon.item := APrivateTrayIcon.bar.statusItemWithLength(NSSquareStatusItemLength);
|
||||
APrivateTrayIcon.item.retain();
|
||||
|
||||
@ -41,7 +41,7 @@ uses
|
||||
// widgetset
|
||||
WSExtCtrls, WSLCLClasses, WSControls, WSProc,
|
||||
// LCL Carbon
|
||||
CarbonWSControls;
|
||||
carbongdiobjects, CarbonWSControls;
|
||||
|
||||
type
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user