/examples/trayicon/frmtest.pas

  1{
  2 frmtest.dpr
  3
  4 *****************************************************************************
  5 *                                                                           *
  6 *  This demonstration program is public domain, which means no copyright,   *
  7 * but also no warranty!                                                     *
  8 *                                                                           *
  9 *  This program is distributed in the hope that it will be useful,          *
 10 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 11 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 12 *                                                                           *
 13 *****************************************************************************
 14
 15 Author: Felipe Monteiro de Carvalho
 16}
 17unit frmtest;
 18
 19{$ifdef fpc}
 20  {$mode delphi}{$H+}
 21{$endif}
 22
 23interface
 24
 25uses
 26  Classes, SysUtils,
 27{$ifdef fpc}
 28  LResources,
 29{$endif}
 30  Forms, Controls, Graphics, Dialogs, Buttons, StdCtrls, Menus,
 31  ExtCtrls;
 32
 33type
 34
 35  { TfrmTrayTest }
 36
 37  TfrmTrayTest = class(TForm)
 38    btnShow: TButton;
 39    btnHide: TButton;
 40    btnDisplayMessage: TButton;
 41    chkOnPaintDrawing: TCheckBox;
 42    MenuItem1: TMenuItem;
 43    MenuItem2: TMenuItem;
 44    MenuItem3: TMenuItem;
 45    PopupMenu: TPopupMenu;
 46    SystrayIcon: TTrayIcon;
 47    procedure btnShowClick(Sender: TObject);
 48    procedure btnHideClick(Sender: TObject);
 49    procedure chkOnPaintDrawingChange(Sender: TObject);
 50    procedure FormCreate(Sender: TObject);
 51    procedure FormPaint(Sender: TObject);
 52    procedure HandleClick(Sender: TObject);
 53  private
 54    { private declarations }
 55    pathMedia: string;
 56  public
 57    { public declarations }
 58  end;
 59
 60var
 61  frmTrayTest: TfrmTrayTest;
 62
 63implementation
 64
 65{$ifdef fpc}
 66  {$R frmtest.lfm}
 67{$else}
 68  {$R frmtest.dfm}
 69{$endif}
 70
 71{$ifdef Windows}
 72uses Windows;
 73{$endif}
 74{$IFDEF Darwin}
 75uses
 76  MacOSAll;
 77{$ENDIF}
 78
 79{ TfrmTrayTest }
 80
 81procedure TfrmTrayTest.btnShowClick(Sender: TObject);
 82begin
 83  SystrayIcon.Visible := True;
 84end;
 85
 86procedure TfrmTrayTest.btnHideClick(Sender: TObject);
 87begin
 88  SystrayIcon.Visible := False;
 89end;
 90
 91procedure TfrmTrayTest.chkOnPaintDrawingChange(Sender: TObject);
 92begin
 93  Invalidate;
 94end;
 95
 96procedure TfrmTrayTest.FormCreate(Sender: TObject);
 97const
 98  IDI_ICON1         = 101;
 99  IDI_ICON2         = 115;
100  BundleResourceFolder = '/Contents/Resources/';
101{$IFDEF Darwin}
102var
103  pathRef: CFURLRef;
104  pathCFStr: CFStringRef;
105  pathStr: shortstring;
106{$ENDIF}
107begin
108  pathMedia := '';
109
110  // Under Mac OS X we need to get the location of the bundle
111{$IFDEF Darwin}
112  pathRef := CFBundleCopyBundleURL(CFBundleGetMainBundle());
113  pathCFStr := CFURLCopyFileSystemPath(pathRef, kCFURLPOSIXPathStyle);
114  CFStringGetPascalString(pathCFStr, @pathStr, 255, CFStringGetSystemEncoding());
115  CFRelease(pathRef);
116  CFRelease(pathCFStr);
117
118  pathMedia := pathStr + BundleResourceFolder;
119{$ENDIF}
120
121  // Under Windows we get the path of the executable
122{$IFDEF Windows}
123  pathMedia := ExtractFilePath(Application.ExeName);
124{$ENDIF}
125
126  IncludeTrailingBackslash(pathMedia);
127
128  SystrayIcon.Hint := 'my tool tip';
129
130  SystrayIcon.OnClick := HandleClick;
131
132  SystrayIcon.PopUpMenu := PopupMenu;
133end;
134
135procedure TfrmTrayTest.FormPaint(Sender: TObject);
136var
137  BaseImage: TIcon;
138begin
139  if chkOnPaintDrawing.Checked then
140  begin
141    BaseImage := TIcon.Create;
142    try
143      // Loads the icon
144      BaseImage.LoadFromFile(pathMedia + 'icon.ico');
145      Canvas.Draw(0, 0, BaseImage);
146    finally
147      BaseImage.Free;
148    end;
149  end;
150end;
151
152procedure TfrmTrayTest.HandleClick(Sender: TObject);
153begin
154  Application.MessageBox('Text', 'Caption', 0);
155end;
156
157end.
158