Apply fonts to font PopupMenu
So each item in the menu item is rendered using the font it represents.
Sub ApplyFontsToItems(xp as PopupMenu)
// Apply font to menu items in a popupmenu
#if TargetCocoa then
// graphics for measurement of height
dim g as new NSGraphicsMBS
dim si as new NSSizeMBS(1000, 1000)
// the Cocoa popup control and it's menu
dim p as NSPopUpButtonMBS = xp.NSPopUpButtonMBS
dim m as NSMenuMBS = p.menu
// font size to use?
dim fontSize as Double = xp.TextSize
if fontsize <= 8 then
fontsize = NSFontMBS.systemFontSize
end if
// walk over all items
dim mu as integer = m.numberOfItems-1
for mi as integer = 0 to mu
dim item as NSMenuItemMBS = m.Item(mi)
// get the title and use it to make font
dim name as string = item.Title
dim f as NSFontMBS = NSFontMBS.fontWithName(name, fontSize)
// now build attributed string with that font
dim a as new NSMutableAttributedStringMBS
if a.initWithString(name) then
dim r as new NSRangeMBS(0, a.length)
a.addAttribute(a.NSFontAttributeName, f, r)
// calculate bounding Rectangle
dim re as NSRectMBS = g.boundingRectWithSize(a, si, 0)
if re.Height <= 22 then
// only apply font if height is not too much
item.attributedTitle = a
end if
end if
next
#endif
End Sub
