Improves the TTrayIcon example

git-svn-id: trunk@15174 -
2025-11-04 13:29:26 +01:00 · 2008-05-18 12:05:10 +00:00 · 2008-05-18 12:05:10 +00:00 · c5ae780008
commit c5ae780008
parent 0c3416a0e8
9 changed files with 250 additions and 272 deletions
--- a/.gitattributes
+++ b/.gitattributes
@ -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
--- a/examples/trayicon/frmtest.lfm
+++ b/examples/trayicon/frmtest.lfm
@ -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
--- a/examples/trayicon/frmtest.lrs
+++ b/examples/trayicon/frmtest.lrs
@ -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
 ]);
--- a/examples/trayicon/frmtest.pas
+++ b/examples/trayicon/frmtest.pas
@ -32,32 +32,33 @@ uses

 type

-  { TForm1 }
+  { TfrmTrayTest }

-  TForm1 = class(TForm)
-    Button1: TButton;
-    Button2: TButton;
-    Button3: TButton;
-    Button4: TButton;
+  TfrmTrayTest = class(TForm)
+    btnShow: TButton;
+    btnHide: TButton;
+    btnPaintTest: TButton;
+    btnDisplayMessage: TButton;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    PopupMenu: TPopupMenu;
    SystrayIcon: TTrayIcon;
-    procedure Button1Click(Sender: TObject);
-    procedure Button2Click(Sender: TObject);
-    procedure Button3Click(Sender: TObject);
+    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
-  Form1: TForm1;
+  frmTrayTest: TfrmTrayTest;

 {$ifndef fpc}
  {$R frmtest.dfm}
@ -72,38 +73,40 @@ uses Windows;
 uses FPCMacOSAll;
 {$ENDIF}

-{ TForm1 }
+{ TfrmTrayTest }

-procedure TForm1.Button1Click(Sender: TObject);
+procedure TfrmTrayTest.btnShowClick(Sender: TObject);
 begin
  SystrayIcon.Visible := True;
 end;

-procedure TForm1.Button2Click(Sender: TObject);
+procedure TfrmTrayTest.btnHideClick(Sender: TObject);
 begin
  SystrayIcon.Visible := False;
 end;

-procedure TForm1.Button3Click(Sender: TObject);
+procedure TfrmTrayTest.btnPaintTestClick(Sender: TObject);
 var
  MyImage, SecondImage: TIcon;
 begin
  MyImage := TIcon.Create;
  SecondImage := TIcon.Create;

-  MyImage.LoadFromFile('icon.ico');
+  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 TForm1.FormCreate(Sender: TObject);
+procedure TfrmTrayTest.FormCreate(Sender: TObject);
 const
  IDI_ICON1         = 101;
  IDI_ICON2         = 115;
@ -114,7 +117,6 @@ var
  pathCFStr: CFStringRef;
  pathStr: shortstring;
 {$ENDIF}
-  pathMedia: string;
 begin
  pathMedia := '';

@ -147,21 +149,24 @@ begin
  SystrayIcon.PopUpMenu := PopupMenu;
 end;

-procedure TForm1.HandleClick(Sender: TObject);
+procedure TfrmTrayTest.HandleClick(Sender: TObject);
 begin
  Application.MessageBox('Text', 'Caption', 0);
 end;

-procedure TForm1.DoPaint(Sender: TObject);
+procedure TfrmTrayTest.DoPaint(Sender: TObject);
 var
  MyImage: TIcon;
 begin
  MyImage := TIcon.Create;
-  MyImage.LoadFromFile('icon.ico');
+  try
+    MyImage.LoadFromFile(pathMedia + 'icon.ico');
    {$IFDEF FPC}
    SystrayIcon.Canvas.Draw(0, 0, MyImage);
    {$ENDIF}
+  finally
    MyImage.Free;
+  end;
  WriteLn('Paint');
 end;

--- a/examples/trayicon/wndtray.dpr
+++ b/examples/trayicon/wndtray.dpr
@ -35,7 +35,7 @@ uses

 begin
  Application.Initialize;
-  Application.CreateForm(TForm1, Form1);
+  Application.CreateForm(TfrmTrayTest, frmTrayTest);
  Application.Run;
 end.

--- a/examples/trayicon/wndtray.lpi
+++ b/examples/trayicon/wndtray.lpi
@ -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"/>
--- a/examples/trayicon/wndtray.lps
+++ b/examples/trayicon/wndtray.lps
@ -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>
--- a/lcl/interfaces/carbon/carbontrayicon.inc
+++ b/lcl/interfaces/carbon/carbontrayicon.inc
@ -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();
--- a/lcl/interfaces/carbon/carbonwsextctrls.pp
+++ b/lcl/interfaces/carbon/carbonwsextctrls.pp
@ -41,7 +41,7 @@ uses
  // widgetset
  WSExtCtrls, WSLCLClasses, WSControls, WSProc,
  // LCL Carbon
-  CarbonWSControls;
+  carbongdiobjects, CarbonWSControls;

 type