Dear listers,
the following little demo is meant to demonstrate how you can
programmatically create Carbon menus (pure toolbox code), i.e. modern
menus without resources. The demo should be compiled with the
Appearance Runtime.
(Tested with OS 9.1 and OS X 10.1.4 )
Take care of possibly lost underscores.
Comments are highly welcome!
Best
Herbie
(Please send a copy of your reply directly to me. I'm on List Digest!)
//************************** Start of Code *************************
'~'A
' Runtime : Rntm Appearance.Incl
' CPU : Carbon
' Debugger : Off
' DIM'd Vars Only : On
' No Re-DIM'd Vars : On
' CALL Req'd : Off
' Register Vars : On
' MacsBug Labels : Off
' Ary Bounds Checking : Off
' QB Labels : Off
' Optimize STR# : Off
' Make Line Start Table : Off
' Show Warnings : On
'~'B
'~'8
'~Compiler Directives *********************************************
'~'9
OUTPUT FILE "ProgMenu"
Stringlist = 140, "Pascal String Constants"
StringList OPT
'~'8
'~Includes ********************************************************
'~'9
Include "Tlbx CarbonEvents.Incl"
'~'8
'~Variable Definitions ********************************************
'~'9
#DEFINE MenuID AS SInt16
#DEFINE MenuAttributes AS UInt32
#DEFINE MenuItemID AS UInt32
#DEFINE MenuItemAttributes AS UInt32
'~'8
'~Toolbox Additions ***********************************************
'~'9
// Creates a new, untitled, empty menu.
TOOLBOX FN CreateNewMenu ( ¬
MenuID inMenuID, ¬
MenuAttributes inMenuAttributes, ¬
MenuRef *outMenuRef ) = OSStatus
// Decrements the retain count of a menu.
TOOLBOX FN ReleaseMenu ( ¬
MenuRef inMenu ) = OSStatus
// Sets the menu whose contents are displayed in the menubar.
TOOLBOX FN SetRootMenu ( ¬
MenuRef inMenu ) = OSStatus
// Sets the title of a menu to the text contained in a CFString.
TOOLBOX FN SetMenuTitleWithCFString ( ¬
MenuRef inMenu, ¬
CFStringRef inString ) = OSStatus
// Sets the title of a menu to the text contained in a Pascal string.
TOOLBOX FN SetMenuTitle ( ¬
MenuRef inMenu, ¬
STR255 title ) = OSStatus
// Appends a new menu item with text from a CFString.
TOOLBOX FN AppendMenuItemTextWithCFString ( ¬
MenuRef inMenu, ¬
CFStringRef inString, ¬
MenuItemAttributes inAttributes, ¬
MenuCommand inCommandID, ¬
MenuItemIndex *outNewItem ) = OSStatus
// Inserts a new menu item with text from a CFString.
TOOLBOX FN InsertMenuItemTextWithCFString ( ¬
MenuRef inMenu, ¬
CFStringRef inString, ¬
MenuItemIndex inAfterItem, ¬
MenuItemAttributes inAttributes, ¬
MenuCommand inCommandID ) = OSStatus
// Attaches a submenu to a menu item.
TOOLBOX FN SetMenuItemHierarchicalMenu ( ¬
MenuRef inMenu, ¬
MenuItemIndex inItem, ¬
MenuRef inHierMenu ) = OSStatus
// Sets the text of a menu item to the text contained in a CFString.
TOOLBOX FN SetMenuItemTextWithCFString ( ¬
MenuRef inMenu, ¬
MenuItemIndex inItem, ¬
CFStringRef inString ) = OSStatus
'~'8
'~Constants *******************************************************
'~'9
_numAppEvtTypes = 2
BEGIN ENUM
_kMenuItemAttrDisabled = (1 << 0)
_kMenuItemAttrIconDisabled = (1 << 1)
_kMenuItemAttrSubmenuParentChoosable = (1 << 2)
_kMenuItemAttrDynamic = (1 << 3)
_kMenuItemAttrNotPreviousAlternate = (1 << 4)
_kMenuItemAttrHidden = (1 << 5)
_kMenuItemAttrSeparator = (1 << 6)
_kMenuItemAttrSectionHeader = (1 << 7)
_kMenuItemAttrIgnoreMeta = (1 << 8)
_kMenuItemAttrAutoRepeat = (1 << 9)
_kMenuItemAttrUseVirtualKey = (1 << 10)
_kMenuItemAttrCustomDraw = (1 << 11)
_kMenuItemAttrIncludeInCmdKeyMatching = (1 << 12)
END ENUM
'~'8
'~Macro ************************************************************
'~'9
#if ( compilerVersion <= 0x07000000 )
DEF FN CFSTR( pStringP as ^Str255 ) = ¬
FN CFStringCreateWithPascalString( _kCFAllocatorDefault, ¬
#pStringP, _kCFStringEncodingMacRoman )
// R.P. said it already: quick-and-dirty CFSTR; don't use in production code
#endif
'~'8
'~Subroutines *****************************************************
'~'9
LOCAL MODE
LOCAL FN DemoMenu
'~';
DIM AS MenuRef @ rootMenu, theMenu
DIM AS SInt32 @ response
DIM AS MenuItemIndex @ item
DIM AS Boolean osX
osX = _false
/*
Application Menu
*/
IF ( FN CreateNewMenu( 0, 0, @theMenu ) ) THEN EXIT"mE"
IF ( FN SetMenuTitleWithCFString( theMenu, FN CFSTR( "" ) ) ) ¬
THEN
EXIT"mE"' CHR$(0x14)
IF ( FN AppendMenuItemTextWithCFString( theMenu, FN CFSTR( "No About" ), ¬
0, _kHICommandAbout, @item ) ) THEN EXIT"mE"
SetItemCmd( theMenu, item, _"I" )
' compose root menu
IF ( FN CreateNewMenu( 1, 0, @rootMenu ) ) THEN EXIT"mE"
IF ( FN AppendMenuItemTextWithCFString( rootMenu, _nil, 0, 0, ¬
@item ) ) THEN EXIT"mE"
IF ( FN SetMenuItemHierarchicalMenu( rootMenu, item, theMenu ) ) ¬
THEN EXIT"mE"
IF ( FN ReleaseMenu( theMenu ) ) THEN EXIT"mE"
IF ( FN SetRootMenu( rootMenu ) ) THEN EXIT"mE"
/*
File Menu
*/
IF ( FN CreateNewMenu( 2, 0, @theMenu ) ) THEN EXIT"mE"
IF ( FN SetMenuTitleWithCFString( theMenu, FN CFSTR( "File" ) ) ) ¬
THEN EXIT"mE"
IF ( FN AppendMenuItemTextWithCFString( theMenu, FN CFSTR( "Close" ), ¬
_kMenuItemAttrDisabled, _kHICommandClose, @item ) ) THEN EXIT"mE"
SetItemCmd( theMenu, item, _"W" )
IF ( FN Gestalt( _gestaltMenuMgrAttr, @response ) ) THEN EXIT"mE"
LONG IF ( response and _gestaltMenuMgrAquaLayoutMask )
osX = _zTrue
XELSE
IF ( FN AppendMenuItemTextWithCFString( theMenu, _nil, ¬
_kMenuItemAttrSeparator, 0, #_nil ) ) THEN EXIT"mE"
IF ( FN AppendMenuItemTextWithCFString( theMenu, FN CFSTR( "Quit" ), ¬
0, _kHICommandQuit, @item ) ) THEN EXIT"mE"
SetItemCmd( theMenu, item, _"Q" )
END IF
InsertMenu( theMenu, 0 )
/*
Edit Menu
*/
IF ( FN CreateNewMenu( 3, 0, @theMenu ) ) THEN EXIT"mE"
IF ( FN SetMenuTitleWithCFString( theMenu, FN CFSTR( "Edit" ) ) ) ¬
THEN EXIT"mE"
IF ( FN AppendMenuItemTextWithCFString( theMenu, FN CFSTR( "Undo" ), ¬
_kMenuItemAttrDisabled, _kHICommandUndo, @item ) ) THEN EXIT"mE"
SetItemCmd( theMenu, item, _"Z" )
IF ( FN AppendMenuItemTextWithCFString( theMenu, _nil, ¬
_kMenuItemAttrSeparator, 0, #_nil ) ) THEN EXIT"mE"
IF ( FN AppendMenuItemTextWithCFString( theMenu, FN CFSTR( "Cut" ), ¬
_kMenuItemAttrDisabled, _kHICommandCut, @item ) ) THEN EXIT"mE"
SetItemCmd( theMenu, item, _"X" )
IF ( FN AppendMenuItemTextWithCFString( theMenu, FN CFSTR( "Copy" ), ¬
_kMenuItemAttrDisabled, _kHICommandCopy, @item ) ) THEN EXIT"mE"
SetItemCmd( theMenu, item, _"C" )
IF ( FN AppendMenuItemTextWithCFString( theMenu, FN CFSTR( "Paste" ), ¬
_kMenuItemAttrDisabled, _kHICommandPaste, @item ) ) THEN EXIT"mE"
SetItemCmd( theMenu, item, _"V" )
IF ( FN AppendMenuItemTextWithCFString( theMenu, FN CFSTR( "Clear" ), ¬
_kMenuItemAttrDisabled, _kHICommandClear, #_nil ) ) THEN EXIT"mE"
IF ( FN AppendMenuItemTextWithCFString( theMenu, FN CFSTR( "Select All" ), ¬
_kMenuItemAttrDisabled, _kHICommandSelectAll, @item ) ) ¬
THEN EXIT"mE"
SetItemCmd( theMenu, item, _"A" )
InsertMenu( theMenu, 0 )
EXIT FN
"mE"
DIM AS OSStatus dc
DIM AS STR63 message
message = "A fatal error occured during menu setup!"
SysBeep(-1)
dc = FN StandardAlert( _kAlertStopAlert, @message, #_nil, _nil, #_nil )
ExitToShell
END FN = osX
'~'1
LOCAL MODE
LOCAL FN ProgramSetup
'~';
DIM AS EventHandlerUPP applicationEventHandlerUPP
DIM AS OSStatus err
DIM AS EventTypeSpec applicationEvents( _numAppEvtTypes - 1 )
// register application event types
applicationEvents.eventClass( 0 ) = _kEventClassApplication
applicationEvents.eventKind( 0 ) = _kEventAppActivated
applicationEvents.eventClass( 1 ) = _kEventClassCommand
applicationEvents.eventKind( 1 ) = _kEventProcessCommand
// install application event handler
applicationEventHandlerUPP = FN NewEventHandlerUPP¬
( [Proc"ApplicationEventHandler" + _FBprocToProcPtrOffset] )
err = FN InstallEventHandler( FN GetApplicationEventTarget, ¬
applicationEventHandlerUPP, _numAppEvtTypes, ¬
@applicationEvents( 0 ), #_nil, #_nil )
END FN = err
'~'8
'~Main ************************************************************
'~'9
FN DemoMenu
IF ( FN ProgramSetup ) THEN ExitToShell
RunApplicationEventLoop
ExitToShell
'~'8
'~Event Handlers **************************************************
'~'9
"ApplicationEventHandler"
enterproc fn ApplicationEventHandler( eventHandlerCallRef AS
EventHandlerCallRef, ¬
eventRef AS EventRef, userData
AS ^LONG ) = OSStatus
'~';
DIM AS UInt32 eventKind
DIM AS OSStatus result, dc
DIM AS HICommand @ hiCmd
result = _eventNotHandledErr
eventKind = FN GetEventKind( eventRef )
SELECT FN GetEventClass( eventRef )
CASE _kEventClassApplication
Long IF ( eventKind == _kEventAppActivated )
dc = FN SetThemeCursor( _kThemeArrowCursor )
END IF
CASE _kEventClassCommand
LONG if ( eventKind == _kEventProcessCommand )
dc = FN GetEventParameter( eventRef, _kEventParamDirectObject, ¬
_typeHICommand, #_nil, sizeof( HICommand ), #_nil , @hiCmd )
SELECT hiCmd.commandID
CASE _kHICommandQuit
' CarbonEvent default behaviour
CASE _kHICommandAbout
SysBeep(-1)
result = _noErr
END SELECT
END IF
END SELECT
EXITPROC = result
'~'8
'~End *************************************************************
'~'9
//**************************** End of Code *************************