[futurebasic] Re: [FB] Fonts Window

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : February 2004 : Group Archive : Group : All Groups

From: Robert Purves <robert.purves@...>
Date: Mon, 16 Feb 2004 22:14:29 +1300
Brian Stevens wrote:

>  I'm at the point of trying to decide whether to use the traditional 
> fonts menu (and ancillary size and style menus) or go with the fonts 
> window. Given the complexity and variety of font types and the 
> decisions a programmer needs to make about which fonts and sizes to 
> include in a menu, I thought the fonts window might be  a better 
> approach.


See below. You need to make two files: "Tlbx FontPanel.incl" and the 
demo. As of OS X 10.3 none of the items in the Font Panel's 
mini-toolbar work, so the Font Panel is a bit limited. I seem to 
remember that there were additional bugs in 10.2.

Robert P.


'------ start of Tlbx FontPanel.incl ------
// partial translation of FontPanel.h   RP 16 Feb 2004

include "Tlbx CarbonEvents.incl"

#define FMFontFamily as SInt16
#define FMFontStyle  as SInt16
#define FMFontSize   as SInt16

begin record FMFontFamilyInstance
dim as FMFontFamily  fontFamily
dim as FMFontStyle   fontStyle
end record

_kHICommandShowHideFontPanel  = _"shfp"
_kEventClassFont              = _"font"
_kEventFontPanelClosed        = 1
_kEventFontSelection          = 2

_typeATSUFontID           = _"magn" /* ATSUI font ID.*/
_typeATSUSize             = _"fixd" /* ATSUI font size.*/
_typeFMFontFamily         = _"shor" /* Font family reference.*/
_typeFMFontStyle          = _"shor" /* Quickdraw font style*/
_typeFMFontSize           = _"shor" /* Integer font size.*/
_typeFontColor            = _"cRGB" /* Font color spec (optional).*/
_kEventParamATSUFontID    = _"auid" /* typeATSUFontID*/
_kEventParamATSUFontSize  = _"ausz" /* typeATSUSize*/
_kEventParamFMFontFamily  = _"fmfm" /* typeFMFontFamily*/
_kEventParamFMFontStyle   = _"fmst" /* typeFMFontStyle*/
_kEventParamFMFontSize    = _"fmsz" /* typeFMFontSize*/
_kEventParamFontColor     = _"fclr" /* typeFontColor*/
_kEventParamDictionary    = _"dict" /* typeCFDictionaryRef*/

/*
fontPanelShowErr = -8880
fontPanelSelectionStyleErr = -8881
fontPanelFontSelectionQDStyleVersionErr = -8882
*/

_kFontSelectionATSUIType = _"astl"
_kFontSelectionQDType    = _"qstl"

_kFontSelectionQDStyleVersionZero = 0

begin record FontSelectionQDStyle
dim as UInt32                version /* Version number of struct.*/
dim as FMFontFamilyInstance  instance /* Font instance data.*/
dim as FMFontSize            size /* Size of font in points.*/
dim as Boolean               hasColor /* true if color info supplied.*/
dim as UInt8                 reserved /* Filler byte.*/
dim as RGBColor              color /* Color specification for font.*/
end record

// AVAILABLE_MAC_OS_X_VERSION_10_2_AND_LATER
toolbox fn FPIsFontPanelVisible() = Boolean
toolbox fn FPShowHideFontPanel()  = OSStatus
toolbox fn SetFontInfoForSelection( OSType iStyleType, UInt32 
iNumStyles,¬
     Ptr *iStyles, EventTargetRef iFPEventTarget ) = OSStatus
// last param is wrongly indicated as HIObjectRef in 10.3 headers   RP
'------ end of Tlbx FontPanel.incl ------



'----- start of FontPanel demo ----
'~'A
'                       Runtime : Rntm Appearance.Incl
'                           CPU : Carbon
'~'B
include "Tlbx FontPanel.incl"

_mFile = 1
_iQuit = 1

_mEdit = 2

_mFormat = 3
_iFont  = 1


local mode
local fn InstallFontPanelCloseHandler
'~'1
dim as EventTypeSpec  eventType

