mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-17 12:49:28 +02:00
Improves Carbon Cocoa TTrayIcon
git-svn-id: trunk@15459 -
This commit is contained in:
sekelsenmat
parent
fa264a54c1
commit
9bf58926c8
@ -1,67 +1,65 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<PathDelim Value="\"/>
|
||||
<Version Value="6"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<SaveClosedFiles Value="False"/>
|
||||
<SaveOnlyProjectUnits Value="True"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<IconPath Value=".\"/>
|
||||
<TargetFileExt Value=""/>
|
||||
</General>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<DestinationDirectory Value="$(TestDir)\publishedproject\"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="wndtray.dpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="wndtray"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="frmtest.pas"/>
|
||||
<ComponentName Value="frmTrayTest"/>
|
||||
<HasResources Value="True"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ResourceFilename Value="frmtest.lrs"/>
|
||||
<UnitName Value="frmtest"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="5"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<SrcPath Value="\Users\felipe\Programas\lazarus-ccr\bindings\objc\;\Users\felipe\Programas\lazarus-ccr\bindings\pascocoa\applicationservices\coregraphics\;\Users\felipe\Programas\lazarus-ccr\bindings\pascocoa\appkit\;\Users\felipe\Programas\lazarus-ccr\bindings\pascocoa\foundation\"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<Generate Value="Faster"/>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Options>
|
||||
<LinkerOptions Value="-framework Qt4Intf -framework carbon -lobjc"/>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</CONFIG>
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<PathDelim Value="/"/>
|
||||
<Version Value="6"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<SaveClosedFiles Value="False"/>
|
||||
<SaveOnlyProjectUnits Value="True"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<IconPath Value="./"/>
|
||||
<TargetFileExt Value=""/>
|
||||
</General>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="wndtray.dpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="wndtray"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="frmtest.pas"/>
|
||||
<ComponentName Value="frmTrayTest"/>
|
||||
<HasResources Value="True"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ResourceFilename Value="frmtest.lrs"/>
|
||||
<UnitName Value="frmtest"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="5"/>
|
||||
<SearchPaths>
|
||||
<SrcPath Value="/Users/felipe/Programas/lazarus-ccr/bindings/objc/;/Users/felipe/Programas/lazarus-ccr/bindings/pascocoa/applicationservices/coregraphics/;/Users/felipe/Programas/lazarus-ccr/bindings/pascocoa/appkit/;/Users/felipe/Programas/lazarus-ccr/bindings/pascocoa/foundation/"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<Generate Value="Faster"/>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Options>
|
||||
<LinkerOptions Value="-framework Cocoa -lobjc"/>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
</CONFIG>
|
||||
|
||||
@ -2,17 +2,108 @@
|
||||
|
||||
{$ifdef CarbonUseCocoa}
|
||||
|
||||
{ TCarbonWSCustomTrayIcon }
|
||||
{$STATIC ON}
|
||||
|
||||
type
|
||||
TPrivateCocoaCarbonTrayIcon = class(TObject)
|
||||
|
||||
{ TPrivateCocoaCarbonTrayIcon }
|
||||
|
||||
TPrivateCocoaCarbonTrayIcon = class(NSObject)
|
||||
public
|
||||
{ Fields }
|
||||
bar: NSStatusBar;
|
||||
item: NSStatusItem;
|
||||
image: NSImage;
|
||||
menu: NSMenu;
|
||||
MenuItems: array of NSMenuItem;
|
||||
{ Structural Methods }
|
||||
constructor Create; override;
|
||||
class function getClass: objc.id; override;
|
||||
procedure AddMethods; override;
|
||||
{ Pascal Methods }
|
||||
function CreateMenu(APopUpMenu: TPopUpMenu): NSMenu;
|
||||
function CreateMenuItem(ATitle: shortstring;
|
||||
ACallbackName: string; ACallbackClass: NSObject): NSMenuItem;
|
||||
{ Objective-C compatible methods }
|
||||
class procedure HandleMenuItemClick(_self: objc.id; _cmd: SEL; sender: objc.id); cdecl; static;
|
||||
end;
|
||||
|
||||
const
|
||||
Str_TPrivateCocoaCarbonTrayIcon = 'TPrivateCocoaCarbonTrayIcon';
|
||||
|
||||
Str_HandleMenuItemClick = 'HandleMenuItemClick';
|
||||
|
||||
{ TPrivateCocoaCarbonTrayIcon }
|
||||
|
||||
{@@
|
||||
Adds methods to the class
|
||||
|
||||
Details of the parameters string:
|
||||
|
||||
The first parameter is the result (v = void),
|
||||
followed by self and _cmd (@ = id and : = SEL),
|
||||
and on the end "sender" (@ = id)
|
||||
}
|
||||
procedure TPrivateCocoaCarbonTrayIcon.AddMethods;
|
||||
begin
|
||||
// AddMethod(Str_HandleMenuItemClick, 'v@:@', Pointer(HandleMenuItemClick));
|
||||
end;
|
||||
|
||||
constructor TPrivateCocoaCarbonTrayIcon.Create;
|
||||
var
|
||||
fileName: CFStringRef;
|
||||
begin
|
||||
{ The class is registered on the Objective-C runtime before the NSObject constructor is called }
|
||||
if not CreateClassDefinition(Str_TPrivateCocoaCarbonTrayIcon, Str_NSObject) then WriteLn('Failed to create objc class');
|
||||
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
class function TPrivateCocoaCarbonTrayIcon.getClass: objc.id;
|
||||
begin
|
||||
Result := objc_getClass(Str_NSObject);
|
||||
end;
|
||||
|
||||
{ Creates a NSMenu structure representing a TPopUpMenu }
|
||||
function TPrivateCocoaCarbonTrayIcon.CreateMenu(APopUpMenu: TPopUpMenu): NSMenu;
|
||||
var
|
||||
MenuTitle: CFStringRef;
|
||||
i: Integer;
|
||||
begin
|
||||
MenuTitle := CFStringCreateWithPascalString(nil, '', kCFStringEncodingUTF8);
|
||||
Result := NSMenu.initWithTitle(MenuTitle);
|
||||
|
||||
for i := 0 to APopUpMenu.Items.Count - 1 do
|
||||
begin
|
||||
SetLength(MenuItems, i + 1);
|
||||
MenuItems[i] := CreateMenuItem(APopUpMenu.Items[i].Caption, Str_HandleMenuItemClick, Self);
|
||||
Result.addItem(MenuItems[i].Handle);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPrivateCocoaCarbonTrayIcon.CreateMenuItem(ATitle: shortstring;
|
||||
ACallbackName: string; ACallbackClass: NSObject): NSMenuItem;
|
||||
var
|
||||
ItemText: CFStringRef;
|
||||
KeyText: CFStringRef;
|
||||
begin
|
||||
KeyText := CFStringCreateWithPascalString(nil, '', kCFStringEncodingUTF8);
|
||||
ItemText := CFStringCreateWithPascalString(nil, ATitle, kCFStringEncodingUTF8);
|
||||
WriteLn(' ItemText: ', IntToHex(Int64(ItemText), 8), ' ATitle: ', ATitle);
|
||||
|
||||
Result := NSMenuItem.initWithTitle_action_keyEquivalent(ItemText, nil, KeyText);
|
||||
Result.setTarget(ACallbackClass.Handle);
|
||||
Result.setAction(sel_registerName(PChar(ACallbackName)));
|
||||
end;
|
||||
|
||||
class procedure TPrivateCocoaCarbonTrayIcon.HandleMenuItemClick(_self: objc.id;
|
||||
_cmd: SEL; sender: objc.id); cdecl;
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
{ TCarbonWSCustomTrayIcon }
|
||||
|
||||
class function TCarbonWSCustomTrayIcon.Hide(const ATrayIcon: TCustomTrayIcon): Boolean;
|
||||
var
|
||||
APrivateTrayIcon: TPrivateCocoaCarbonTrayIcon;
|
||||
@ -78,13 +169,6 @@ begin
|
||||
{$endif VerboseCarbonTrayIcon}
|
||||
APrivateTrayIcon.image.unlockFocus;
|
||||
|
||||
{ Inserts the menu }
|
||||
|
||||
if ATrayIcon.PopUpMenu <> nil then
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
{ Shows the icon }
|
||||
|
||||
if APrivateTrayIcon.item <> nil then Exit(True);
|
||||
@ -93,6 +177,14 @@ begin
|
||||
APrivateTrayIcon.item.retain();
|
||||
APrivateTrayIcon.item.setImage(APrivateTrayIcon.image.Handle);
|
||||
|
||||
{ Inserts the menu }
|
||||
|
||||
if ATrayIcon.PopUpMenu <> nil then
|
||||
begin
|
||||
APrivateTrayIcon.menu := APrivateTrayIcon.CreateMenu(ATrayIcon.PopUpMenu);
|
||||
APrivateTrayIcon.item.setMenu(APrivateTrayIcon.menu.Handle);
|
||||
end;
|
||||
|
||||
Result := True;
|
||||
|
||||
{$ifdef VerboseCarbonTrayIcon}
|
||||
|
||||
@ -22,7 +22,7 @@
|
||||
}
|
||||
unit CarbonWSExtCtrls;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
{$mode delphi}
|
||||
|
||||
interface
|
||||
|
||||
@ -42,6 +42,7 @@ uses
|
||||
{$endif CarbonUseCocoa}
|
||||
// LCL
|
||||
Classes, Controls, ExtCtrls, LCLType, LCLProc, Graphics, Math, SysUtils,
|
||||
Menus,
|
||||
// widgetset
|
||||
WSExtCtrls, WSLCLClasses, WSControls, WSProc,
|
||||
// LCL Carbon
|
||||
|
||||
@ -328,6 +328,7 @@ var
|
||||
CocoaButton: TCocoaButton;
|
||||
begin
|
||||
CocoaButton := TCocoaButton.Create(AWinControl, AParams);
|
||||
CocoaButton.Handle.setButtonType(NSSwitchButton);
|
||||
|
||||
Result := TLCLIntfHandle(CocoaButton);
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user