{%mainunit carbonwsextctrls.pas} type { TCDCocoaTrayIcon } TCDCocoaTrayIcon = objcclass(NSObject) public { Fields } LCLTrayIcon: TCustomTrayIcon; bar: NSStatusBar; item: NSStatusItem; WSBitmap: TCocoaBitmap;//image: NSImage; menu: NSMenu; EmptyMenuTitle: CFStringRef; (* // The following lists store the items and are used // to be able to release them in ReleaseMenu // // SubMenuOwners: Holds all internal owners of the submenus // SubMenuItems: Holds all items in submenus SubMenuOwners: array of NSMenu; SubMenuItems: array of NSMenuItem; SubMenuImages: array of NSImage; { Structural Methods } constructor Create; override; destructor Destroy; override; class function getClass: lobjc.id; override; procedure AddMethods; override; { Pascal Methods } function TrimAllChar(const S: string; const ch: Char): string; function CreateMenu(APopUpMenu: TPopUpMenu): NSMenu; function RecursiveCreateMenuItems(AMenuItem: TMenuItem; ACallbackName: string; ACallbackClass: NSObject): NSMenuItem; function CreateMenuItem(AMenuItem: TMenuItem; ACallbackName: string; ACallbackClass: NSObject): NSMenuItem; procedure ReleaseMenu(); procedure RemoveIcon();*) function ConvertTIconToWSBitmap(AIcon: TIcon): TCocoaBitmap; message 'converticon:'; function ConvertTBitmapToWSBitmap(ABitmap: TBitmap): TCocoaBitmap; message 'convertbitmap:'; (* function IsMenuVisible: Boolean; { Objective-C compatible methods } class procedure HandleMenuItemClick(_self: lobjc.id; _cmd: SEL; sender: lobjc.id); cdecl; //static; class procedure HandleMenuWillOpen(_self: lobjc.id; _cmd: SEL; sender: lobjc.id); cdecl; //static; class procedure HandleMenuDidClose(_self: lobjc.id; _cmd: SEL; sender: lobjc.id); cdecl; //static;*) end; (*const Str_TPrivateCocoaCarbonTrayIcon = 'TTrayIcon'; Str_HandleMenuItemClick = 'HandleMenuItemClick'; Str_HandleMenuWillOpen = 'menuWillOpen:'; Str_HandleMenuDidClose = 'menuDidClose:'; { 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)); AddMethod(Str_HandleMenuWillOpen, 'v@:@', Pointer(HandleMenuWillOpen)); AddMethod(Str_HandleMenuDidClose, 'v@:@', Pointer(HandleMenuDidClose)); end; constructor TPrivateCocoaCarbonTrayIcon.Create; begin { The class is registered on the Objective-C runtime before the NSObject constructor is called } // The original plan was to create a descendent class, but causes wierd crashes // so now we just stuck our method into NSObject // if not CreateClassDefinition(Str_TPrivateCocoaCarbonTrayIcon, Str_NSObject) then WriteLn('Failed to create lobjc class'); EmptyMenuTitle := CFStringCreateWithPascalString(nil, '', kCFStringEncodingUTF8); inherited Create; end; destructor TPrivateCocoaCarbonTrayIcon.Destroy; begin CFRelease(EmptyMenuTitle); RemoveIcon(); ReleaseMenu(); if item <> nil then begin item.setImage(nil); item.Free; item := nil; end; if image <> nil then begin image.Free; image := nil; end; inherited Destroy; end; class function TPrivateCocoaCarbonTrayIcon.getClass: lobjc.id; begin Result := objc_getClass({Str_TPrivateCocoaCarbonTrayIcon} Str_NSObject); end; {Removes/replaces all occurences of a character from a string} function TPrivateCocoaCarbonTrayIcon.TrimAllChar(const S: string; const ch: Char): string; var buf: string; begin buf := S; Result := ''; {while Pos finds a blank} while (Pos(ch, buf) > 0) do begin {copy the substrings before the blank in to Result} Result := Result + Copy(buf, 1, Pos(ch, buf) - 1); buf := Copy(buf, Pos(ch, buf) + 1, Length(buf) - Pos(ch, buf)); end; {There will still be a remainder in buf, so copy remainder into Result} Result := Result + buf; end; { Creates a NSMenu structure representing a TPopUpMenu } function TPrivateCocoaCarbonTrayIcon.CreateMenu(APopUpMenu: TPopUpMenu): NSMenu; var i: Integer; Item: NSMenuItem; begin Result := NSMenu.initWithTitle(EmptyMenuTitle); // Result.setVersion(0); Result.setDelegate(Self.Handle); Result.setAutoenablesItems(LongBool(NO)); // For menu enabling/disabling for i := 0 to APopUpMenu.Items.Count - 1 do begin { If the submenu has a submenu it needs special treatment } if APopUpMenu.Items[i].Count > 0 then Item := RecursiveCreateMenuItems(APopUpMenu.Items[i], Str_HandleMenuItemClick, Self) else Item := CreateMenuItem(APopUpMenu.Items[i], Str_HandleMenuItemClick, Self); if item <> nil then Result.addItem(Item.Handle); end; end; function TPrivateCocoaCarbonTrayIcon.RecursiveCreateMenuItems( AMenuItem: TMenuItem; ACallbackName: string; ACallbackClass: NSObject): NSMenuItem; var j, subindex: Integer; InternalOwner: NSMenu; SubItem: NSMenuItem; begin // First create the menu Result := CreateMenuItem(AMenuItem, Str_HandleMenuItemClick, Self); // Then a owner for the children InternalOwner := NSMenu.initWithTitle(EmptyMenuTitle); InternalOwner.setAutoenablesItems(LongBool(NO)); // For menu enabling/disabling subindex := Length(SubMenuOwners); SetLength(SubMenuOwners, subindex + 1); SubMenuOwners[subindex] := InternalOwner; { Add all submenus in this submenu } for j := 0 to AMenuItem.Count - 1 do begin if AMenuItem.Items[j].Count > 0 then SubItem := RecursiveCreateMenuItems(AMenuItem.Items[j], Str_HandleMenuItemClick, Self) else SubItem := CreateMenuItem(AMenuItem.Items[j], Str_HandleMenuItemClick, Self); if SubItem <> nil then InternalOwner.addItem(SubItem.Handle); end; // And set the submenu to the item Result.setSubmenu(InternalOwner.Handle); end; function TPrivateCocoaCarbonTrayIcon.CreateMenuItem(AMenuItem: TMenuItem; ACallbackName: string; ACallbackClass: NSObject): NSMenuItem; var ItemText: CFStringRef; KeyText: CFStringRef; subitemindex: Integer; subimageindex: Integer; AImage: NSImage; StrBuffer: string; // Default property implementation (=bold) FontManager: NSFontManager; AttrString: NSAttributedString; AttrStringFont: NSFont; AttrDictionary: NSDictionary; begin Result := nil; { Check visibility, invisible menus are implemented by not adding them at all, because NSMenuItem.setHidden was only added in Mac OS X 10.5 } if not AMenuItem.Visible then Exit; { The MenuItem is a separator } if AMenuItem.Caption = '-' then begin Result := NSMenuItem.separatorItem(); end { A normal menu item } else begin { While creating the menus we ignore the & shortcut identifiers } StrBuffer := TrimAllChar(AMenuItem.Caption, '&'); KeyText := CFStringCreateWithPascalString(nil, '', kCFStringEncodingUTF8); ItemText := CFStringCreateWithPascalString(nil, StrBuffer, kCFStringEncodingUTF8); {$ifdef VerboseCarbonTrayIcon} WriteLn(' ItemText: ', IntToHex(Int64(ItemText), 8), ' ATitle: ', AMenuItem.Caption); {$endif} Result := NSMenuItem.initWithTitle_action_keyEquivalent(ItemText, nil, KeyText); { Assign the OnClick event handler } Result.setTarget(ACallbackClass.Handle); Result.setAction(sel_registerName(PChar(ACallbackName))); { Assign the checked state } if AMenuItem.Checked then Result.setState(NSOnState) else Result.setState(NSOffState); { Assign default (=bold) state } if AMenuItem.Default then begin FontManager := NSFontManager.sharedFontManager; // For now hard-code the menu font to 14, because the default size // is 13, which is wrong, and looks bad. AttrStringFont := NSFont.menuFontOfSize(14); // 0 = default size AttrStringFont.Handle := FontManager.convertFont_toHaveTrait_(AttrStringFont.Handle, NSBoldFontMask); AttrDictionary := NSDictionary.dictionaryWithObject_forKey(AttrStringFont.Handle, lobjc.id(NSFontAttributeName)); AttrString := NSAttributedString.initWithString_attributes(ItemText, CFDictionaryRef(AttrDictionary.Handle)); if AttrString.Handle <> nil then Result.setAttributedTitle(AttrString.Handle); // Only objects acquired with routines with alloc, // init or copy in the name should be manually released AttrString.Free; AttrDictionary.Handle := nil; AttrDictionary.Free; AttrStringFont.Handle := nil; AttrStringFont.Free; FontManager.Handle := nil; FontManager.Free; end; { Assign enabled/disabled state } if AMenuItem.Enabled then Result.setEnabled(LongBool(YES)) else Result.setEnabled(LongBool(NO)); { Assign the item image, if any } if (AMenuItem.Bitmap <> nil) and (not AMenuItem.Bitmap.Empty) then begin AImage := ConvertTBitmapToNSImage(AMenuItem.Bitmap); Result.setImage(AImage.Handle); // We also need to free the images subimageindex := Length(SubMenuImages); SetLength(SubMenuImages, subimageindex + 1); SubMenuImages[subimageindex] := AImage; end; { We use the Tag to hold the LCL MenuItem RepresentedObject was also tried, by it crashed. Cocoa probably tryes to use it as a real Cocoa object } Result.setTag(PtrInt(AMenuItem)); { Never add separators to the list of items to be freed } subitemindex := Length(SubMenuItems); SetLength(SubMenuItems, subitemindex + 1); SubMenuItems[subitemindex] := Result; end; end; procedure TPrivateCocoaCarbonTrayIcon.ReleaseMenu(); var i: Integer; begin for i := 0 to Length(SubMenuOwners) - 1 do if SubMenuOwners[i] <> nil then SubMenuOwners[i].Free; for i := 0 to Length(SubMenuItems) - 1 do if (SubMenuItems[i] <> nil) then SubMenuItems[i].Free; for i := 0 to Length(SubMenuImages) - 1 do if (SubMenuImages[i] <> nil) then SubMenuImages[i].Free; SetLength(SubMenuOwners, 0); SetLength(SubMenuItems, 0); SetLength(SubMenuImages, 0); if item <> nil then item.setMenu(nil); if menu <> nil then begin menu.Free; menu := nil; end; end; procedure TPrivateCocoaCarbonTrayIcon.RemoveIcon(); begin if item <> nil then bar.removeStatusItem(item.Handle); end;*) function TCDCocoaTrayIcon.ConvertTIconToWSBitmap(AIcon: TIcon): TCocoaBitmap; (*var ASize: NSSize; ACGRect: CGRect; AcurrentContext: NSGraphicsContext;*) begin Result := nil; (* if (AIcon = nil) or (AIcon.Empty) then Exit; { Convert our CFImageRef to a NSImage } ASize.width := TCarbonBitmap(AIcon.Handle).Width; ASize.height := TCarbonBitmap(AIcon.Handle).Height; ACGRect.size.width := ASize.width; ACGRect.size.height := ASize.height; ACGRect.origin.x := 0; ACGRect.origin.y := 0; Result := NSImage.initWithSize(ASize); Result.setCacheMode(NSImageCacheNever); Result.lockFocus; AcurrentContext := NSGraphicsContext.currentContext(); CGContextDrawImage(AcurrentContext.graphicsPort, ACGRect, TCarbonBitmap(AIcon.Handle).CGImage); {$ifdef VerboseCarbonTrayIcon} WriteLn('::[TCarbonWSCustomTrayIcon.Show]', ' AcurrentContext ', IntToHex(PtrUInt(Pointer(AcurrentContext)), 8), ' AcurrentContext.ClassID ', IntToHex(Int64(AcurrentContext.ClassID), 8), ' AcurrentContext.Handle ', IntToHex(Int64(AcurrentContext.Handle), 8), ' AcurrentContext.graphicsPort ', IntToHex(Int64(AcurrentContext.graphicsPort), 8) ); {$endif VerboseCarbonTrayIcon} Result.unlockFocus;*) end; function TCDCocoaTrayIcon.ConvertTBitmapToWSBitmap(ABitmap: TBitmap): TCocoaBitmap; (*var ASize: NSSize; ACGRect: CGRect; AcurrentContext: NSGraphicsContext;*) begin Result := nil; (* if (ABitmap = nil) or (ABitmap.Empty) then Exit; { Convert our CFImageRef to a NSImage } ASize.width := TCarbonBitmap(ABitmap.Handle).Width; ASize.height := TCarbonBitmap(ABitmap.Handle).Height; ACGRect.size.width := ASize.width; ACGRect.size.height := ASize.height; ACGRect.origin.x := 0; ACGRect.origin.y := 0; Result := NSImage.initWithSize(ASize); Result.setCacheMode(NSImageCacheNever); Result.lockFocus; AcurrentContext := NSGraphicsContext.currentContext(); CGContextDrawImage(AcurrentContext.graphicsPort, ACGRect, TCarbonBitmap(ABitmap.Handle).CGImage); {$ifdef VerboseCarbonTrayIcon} WriteLn('::[TCarbonWSCustomTrayIcon.Show]', ' AcurrentContext ', IntToHex(PtrUInt(Pointer(AcurrentContext)), 8), ' AcurrentContext.ClassID ', IntToHex(Int64(AcurrentContext.ClassID), 8), ' AcurrentContext.Handle ', IntToHex(Int64(AcurrentContext.Handle), 8), ' AcurrentContext.graphicsPort ', IntToHex(Int64(AcurrentContext.graphicsPort), 8) ); {$endif VerboseCarbonTrayIcon} Result.unlockFocus;*) end; (*// Using private APIs might cause a rejection in the Apple AppStore // See: http://bugs.freepascal.org/view.php?id=19025 // But on the other hand there is no other way to check if the menu is visible // http://www.cocoabuilder.com/archive/cocoa/100570-checking-if-menu-is-visible.html {$ifdef CarbonUsePrivateAPIs} function _NSGetCarbonMenu(AMenu: lobjc.id {NSMenu}): MenuRef; cdecl; external name '_NSGetCarbonMenu'; {$endif} function TPrivateCocoaCarbonTrayIcon.IsMenuVisible: Boolean; {$ifdef CarbonUsePrivateAPIs} var CarbonMenu: MenuRef; theMenuTrackingData: MenuTrackingData; begin Result := False; if menu = nil then Exit; CarbonMenu := _NSGetCarbonMenu(menu.Handle); if CarbonMenu = nil then Exit; Result := GetMenuTrackingData(CarbonMenu, theMenuTrackingData) = noErr; end; {$else} begin Result := False; end; {$endif} { Here we try to get the LCL MenuItem from the Tag and then call it's OnClick method } class procedure TPrivateCocoaCarbonTrayIcon.HandleMenuItemClick(_self: lobjc.id; _cmd: SEL; sender: lobjc.id); cdecl; //static; var AMenuItem: NSMenuItem; LCLMenu: TMenuItem; begin AMenuItem := NSMenuItem.CreateWithHandle(lobjc.id(_cmd)); LCLMenu := TMenuItem(PtrInt(AMenuItem.Tag())); if (LCLMenu <> nil) and Assigned(LCLMenu.OnClick) then LCLMenu.OnClick(LCLMenu); end; class procedure TPrivateCocoaCarbonTrayIcon.HandleMenuWillOpen(_self: lobjc.id; _cmd: SEL; sender: lobjc.id); cdecl; //static; var AMenu: NSMenu; //LCLMenu: TPopUpMenu; begin AMenu := NSMenu.CreateWithHandle(sender); if AMenu=nil then ; // LCLMenu := TPopUpMenu(PtrInt(AMenu.menuRepresentation())); // if (LCLMenu <> nil) and Assigned(LCLMenu.OnPopUp) then LCLMenu.OnPopUp(LCLMenu); end; class procedure TPrivateCocoaCarbonTrayIcon.HandleMenuDidClose(_self: lobjc.id; _cmd: SEL; sender: lobjc.id); cdecl; //static; var AMenu: NSMenu; //LCLMenu: TPopUpMenu; begin AMenu := NSMenu.CreateWithHandle(sender); // LCLMenu := TPopUpMenu(PtrInt(AMenu.menuRepresentation())); // if (LCLMenu <> nil) and Assigned(LCLMenu.OnClose) then LCLMenu.OnClose(LCLMenu); end;*) { TCarbonWSCustomTrayIcon } class function TCDWSCustomTrayIcon.Hide(const ATrayIcon: TCustomTrayIcon): Boolean; begin Result := True; end; class function TCDWSCustomTrayIcon.Show(const ATrayIcon: TCustomTrayIcon): Boolean; var ATrayIconHandle: TCDCocoaTrayIcon; begin {$ifdef VerboseCDTrayIcon} DebugLn(':>[TCarbonWSCustomTrayIcon.Show]'); {$endif VerboseCDTrayIcon} Result := False; { Creates the handle } ATrayIconHandle := TCDCocoaTrayIcon.alloc.init; ATrayIconHandle.bar := NSStatusBar.systemStatusBar(); ATrayIconHandle.LCLTrayIcon := ATrayIcon; ATrayIcon.Handle := HWND(ATrayIconHandle); { Converts the icon to NSImage } ATrayIconHandle.WSBitmap := ATrayIconHandle.ConvertTIconToWSBitmap(ATrayIcon.Icon); { Shows the icon } if ATrayIconHandle.item <> nil then Exit(True); ATrayIconHandle.item := ATrayIconHandle.bar.statusItemWithLength(NSSquareStatusItemLength); ATrayIconHandle.item.retain(); if Assigned(ATrayIconHandle.WSBitmap) and Assigned(ATrayIconHandle.WSBitmap.image) then ATrayIconHandle.item.setImage(ATrayIconHandle.WSBitmap.image); ATrayIconHandle.item.setHighlightMode(True); (* { Inserts the menu } if ATrayIcon.PopUpMenu <> nil then begin APrivateTrayIcon.menu := APrivateTrayIcon.CreateMenu(ATrayIcon.PopUpMenu); if APrivateTrayIcon.item <> nil then APrivateTrayIcon.item.setMenu(APrivateTrayIcon.menu.Handle); end;*) Result := True; (* {$ifdef VerboseCDTrayIcon} WriteLn(':<[TCarbonWSCustomTrayIcon.Show]', ' Handle: ', IntToHex(ATrayIcon.Handle, 8), ' ACGRect.size.width: ', ACGRect.size.width, ' ACGRect.size.height: ', ACGRect.size.height, ' ACGRect.origin.x: ', ACGRect.origin.x, ' ACGRect.origin.y: ', ACGRect.origin.y, ' TCarbonBitmap(ATrayIcon.Icon.Handle).CGImage ', IntToHex(Int64(TCarbonBitmap(ATrayIcon.Icon.Handle).CGImage), 8) ); {$endif VerboseCDTrayIcon}*) end; class procedure TCDWSCustomTrayIcon.InternalUpdate(const ATrayIcon: TCustomTrayIcon); begin (* APrivateTrayIcon := TPrivateCocoaCarbonTrayIcon(ATrayIcon.Handle); if APrivateTrayIcon = nil then Exit; // The update is only necessary for a visible TTrayIcon if not ATrayIcon.Visible then Exit; { Updates the image } if Assigned(APrivateTrayIcon.Image) then APrivateTrayIcon.image.Free; if Assigned(ATrayIcon.Icon) then begin APrivateTrayIcon.image := APrivateTrayIcon.ConvertTIconToNSImage(ATrayIcon.Icon); APrivateTrayIcon.item.setImage(APrivateTrayIcon.image.Handle); end; { Inserts the menu } APrivateTrayIcon.ReleaseMenu(); if ATrayIcon.PopUpMenu <> nil then begin APrivateTrayIcon.menu := APrivateTrayIcon.CreateMenu(ATrayIcon.PopUpMenu); if APrivateTrayIcon.item <> nil then APrivateTrayIcon.item.setMenu(APrivateTrayIcon.menu.Handle); end;*) end; class function TCDWSCustomTrayIcon.ShowBalloonHint(const ATrayIcon: TCustomTrayIcon): Boolean; begin Result := False; end; class function TCDWSCustomTrayIcon.GetPosition(const ATrayIcon: TCustomTrayIcon): Types.TPoint; begin Result := Types.Point(0, 0); end;