mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-09 02:55:54 +02:00
trayicon example: fixed compilation with fpc 2.2.1 and higher on darwin
git-svn-id: trunk@15313 -
This commit is contained in:
vincents
parent
f2c437b0e5
commit
a7bba2a00d
@ -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.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user