{ 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.