← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to lcl/interfaces/customdrawn/customdrawntrayicon_cocoa.inc

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lcl/interfaces/customdrawn/customdrawntrayicon_cocoa.inc
 
1
{%mainunit carbonwsextctrls.pas}
 
2
 
 
3
type
 
4
  { TCDCocoaTrayIcon }
 
5
 
 
6
  TCDCocoaTrayIcon = objcclass(NSObject)
 
7
  public
 
8
    { Fields }
 
9
    LCLTrayIcon: TCustomTrayIcon;
 
10
    bar: NSStatusBar;
 
11
    item: NSStatusItem;
 
12
    WSBitmap: TCocoaBitmap;//image: NSImage;
 
13
    menu: NSMenu;
 
14
    EmptyMenuTitle: CFStringRef;
 
15
(*    // The following lists store the items and are used
 
16
    // to be able to release them in ReleaseMenu
 
17
    //
 
18
    // SubMenuOwners: Holds all internal owners of the submenus
 
19
    // SubMenuItems: Holds all items in submenus
 
20
    SubMenuOwners: array of NSMenu;
 
21
    SubMenuItems: array of NSMenuItem;
 
22
    SubMenuImages: array of NSImage;
 
23
    { Structural Methods }
 
24
    constructor Create; override;
 
25
    destructor Destroy; override;
 
26
    class function getClass: lobjc.id; override;
 
27
    procedure AddMethods; override;
 
28
    { Pascal Methods }
 
29
    function TrimAllChar(const S: string; const ch: Char): string;
 
30
    function CreateMenu(APopUpMenu: TPopUpMenu): NSMenu;
 
31
    function RecursiveCreateMenuItems(AMenuItem: TMenuItem;
 
32
      ACallbackName: string; ACallbackClass: NSObject): NSMenuItem;
 
33
    function CreateMenuItem(AMenuItem: TMenuItem;
 
34
      ACallbackName: string; ACallbackClass: NSObject): NSMenuItem;
 
35
    procedure ReleaseMenu();
 
36
    procedure RemoveIcon();*)
 
37
    function ConvertTIconToWSBitmap(AIcon: TIcon): TCocoaBitmap; message 'converticon:';
 
38
    function ConvertTBitmapToWSBitmap(ABitmap: TBitmap): TCocoaBitmap; message 'convertbitmap:';
 
