[futurebasic] Re: [FB] Installing and removing control event handler

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

From: Alain Pastor <apastor@...>
Date: Sat, 11 Sep 2004 01:18:53 +0200
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