From a7bba2a00d5821494eb8a33f06947fa5594f82b7 Mon Sep 17 00:00:00 2001 From: vincents Date: Thu, 5 Jun 2008 07:45:39 +0000 Subject: [PATCH] trayicon example: fixed compilation with fpc 2.2.1 and higher on darwin git-svn-id: trunk@15313 - --- examples/trayicon/frmtest.pas | 363 +++++++++++++++++----------------- 1 file changed, 184 insertions(+), 179 deletions(-) diff --git a/examples/trayicon/frmtest.pas b/examples/trayicon/frmtest.pas index 0379d5fbde..3eb908c558 100644 --- a/examples/trayicon/frmtest.pas +++ b/examples/trayicon/frmtest.pas @@ -1,179 +1,184 @@ -{ - 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. - +{ + 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 +{$ifdef ver2_2_0} + FPCMacOSAll; +{$else} + MacOSAll; +{$endif} +{$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. +