39
(*    function IsMenuVisible: Boolean;
 
40
    { Objective-C compatible methods }
 
41
    class procedure HandleMenuItemClick(_self: lobjc.id; _cmd: SEL; sender: lobjc.id); cdecl; //static;
 
42
    class procedure HandleMenuWillOpen(_self: lobjc.id; _cmd: SEL; sender: lobjc.id); cdecl; //static;
 
43
    class procedure HandleMenuDidClose(_self: lobjc.id; _cmd: SEL; sender: lobjc.id); cdecl; //static;*)
 
44
  end;
 
45
 
 
46
(*const
 
47
  Str_TPrivateCocoaCarbonTrayIcon = 'TTrayIcon';
 
48
 
 
49
  Str_HandleMenuItemClick = 'HandleMenuItemClick';
 
50
  Str_HandleMenuWillOpen = 'menuWillOpen:';
 
51
  Str_HandleMenuDidClose = 'menuDidClose:';
 
52
 
 
53
{ TPrivateCocoaCarbonTrayIcon }
 
54
 
 
55
{@@
 
56
  Adds methods to the class
 
57
 
 
58
  Details of the parameters string:
 
59
 
 
60
  The first parameter is the result (v = void),
 
61
  followed by self and _cmd (@ = id and : = SEL),
 
62
  and on the end "sender" (@ = id)
 
63
}
 
64
procedure TPrivateCocoaCarbonTrayIcon.AddMethods;
 
65
begin
 
66
  AddMethod(Str_HandleMenuItemClick, 'v@:@', Pointer(HandleMenuItemClick));
 
67
  AddMethod(Str_HandleMenuWillOpen, 'v@:@', Pointer(HandleMenuWillOpen));
 
68
  AddMethod(Str_HandleMenuDidClose, 'v@:@', Pointer(HandleMenuDidClose));
 
69
end;
 
70
 
 
71
constructor TPrivateCocoaCarbonTrayIcon.Create;
 
72
begin
 
73
  { The class is registered on the Objective-C runtime before the NSObject constructor is called }
 
74
  // The original plan was to create a descendent class, but causes wierd crashes
 
75
  // so now we just stuck our method into NSObject
 
76
//  if not CreateClassDefinition(Str_TPrivateCocoaCarbonTrayIcon, Str_NSObject) then WriteLn('Failed to create lobjc class');
 
77
 
 
78
  EmptyMenuTitle := CFStringCreateWithPascalString(nil, '', kCFStringEncodingUTF8);
 
79
 
 
80
  inherited Create;
 
81
end;
 
82
 
 
83
destructor TPrivateCocoaCarbonTrayIcon.Destroy;
 
84
begin
 
85
  CFRelease(EmptyMenuTitle);
 
86
 
 
87
  RemoveIcon();
 
88
  ReleaseMenu();
 
89
 
 
90
  if item <> nil then
 
91
  begin
 
92
    item.setImage(nil);
 
93
    item.Free;
 
94
    item := nil;
 
95
  end;
 
96
 
 
97
  if image <> nil then
 
98
  begin
 
99
    image.Free;
 
100
    image := nil;
 
101
  end;
 
102
 
 
103
  inherited Destroy;
 
104
end;
 
105
 
 
106
class function TPrivateCocoaCarbonTrayIcon.getClass: lobjc.id;
 
107
begin
 
108
  Result := objc_getClass({Str_TPrivateCocoaCarbonTrayIcon} Str_NSObject);
 
109
end;
 
110
 
 
111
{Removes/replaces all occurences of a character from a string}
 
112
function TPrivateCocoaCarbonTrayIcon.TrimAllChar(const S: string; const ch: Char): string;
 
113
var
 
114
  buf: string;
 
115
begin
 
116
  buf := S;
 
117
  Result := '';
 
118
  {while Pos finds a blank}
 
119
  while (Pos(ch, buf) > 0) do
 
120
    begin
 
121
      {copy the substrings before the blank in to Result}
 
122
      Result := Result + Copy(buf, 1, Pos(ch, buf) - 1);
 
123
      buf := Copy(buf, Pos(ch, buf) + 1, Length(buf) - Pos(ch, buf));
 
124
    end;
 
125
  {There will still be a remainder in buf, so copy remainder into Result}
 
126
  Result := Result + buf;
 
127
end;
 
128
 
 
129
{ Creates a NSMenu structure representing a TPopUpMenu }
 
130
function TPrivateCocoaCarbonTrayIcon.CreateMenu(APopUpMenu: TPopUpMenu): NSMenu;
 
131
var
 
132
  i: Integer;
 
133
  Item: NSMenuItem;
 
134
begin
 
135
  Result := NSMenu.initWithTitle(EmptyMenuTitle);
 
136
//  Result.setVersion(0);
 
137
  Result.setDelegate(Self.Handle);
 
138
  Result.setAutoenablesItems(LongBool(NO)); // For menu enabling/disabling
 
139
 
 
140
  for i := 0 to APopUpMenu.Items.Count - 1 do
 
141
  begin
 
142
    { If the submenu has a submenu it needs special treatment }
 
143
    if APopUpMenu.Items[i].Count > 0 then
 
144
      Item := RecursiveCreateMenuItems(APopUpMenu.Items[i], Str_HandleMenuItemClick, Self)
 
145
    else
 
146
      Item := CreateMenuItem(APopUpMenu.Items[i], Str_HandleMenuItemClick, Self);
 
147
 
 
148
    if item <> nil then
 
149
      Result.addItem(Item.Handle);
 
150
  end;
 
151
end;
 
152
 
 
153
function TPrivateCocoaCarbonTrayIcon.RecursiveCreateMenuItems(
 
154
  AMenuItem: TMenuItem; ACallbackName: string; ACallbackClass: NSObject): NSMenuItem;
 
155
var
 
156
  j, subindex: Integer;
 
157
  InternalOwner: NSMenu;
 
158
  SubItem: NSMenuItem;
 
159
begin
 
160
  // First create the menu
 
161
  Result := CreateMenuItem(AMenuItem, Str_HandleMenuItemClick, Self);
 
162
 
 
163
  // Then a owner for the children
 
164
  InternalOwner := NSMenu.initWithTitle(EmptyMenuTitle);
 
165
  InternalOwner.setAutoenablesItems(LongBool(NO)); // For menu enabling/disabling
 
166
 
 
167
  subindex := Length(SubMenuOwners);
 
168
  SetLength(SubMenuOwners, subindex + 1);
 
169
  SubMenuOwners[subindex] := InternalOwner;
 
170
 
 
171
  { Add all submenus in this submenu }
 
172
  for j := 0 to AMenuItem.Count - 1 do
 
173
  begin
 
174
    if AMenuItem.Items[j].Count > 0 then
 
175
      SubItem := RecursiveCreateMenuItems(AMenuItem.Items[j], Str_HandleMenuItemClick, Self)
 
176
    else
 
177
      SubItem := CreateMenuItem(AMenuItem.Items[j], Str_HandleMenuItemClick, Self);
 
178
 
 
179
    if SubItem <> nil then
 
180
      InternalOwner.addItem(SubItem.Handle);
 
181
  end;
 
182
 
 
183
  // And set the submenu to the item
 
184
  Result.setSubmenu(InternalOwner.Handle);
 
185
end;
 
186
 
 
187
function TPrivateCocoaCarbonTrayIcon.CreateMenuItem(AMenuItem: TMenuItem;
 
188
  ACallbackName: string; ACallbackClass: NSObject): NSMenuItem;
 
189
var
 
190
  ItemText: CFStringRef;
 
191
  KeyText: CFStringRef;
 
192
  subitemindex: Integer;
 
193
  subimageindex: Integer;
 
194
  AImage: NSImage;
 
195
  StrBuffer: string;
 
196
  // Default property implementation (=bold)
 
197
  FontManager: NSFontManager;
 
198
  AttrString: NSAttributedString;
 
199
  AttrStringFont: NSFont;
 
200
  AttrDictionary: NSDictionary;
 
201
begin
 
202
  Result := nil;
 
203
 
 
204
  { Check visibility, invisible menus are implemented by not adding them at all,
 
205
    because NSMenuItem.setHidden was only added in Mac OS X 10.5 }
 
206
  if not AMenuItem.Visible then Exit;
 
207
 
 
208
  { The MenuItem is a separator }
 
209
  if AMenuItem.Caption = '-' then
 
210
  begin
 
211
    Result := NSMenuItem.separatorItem();
 
212
  end
 
213
  { A normal menu item }
 
214
  else
 
215
  begin
 
216
    { While creating the menus we ignore the & shortcut identifiers }
 
217
    StrBuffer := TrimAllChar(AMenuItem.Caption, '&');
 
218
    KeyText := CFStringCreateWithPascalString(nil, '', kCFStringEncodingUTF8);
 
219
    ItemText := CFStringCreateWithPascalString(nil, StrBuffer, kCFStringEncodingUTF8);
 
220
    {$ifdef VerboseCarbonTrayIcon}
 
221
    WriteLn(' ItemText: ', IntToHex(Int64(ItemText), 8), ' ATitle: ', AMenuItem.Caption);
 
222
    {$endif}
 
223
 
 
224
    Result := NSMenuItem.initWithTitle_action_keyEquivalent(ItemText, nil, KeyText);
 
225
    
 
226
    { Assign the OnClick event handler }
 
227
    Result.setTarget(ACallbackClass.Handle);
 
228
    Result.setAction(sel_registerName(PChar(ACallbackName)));
 
229
 
 
230
    { Assign the checked state }
 
231
    if AMenuItem.Checked then Result.setState(NSOnState)
 
232
    else Result.setState(NSOffState);
 
233
 
 
234
    { Assign default (=bold) state }
 
235
    if AMenuItem.Default then
 
236
    begin
 
237
      FontManager := NSFontManager.sharedFontManager;
 
238
      // For now hard-code the menu font to 14, because the default size
 
239
      // is 13, which is wrong, and looks bad.
 
240
      AttrStringFont := NSFont.menuFontOfSize(14); // 0 = default size
 
241
      AttrStringFont.Handle := FontManager.convertFont_toHaveTrait_(AttrStringFont.Handle, NSBoldFontMask);
 
242
      AttrDictionary := NSDictionary.dictionaryWithObject_forKey(AttrStringFont.Handle, lobjc.id(NSFontAttributeName));
 
243
      AttrString := NSAttributedString.initWithString_attributes(ItemText, CFDictionaryRef(AttrDictionary.Handle));
 
244
      if AttrString.Handle <> nil then
 
245
        Result.setAttributedTitle(AttrString.Handle);
 
246
 
 
247
      // Only objects acquired with routines with alloc,
 
248
      // init or copy in the name should be manually released
 
249
      AttrString.Free;
 
250
      AttrDictionary.Handle := nil;
 
251
      AttrDictionary.Free;
 
252
      AttrStringFont.Handle := nil;
 
253
      AttrStringFont.Free;
 
254
      FontManager.Handle := nil;
 
255
      FontManager.Free;
 
256
    end;
 
257
 
 
258
    { Assign enabled/disabled state }
 
259
    if AMenuItem.Enabled then Result.setEnabled(LongBool(YES))
 
260
    else Result.setEnabled(LongBool(NO));
 
261
 
 
262
    { Assign the item image, if any }
 
263
    if (AMenuItem.Bitmap <> nil) and (not AMenuItem.Bitmap.Empty) then
 
264
    begin
 
265
      AImage := ConvertTBitmapToNSImage(AMenuItem.Bitmap);
 
266
      Result.setImage(AImage.Handle);
 
267
 
 
268
      // We also need to free the images
 
269
      subimageindex := Length(SubMenuImages);
 
270
      SetLength(SubMenuImages, subimageindex + 1);
 
271
      SubMenuImages[subimageindex] := AImage;
 
272
    end;
 
273
 
 
274
    { We use the Tag to hold the LCL MenuItem
 
275
      RepresentedObject was also tried, by it crashed.
 
276
      Cocoa probably tryes to use it as a real Cocoa object }
 
277
    Result.setTag(PtrInt(AMenuItem));
 
278
 
 
279
    { Never add separators to the list of items to be freed }
 
280
    subitemindex := Length(SubMenuItems);
 
281
    SetLength(SubMenuItems, subitemindex + 1);
 
282
    SubMenuItems[subitemindex] := Result;
 
283
  end;
 
284
end;
 
285
 
 
286
procedure TPrivateCocoaCarbonTrayIcon.ReleaseMenu();
 
287
var
 
288
  i: Integer;
 
289
begin
 
290
  for i := 0 to Length(SubMenuOwners) - 1 do
 
291
    if SubMenuOwners[i] <> nil then SubMenuOwners[i].Free;
 
292
  for i := 0 to Length(SubMenuItems) - 1 do
 
293
    if (SubMenuItems[i] <> nil) then SubMenuItems[i].Free;
 
294
  for i := 0 to Length(SubMenuImages) - 1 do
 
295
    if (SubMenuImages[i] <> nil) then SubMenuImages[i].Free;
 
296
 
 
297
  SetLength(SubMenuOwners, 0);
 
298
  SetLength(SubMenuItems, 0);
 
299
  SetLength(SubMenuImages, 0);
 
300
 
 
301
  if item <> nil then
 
302
    item.setMenu(nil);
 
303
 
 
304
  if menu <> nil then
 
305
  begin
 
306
    menu.Free;
 
307
    menu := nil;
 
308
  end;
 
309
end;
 
310
 
 
311
procedure TPrivateCocoaCarbonTrayIcon.RemoveIcon();
 
312
begin
 
313
  if item <> nil then
 
314
    bar.removeStatusItem(item.Handle);
 
315
end;*)
 
316
 
 
317
function TCDCocoaTrayIcon.ConvertTIconToWSBitmap(AIcon: TIcon): TCocoaBitmap;
 
318
(*var
 
319
  ASize: NSSize;
 
320
  ACGRect: CGRect;
 
321
  AcurrentContext: NSGraphicsContext;*)
 
322
begin
 
323
  Result := nil;
 
324
 
 
325
(*  if (AIcon = nil) or (AIcon.Empty) then Exit;
 
326
 
 
327
  { Convert our CFImageRef to a NSImage }
 
328
 
 
329
  ASize.width := TCarbonBitmap(AIcon.Handle).Width;
 
330
  ASize.height := TCarbonBitmap(AIcon.Handle).Height;
 
331
  ACGRect.size.width := ASize.width;
 
332
  ACGRect.size.height := ASize.height;
 
333
  ACGRect.origin.x := 0;
 
334
  ACGRect.origin.y := 0;
 
335
 
 
336
  Result := NSImage.initWithSize(ASize);
 
337
  Result.setCacheMode(NSImageCacheNever);
 
338
  Result.lockFocus;
 
339
  AcurrentContext := NSGraphicsContext.currentContext();
 
340
  CGContextDrawImage(AcurrentContext.graphicsPort, ACGRect, TCarbonBitmap(AIcon.Handle).CGImage);
 
341
  {$ifdef VerboseCarbonTrayIcon}
 
342
    WriteLn('::[TCarbonWSCustomTrayIcon.Show]',
 
343
     ' AcurrentContext ', IntToHex(PtrUInt(Pointer(AcurrentContext)), 8),
 
344
     ' AcurrentContext.ClassID ', IntToHex(Int64(AcurrentContext.ClassID), 8),
 
345
     ' AcurrentContext.Handle ', IntToHex(Int64(AcurrentContext.Handle), 8),
 
346
     ' AcurrentContext.graphicsPort ', IntToHex(Int64(AcurrentContext.graphicsPort), 8)
 
347
     );
 
348
  {$endif VerboseCarbonTrayIcon}
 
349
  Result.unlockFocus;*)
 
350
end;
 
351
 
 
352
function TCDCocoaTrayIcon.ConvertTBitmapToWSBitmap(ABitmap: TBitmap): TCocoaBitmap;
 
353
(*var
 
354
  ASize: NSSize;
 
355
  ACGRect: CGRect;
 
356
  AcurrentContext: NSGraphicsContext;*)
 
357
begin
 
358
  Result := nil;
 
359
 
 
360
(*  if (ABitmap = nil) or (ABitmap.Empty) then Exit;
 
361
 
 
362
  { Convert our CFImageRef to a NSImage }
 
363
 
 
364
  ASize.width := TCarbonBitmap(ABitmap.Handle).Width;
 
365
  ASize.height := TCarbonBitmap(ABitmap.Handle).Height;
 
366
  ACGRect.size.width := ASize.width;
 
367
  ACGRect.size.height := ASize.height;
 
368
  ACGRect.origin.x := 0;
 
369
  ACGRect.origin.y := 0;
 
370
 
 
371
  Result := NSImage.initWithSize(ASize);
 
372
  Result.setCacheMode(NSImageCacheNever);
 
373
  Result.lockFocus;
 
374
  AcurrentContext := NSGraphicsContext.currentContext();
 
375
  CGContextDrawImage(AcurrentContext.graphicsPort, ACGRect, TCarbonBitmap(ABitmap.Handle).CGImage);
 
376
  {$ifdef VerboseCarbonTrayIcon}
 
377
    WriteLn('::[TCarbonWSCustomTrayIcon.Show]',
 
378
     ' AcurrentContext ', IntToHex(PtrUInt(Pointer(AcurrentContext)), 8),
 
379
     ' AcurrentContext.ClassID ', IntToHex(Int64(AcurrentContext.ClassID), 8),
 
380
     ' AcurrentContext.Handle ', IntToHex(Int64(AcurrentContext.Handle), 8),
 
381
     ' AcurrentContext.graphicsPort ', IntToHex(Int64(AcurrentContext.graphicsPort), 8)
 
382
     );
 
383
  {$endif VerboseCarbonTrayIcon}
 
384
  Result.unlockFocus;*)
 
385
end;
 
386
 
 
387
(*// Using private APIs might cause a rejection in the Apple AppStore
 
388
// See: http://bugs.freepascal.org/view.php?id=19025
 
389
// But on the other hand there is no other way to check if the menu is visible
 
390
// http://www.cocoabuilder.com/archive/cocoa/100570-checking-if-menu-is-visible.html
 
391
{$ifdef CarbonUsePrivateAPIs}
 
392
function _NSGetCarbonMenu(AMenu: lobjc.id {NSMenu}): MenuRef; cdecl; external name '_NSGetCarbonMenu';
 
393
{$endif}
 
394
 
 
395
function TPrivateCocoaCarbonTrayIcon.IsMenuVisible: Boolean;
 
396
{$ifdef CarbonUsePrivateAPIs}
 
397
var
 
398
  CarbonMenu: MenuRef;
 
399
  theMenuTrackingData: MenuTrackingData;
 
400
begin
 
401
  Result := False;
 
402
 
 
403
  if menu = nil then Exit;
 
404
 
 
405
  CarbonMenu := _NSGetCarbonMenu(menu.Handle);
 
406
  if CarbonMenu = nil then Exit;
 
407
 
 
408
  Result :=  GetMenuTrackingData(CarbonMenu, theMenuTrackingData) = noErr;
 
409
end;
 
410
{$else}
 
411
begin
 
412
  Result := False;
 
413
end;
 
414
{$endif}
 
415
 
 
416
{ Here we try to get the LCL MenuItem from the Tag and then call
 
417
  it's OnClick method }
 
418
class procedure TPrivateCocoaCarbonTrayIcon.HandleMenuItemClick(_self: lobjc.id;
 
419
  _cmd: SEL; sender: lobjc.id); cdecl; //static;
 
420
var
 
421
  AMenuItem: NSMenuItem;
 
422
  LCLMenu: TMenuItem;
 
423
begin
 
424
  AMenuItem := NSMenuItem.CreateWithHandle(lobjc.id(_cmd));
 
425
  LCLMenu := TMenuItem(PtrInt(AMenuItem.Tag()));
 
426
  if (LCLMenu <> nil) and Assigned(LCLMenu.OnClick) then LCLMenu.OnClick(LCLMenu);
 
427
end;
 
428
 
 
429
class procedure TPrivateCocoaCarbonTrayIcon.HandleMenuWillOpen(_self: lobjc.id;
 
430
  _cmd: SEL; sender: lobjc.id); cdecl; //static;
 
431
var
 
432
  AMenu: NSMenu;
 
433
  //LCLMenu: TPopUpMenu;
 
434
begin
 
435
  AMenu := NSMenu.CreateWithHandle(sender);
 
436
  if AMenu=nil then ;
 
437
//  LCLMenu := TPopUpMenu(PtrInt(AMenu.menuRepresentation()));
 
438
//  if (LCLMenu <> nil) and Assigned(LCLMenu.OnPopUp) then LCLMenu.OnPopUp(LCLMenu);
 
439
end;
 
440
 
 
441
class procedure TPrivateCocoaCarbonTrayIcon.HandleMenuDidClose(_self: lobjc.id;
 
442
  _cmd: SEL; sender: lobjc.id); cdecl; //static;
 
443
var
 
444
  AMenu: NSMenu;
 
445
  //LCLMenu: TPopUpMenu;
 
446
begin
 
447
  AMenu := NSMenu.CreateWithHandle(sender);
 
448
//  LCLMenu := TPopUpMenu(PtrInt(AMenu.menuRepresentation()));
 
449
//  if (LCLMenu <> nil) and Assigned(LCLMenu.OnClose) then LCLMenu.OnClose(LCLMenu);
 
450
end;*)
 
451
 
 
452
{ TCarbonWSCustomTrayIcon }
 
453
 
 
454
class function TCDWSCustomTrayIcon.Hide(const ATrayIcon: TCustomTrayIcon): Boolean;
 
455
begin
 
456
  Result := True;
 
457
end;
 
458
 
 
459
class function TCDWSCustomTrayIcon.Show(const ATrayIcon: TCustomTrayIcon): Boolean;
 
460
var
 
461
  ATrayIconHandle: TCDCocoaTrayIcon;
 
462
begin
 
463
  {$ifdef VerboseCDTrayIcon}
 
464
  DebugLn(':>[TCarbonWSCustomTrayIcon.Show]');
 
465
  {$endif VerboseCDTrayIcon}
 
466
 
 
467
  Result := False;
 
468
 
 
469
  { Creates the handle }
 
470
  
 
471
  ATrayIconHandle := TCDCocoaTrayIcon.alloc.init;
 
472
  ATrayIconHandle.bar := NSStatusBar.systemStatusBar();
 
473
  ATrayIconHandle.LCLTrayIcon := ATrayIcon;
 
474
  ATrayIcon.Handle := HWND(ATrayIconHandle);
 
475
 
 
476
  { Converts the icon to NSImage }
 
477
 
 
478
  ATrayIconHandle.WSBitmap := ATrayIconHandle.ConvertTIconToWSBitmap(ATrayIcon.Icon);
 
479
 
 
480
  { Shows the icon }
 
481
 
 
482
  if ATrayIconHandle.item <> nil then Exit(True);
 
483
 
 
484
  ATrayIconHandle.item := ATrayIconHandle.bar.statusItemWithLength(NSSquareStatusItemLength);
 
485
  ATrayIconHandle.item.retain();
 
486
  if Assigned(ATrayIconHandle.WSBitmap) and Assigned(ATrayIconHandle.WSBitmap.image) then
 
487
    ATrayIconHandle.item.setImage(ATrayIconHandle.WSBitmap.image);
 
488
  ATrayIconHandle.item.setHighlightMode(True);
 
489
 
 
490
(*  { Inserts the menu }
 
491
 
 
492
  if ATrayIcon.PopUpMenu <> nil then
 
493
  begin
 
494
    APrivateTrayIcon.menu := APrivateTrayIcon.CreateMenu(ATrayIcon.PopUpMenu);
 
495
    if APrivateTrayIcon.item <> nil then
 
496
      APrivateTrayIcon.item.setMenu(APrivateTrayIcon.menu.Handle);
 
497
  end;*)
 
498
 
 
499
  Result := True;
 
500
  
 
501
(*  {$ifdef VerboseCDTrayIcon}
 
502
    WriteLn(':<[TCarbonWSCustomTrayIcon.Show]',
 
503
     ' Handle: ', IntToHex(ATrayIcon.Handle, 8),
 
504
     ' ACGRect.size.width: ', ACGRect.size.width,
 
505
     ' ACGRect.size.height: ', ACGRect.size.height,
 
506
     ' ACGRect.origin.x: ', ACGRect.origin.x,
 
507
     ' ACGRect.origin.y: ', ACGRect.origin.y,
 
508
     ' TCarbonBitmap(ATrayIcon.Icon.Handle).CGImage ', IntToHex(Int64(TCarbonBitmap(ATrayIcon.Icon.Handle).CGImage), 8)
 
509
     );
 
510
  {$endif VerboseCDTrayIcon}*)
 
511
end;
 
512
 
 
513
class procedure TCDWSCustomTrayIcon.InternalUpdate(const ATrayIcon: TCustomTrayIcon);
 
514
begin
 
515
(*  APrivateTrayIcon := TPrivateCocoaCarbonTrayIcon(ATrayIcon.Handle);
 
516
 
 
517
  if APrivateTrayIcon = nil then Exit;
 
518
 
 
519
  // The update is only necessary for a visible TTrayIcon
 
520
  if not ATrayIcon.Visible then Exit;
 
521
 
 
522
  { Updates the image }
 
523
 
 
524
  if Assigned(APrivateTrayIcon.Image) then
 
525
    APrivateTrayIcon.image.Free;
 
526
 
 
527
  if Assigned(ATrayIcon.Icon) then
 
528
  begin
 
529
    APrivateTrayIcon.image := APrivateTrayIcon.ConvertTIconToNSImage(ATrayIcon.Icon);
 
530
    APrivateTrayIcon.item.setImage(APrivateTrayIcon.image.Handle);
 
531
  end;
 
532
 
 
533
  { Inserts the menu }
 
534
 
 
535
  APrivateTrayIcon.ReleaseMenu();
 
536
  if ATrayIcon.PopUpMenu <> nil then
 
537
  begin
 
538
    APrivateTrayIcon.menu := APrivateTrayIcon.CreateMenu(ATrayIcon.PopUpMenu);
 
539
    if APrivateTrayIcon.item <> nil then
 
540
      APrivateTrayIcon.item.setMenu(APrivateTrayIcon.menu.Handle);
 
541
  end;*)
 
542
end;
 
543
 
 
544
class function TCDWSCustomTrayIcon.ShowBalloonHint(const ATrayIcon: TCustomTrayIcon): Boolean;
 
545
begin
 
546
  Result := False;
 
547
end;
 
548
 
 
549
class function TCDWSCustomTrayIcon.GetPosition(const ATrayIcon: TCustomTrayIcon): Types.TPoint;
 
550
begin
 
551
  Result := Types.Point(0, 0);
 
552
end;
 
553