eventType.eventClass = _kEventClassFont
eventType.eventKind  = _kEventFontPanelClosed
end fn = fn InstallEventHandler( fn GetApplicationEventTarget, ¬
       fn NewEventHandlerUPP( [Proc "FontPanelClosed" + 
_FBprocToProcPtrOffset] ),¬
       1, @eventType, #0, #0 )


local mode
local fn InstallFontSelectionHandler
'~'1
dim as EventTypeSpec  eventType

eventType.eventClass = _kEventClassFont
eventType.eventKind  = _kEventFontSelection
end fn = fn InstallEventHandler( fn GetApplicationEventTarget, ¬
       fn NewEventHandlerUPP( [Proc "FontSelection" + 
_FBprocToProcPtrOffset] ),¬
       1, @eventType, #0, #0 )


long if 0
"FontPanelClosed"
enterproc fn FontPanelClosed( nextHandler as EventHandlerCallRef, ¬
   theEvent as EventRef, userData as Ptr ) = OSStatus
'~'1
// adjust title of menu item
menu _mFormat, _iFont, _enable, "Show Fonts"
exitproc = _noErr

"FontSelection"
enterproc fn FontSelection( nextHandler as EventHandlerCallRef, ¬
   theEvent as EventRef, userData as Ptr ) = OSStatus
'~'1
dim as OSStatus       ignore
dim as RGBColor       colour
dim as FMFontFamily @ fontFamily
dim as FMFontStyle  @ fontStyle
dim as FMFontSize   @ fontSize

long if ( _noErr == fn GetEventParameter( theEvent, 
_kEventParamFMFontFamily, ¬
   _typeFMFontFamily, #0, sizeof( fontFamily ), #0, @fontFamily ) )
edit text #1, fontFamily
end if

long if ( _noErr == fn GetEventParameter( theEvent, 
_kEventParamFMFontStyle, ¬
   _typeFMFontStyle, #0, sizeof( fontStyle ), #0, @fontStyle ) )
edit text #1,,, fontStyle
end if

long if ( _noErr == fn GetEventParameter( theEvent, 
_kEventParamFMFontSize, ¬
   _typeFMFontSize, #0, sizeof( fontSize ), #0, @fontSize ) )
edit text #1,, fontSize
end if

// FontPanel bug, not fixed in 10.3.2, means that this does not work
long if ( _noErr == fn GetEventParameter( theEvent, 
_kEventParamFontColor, ¬
   _typeFontColor, #0, sizeof( colour ), #0, @colour ) )
edit text #1,,,, colour
end if

exitproc = _noErr
end if


local mode
local fn DoMenu
'~'1
dim as short  menuNum, menuItem
dim as OSStatus  ignore

menuNum = menu( 0 )
menuItem = menu( 1 )
select menuNum
case _mFile
end
case _mFormat
select menuItem
case _iFont
ignore = fn FPShowHideFontPanel()
long if ( fn FPIsFontPanelVisible() )
menu _mFormat, _iFont, _enable, "Hide Fonts"
xelse
menu _mFormat, _iFont, _enable, "Show Fonts"
end if
end select
end select
menu
end fn



// main program
dim as FontSelectionQDStyle  myFontStyle
dim as OSStatus              err

if ( system( _sysVers ) < 1020 ) then ¬
   stop "Requires os X 10.2 or higher"

menu _mFile,  0,       _enable, "File"
menu _mFormat, _iQuit, _enable, "Quit/Q"

gFBEditSelectAll = _zTrue
edit menu _mEdit

menu _mFormat, 0,      _enable, "Format"
menu _mFormat, _iFont, _enable, "Show Fonts/T"

fn InstallFontPanelCloseHandler
on menu fn DoMenu

window 1
edit field 1, "Abcdefg hijklmn opqrs", (20, 20)-(300, 190)
edit text #1, _sysFont, 18, _boldBit%
fn InstallFontSelectionHandler

// default setting for Font Panel
myFontStyle.version  = _kFontSelectionQDStyleVersionZero
myFontStyle.hasColor = _false
myFontStyle.instance.fontFamily = _sysFont
myFontStyle.instance.fontStyle  = _boldBit%
myFontStyle.size     = 18
err = fn SetFontInfoForSelection( _kFontSelectionQDType, 1, 
myFontStyle, 0 )
// last parameter 0: events to be sent to ApplicationEventTarget
if err then stop "SetFontInfoForSelection error " + str$( err )

do
HandleEvents
until 0
'----- end of FontPanel demo ----