Bernie,
Sorry for the repost, I have made a couple of minor changes:
'~'A
' Runtime : Rntm Appearance.Incl
' CPU : Carbon
'~'B
Toolbox Fn SetControlProperty ( ControlRef c, ¬
OSType propertyCreator, ¬
OSType propertyTag, ¬
UInt32 propertySize, ¬
ptr * propertyData ) = OSStatus
Toolbox Fn GetControlProperty ( ControlRef c, ¬
OSType propertyCreator, ¬
OSType propertyTag, ¬
UInt32 bufferSize, ¬
UInt32 * actualSize, ¬
ptr * propertyBuffer ) = OSStatus
if ( system( _sysVers ) < 1000 ) then shutdown "Requires OS X"
include "Tlbx CarbonEvents.incl"
_kAppCreatorCode = _"????"
end globals
Clear Local Mode
Local Fn SetButtonProperty( btnNum As Long, ¬
propType As OSType, ¬
propSize As Long, ¬
@valuePtr As Ptr )
Dim As OSStatus err
'~'<
If ( btnNum < 1 Or propSize < 1 Or valuePtr = _nil ) ¬
Then err = _paramErr : Exit Fn
err = Fn SetControlProperty ( Button&( btnNum ), ¬
_kAppCreatorCode, ¬
propType, ¬
propSize, ¬
#valuePtr )
End Fn = err
Clear Local Mode
Local Fn GetButtonProperty( btnNum As Long, ¬
propType As OSType, ¬
propSize As Long, ¬
@valuePtr As Ptr )
Dim As OSStatus err
'~'<
If ( btnNum < 1 Or propSize < 1 Or valuePtr = _nil ) ¬
Then err = _paramErr : Exit Fn
err = fn GetControlProperty ( Button&( btnNum ), ¬
_kAppCreatorCode, ¬
propType, ¬
propSize, ¬
#_nil, ¬
#valuePtr )
End Fn = err
clear local fn InstallControlDrawHandler(c as long)
'~'1
dim as EventTypeSpec cEvent
dim as ControlRef cRef
dim as OSStatus err
dim as EventHandlerRef @ ctrlEvRef
begin globals
dim as proc sControlEventUPP
end globals
'~'<
cRef = button&(c)
long if (sControlEventUPP == _nil)
sControlEventUPP = fn NewEventHandlerUPP([Proc "CustomDrawControl" +
_FBprocToProcPtrOffset])
end if
cEvent.eventClass = _kEventClassControl
cEvent.eventKind = _kEventControlDraw
err = fn InstallEventHandler(fn GetControlEventTarget(cRef),
sControlEventUPP, 1, @cEvent, #0, ctrlEvRef)
if err == _noErr then err = Fn SetButtonProperty( c, _"evrf",
Sizeof(ctrlEvRef), ctrlEvRef )
end fn = err
Clear Local Mode
Local Fn RemoveControlDrawHandler(c As Long)
Dim As EventHandlerRef @ ctrlEvRef
Dim As OSStatus err
'~'<
Long If Fn GetButtonProperty( c, _"evrf", Sizeof(ctrlEvRef),
ctrlEvRef ) = _noErr
If ctrlEvRef Then err = Fn RemoveEventHandler( ctrlEvRef )
End If
End Fn = err
long if 0
"CustomDrawControl"
enterproc fn CustomDrawControl(nextHandler as EventHandlerCallRef,
theEvent as EventRef, userData as ptr) = OSStatus
dim as Str255 title
dim as ControlRef @ cRef
dim as Rect r
dim as OSStatus ignore, err
dim as CGrafPtr @ oldPort, controlPort
dim as Ptr @ themeState
'~'<
ignore = fn GetEventParameter(theEvent, _kEventParamDirectObject,
_typeControlRef, #0, SizeOf(ControlRef), #0, @cRef)
long if (fn IsControlVisible(cRef))
GetPort(@oldPort)
err = fn GetEventParameter(theEvent, _kEventParamGrafPort,
_typeGrafPtr, #0, SizeOf(CGrafPtr ), #0, @controlPort)
if (err == _noErr) then SetPort(controlPort)
GetControlBounds(cRef, r)
InsetRect(r, -5, -5) : EraseRect(r) : InsetRect(r, 5, 5)
GetControlTitle(cRef, @title)
color _zBlue
def CBox(r, title)
FrameRect(r)
color _zBlack
SetPort(oldPort)
end if
exitproc = _noErr
end if
local fn BuildWindows
dim as Rect r
'~'<
window 1
SetRect(r, 10, 10, 110, 30)
appearance button -1,,,,, "OK", @r, _kControlPushButtonProc
fn InstallControlDrawHandler(1)
button 1
window 2
SetRect(r, 60, 50, 150, 90)
appearance button -99,,,,, "Demo", @r, _kControlPushButtonProc
fn InstallControlDrawHandler(99)
button 99
end fn
local fn DoDialog
dim as long evnt, ref
'~'<
evnt = dialog(0) : ref = dialog(evnt)
select evnt
case _btnClick
dim @ ctrlEvRef as EventHandlerRef
Long If Fn GetButtonProperty( ref, _"evrf", Sizeof(ctrlEvRef),
ctrlEvRef ) = _noErr
long if ctrlEvRef
fn RemoveControlDrawHandler( ref )
ctrlEvRef = 0
Fn SetButtonProperty( ref, _"evrf", Sizeof(ctrlEvRef), ctrlEvRef )
Xelse
fn InstallControlDrawHandler( ref )
end if
end if
DrawOneControl(button&(ref))
case _wndClick : window ref
end select
end fn
on dialog fn DoDialog
fn BuildWindows
do
HandleEvents
until 0
Alain