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