macosext/macosappmenu.pas at master · skalogryz/macosext · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
unit MacOSAppMenu;

{$mode delphi}{$H+}
{$ifdef LCLCocoa}{$modeswitch objectivec2}{$endif}

interface

uses
  {$ifdef LCLCocoa}
  CocoaAll,
  {$endif}
  Classes, SysUtils, LCLClasses, Menus, Forms;

type

  { TMacOSAppMenu }

  TMacOSAppMenu = class(TLCLComponent)
  private
    fAboutMenuItem   : TMenuItem;
    fAboutInstalled  : Boolean;
    fExitMenuItem    : TMenuItem;
    fPrefMenuItem    : TMenuItem;
    procedure SetAboutMenuItem(AValue: TMenuItem);
    procedure SetExitMenuItem(AValue: TMenuItem);
    procedure SetPrefMenuItem(AValue: TMenuItem);
  protected
    procedure UpdateMenu;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property AboutMenuItem: TMenuItem read fAboutMenuItem write SetAboutMenuItem;
    property PreferncesMenuItem: TMenuItem read fPrefMenuItem write SetPrefMenuItem;
    property ExitMenuItem: TMenuItem read fExitMenuItem write SetExitMenuItem;
  end;

implementation

{ TMacOSAppMenu }

procedure TMacOSAppMenu.SetAboutMenuItem(AValue: TMenuItem);
begin
  if fAboutMenuItem=AValue then Exit;
  fAboutMenuItem:=AValue;
  UpdateMenu;
end;

procedure TMacOSAppMenu.SetExitMenuItem(AValue: TMenuItem);
begin
  if fExitMenuItem=AValue then Exit;
  fExitMenuItem:=AValue;
  UpdateMenu;
end;

procedure TMacOSAppMenu.SetPrefMenuItem(AValue: TMenuItem);
begin
  if fPrefMenuItem=AValue then Exit;
  fPrefMenuItem:=AValue;
  UpdateMenu;
end;

constructor TMacOSAppMenu.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  {$ifdef LCLCocoa}
  //win := ComponentToNSWindow(Owner);
  writeln('TMacOSAppMenu.Create - creating');
  UpdateMenu;
  {$endif}
end;

{$ifdef LCLCocoa}
type
  NSMenuFix = objccategory external (NSMenu)
    function itemAtIndex(index: NSInteger): NSMenuItem; message 'itemAtIndex:'; // missing in NSMenu. available since 10.0
  end;

procedure InstallAbout;
var
  menu    : NSMenu;
  abtStr  : NSString;
  abtMenu : NSMenuItem;
begin
  writeln('installing about');
  menu := NSApplication.sharedApplication.mainMenu.itemAtIndex(0).submenu;
  writeln('allocating');

  abtStr := NSString.stringWithUTF8String('About');
  abtMenu := menu.itemWithTitle(abtStr);
  if Assigned(abtMenu) then begin
    writeln('allocated');
    //todo:
  end;

{NSString *prefsTitle = [NSString stringWithFormat:@"Preferences%C", (unichar)0x2026];
NSMenuItem *prefsMenuItem = [menu itemWithTitle:prefsTitle];
if (prefsMenuItem)}
{
    [prefsMenuItem setTarget:self];
    [prefsMenuItem setAction:@selector(openPreferences:)];
}

end;
{$endif}

procedure TMacOSAppMenu.UpdateMenu;
begin
  {$ifndef LCLCocoa}
  Exit; // non-cocoa - do nothing
  {$else}
  if not Assigned(Owner) then Exit;
  if (csDesigning in Owner.ComponentState) then Exit;

  if Assigned(fAboutMenuItem) and fAboutMenuItem.Visible then begin
    fAboutMenuItem.Visible := false;
    InstallAbout;
  end;
  {$endif}
end;

type

  { TMacOSAppMenuHandlers }

  TMacOSAppMenuHandlers = class(TObject)
  public
    class procedure FormAdded(Sender: TObject; Form: TCustomForm);
  end;

{ TMacOSAppMenuHandlers }

class procedure TMacOSAppMenuHandlers.FormAdded(Sender: TObject;
  Form: TCustomForm);
begin
end;

procedure initHandler;
begin
  Screen.AddHandlerFormAdded(TMacOSAppMenuHandlers.FormAdded, false);
end;

initialization
  {$ifdef LCLCocoa}
  //initHandler;
  {$endif}

end.