[futurebasic] Re: [FB] Mouse still down in control (CE)

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : December 2005 : Group Archive : Group : All Groups

From: Bernie <fblist@...>
Date: Sun, 4 Dec 2005 00:28:04 +0000
Steve Crossman wrote:

> Bernie,
>
> The bane of CE for me has been mouse event detection.  Mouse down,  
> up, outside of anything but a control was something I could never  
> achieve.  This was in a composite window.
>
> I think Robert P. had posted some examples on the list before. I  
> will see if I can find it.
>
>
> On Dec 3, 2005, at 7:11 AM, Bernie wrote:
>
>>
>> Using carbon events, I want to detect when the mouse button is  
>> held down in the little arrows control. I'm not getting anywhere  
>> with mouse tracking and control tracking but I think I've done  
>> something similar by installing a carbon timer.
>>
>> Can someone point me in the right direction?
>>


Thanks Steve, Ken & SVV.

Here's some sample code to show the problem. It needs OS X 10.4 and  
the recently updated Tlbx HIView.incl header:


'----------
include "Tlbx HIView.incl"

//include "Tlbx ControlDefinitions.incl"
_kControlLittleArrowsIncrementValueTag = _"incr"
toolbox fn CreateLittleArrowsControl( WindowRef window, ¬
                                const Rect * boundsRect, ¬
                                           SInt32 value, ¬
                                         SInt32 minimum, ¬
                                         SInt32 maximum, ¬
                                       SInt32 increment, ¬
                                ControlRef * outControl ) = OSStatus

toolbox fn CreateStaticTextControl( WindowRef window, ¬
                              const Rect * boundsRect, ¬
                                     CFStringRef text, ¬
                    const ControlFontStyleRec * style, ¬
                              ControlRef * outControl ) = OSStatus

_MyWindow = 1
begin enum 1
_cArr
_cStat
end enum


local fn GetWindowContentView( w as WindowRef )
'~'1
dim as HIViewRef  @ contentView
dim as OSStatus     ignore

contentView = 0
ignore = fn HIViewFindByID( fn HIViewGetRoot( w ), ¬
                  kHIViewWindowContentID.signature, ¬
            kHIViewWindowContentID.id, contentView )
end fn = contentView


local mode
local fn LittleArrowsClick( c as HIViewRef, partCode as  
ControlPartCode )
'~'1
dim as SInt32    oldVal, newVal, min, max, @ increment
dim as OSStatus  ignore

oldVal = fn HIViewGetValue( c )
min    = fn HIViewGetMinimum( c )
max    = fn HIViewGetMaximum( c )
long if ( fn GetControlData( c, _kControlNoPart, ¬
        _kControlLittleArrowsIncrementValueTag, ¬
               sizeof( SInt32 ), increment, #0 ) )
increment = 1
end if

select partCode
case _kControlUpButtonPart
newVal = oldVal + increment
if ( newVal > max ) then newVal = max
case _kControlDownButtonPart
newVal = oldVal - increment
if ( newVal < min ) then newVal = min
end select

if ( newVal != oldVal ) then ignore = fn HIViewSetValue( c, newVal )
end fn = newVal


local mode
local fn AddEventToHandle( eventClass as UInt32, ¬
              eventKind as UInt32, h as Handle )
'~'1
dim as EventTypeSpec evnt

evnt.eventClass = eventClass
evnt.eventKind  = eventKind
end fn = fn PtrAndHand( @evnt, h, sizeof( EventTypeSpec ) )


local fn InstallControlEvents( c as HIViewRef )
'~'1
dim as Handle    @ eventH
dim as OSStatus    ignore
begin globals
   dim as pointer   sControlEventHandlerUPP
end globals
long if ( sControlEventHandlerUPP == 0 )
sControlEventHandlerUPP = fn NewEventHandlerUPP( ¬
[proc "ControlEventHandler" + _FBprocToProcPtrOffset] )
end if

eventH = fn NewHandle( 0 )
long if ( eventH )
'~'<
fn AddEventToHandle( _kEventClassControl, ¬
              _kEventControlClick, eventH )
fn AddEventToHandle( _kEventClassControl, ¬
_kEventControlValueFieldChanged, eventH )
'~'<
ignore = fn InstallEventHandler( fn GetControlEventTarget( c ), ¬
                                        sControlEventHandlerUPP, ¬
        fn GetHandleSize( eventH )\\( sizeof( EventTypeSpec ) ), ¬
                                              #[eventH], #0, #0 )
DisposeHandle( eventH )
end if
end fn


long if ( 0 )
"ControlEventHandler"
enterproc fn ControlEventHandler( handler as EventHandlerCallRef, ¬
                          evnt as EventRef, userData as pointer ) =  
OSStatus
'~'1
dim as UInt32       eventClass, eventKind
dim as HiViewRef  @ c
dim as long         result
dim as OSStatus     ignore

result = _eventNotHandledErr

eventClass = fn GetEventClass( evnt )
eventKind  = fn GetEventKind( evnt )

ignore = fn GetEventParameter( evnt, _kEventParamDirectObject, ¬
             _typeControlRef, #0, sizeof( ControlRef ), #0, @c )

select eventClass
case _kEventClassControl
select eventKind
case _kEventControlClick
'~'<
dim as HIRect          @ hiRect
dim as HIPoint         @ hiPt
dim as point           @ pt
dim as HIViewPartCode  @ partCode

ignore = fn GetEventParameter( evnt, _kEventParamWindowMouseLocation, ¬
                       _typeHIPoint, #0, sizeof( HIPoint ), #0, @hiPt )
ignore = fn HIViewGetFrame( c, @hiRect )
hiPt.x -= hiRect.origin.x
hiPt.y -= hiRect.origin.y + hiRect.size.height
ignore = fn HIViewGetPartHit( c, hiPt, @partCode )
fn LittleArrowsClick( c, partCode )

case _kEventControlValueFieldChanged
'~'<
dim as Str255  s

s = str$( fn HIViewGetValue( c ) )
ignore = fn HIViewFindByID( fn GetWindowContentView( ¬
             fn GetControlOwner( c ) ), 0, _cStat, c )
ignore = fn HIViewSetText( c, fn CFSTR( s ) )

end select
end select
exitproc = result
end If


local mode
local fn BuildMyWindow
'~'1
dim as Str255                 s
dim as ControlFontStyleRec    cfs
dim as Rect                   r
dim as SInt32                 value
dim as WindowAttributes       wa
dim as WindowRef            @ w
dim as HIViewRef            @ c
dim as OSStatus               ignore

wa = _kWindowStandardHandlerAttribute _kWindowCompositingAttribute

SetRect( r, 195, 177, 545, 352 )
ignore = fn CreateNewWindow( _kDocumentWindowClass, wa, @r, w )
ignore = fn SetWindowTitleWithCFString( w, fn CFSTR( "My Window" ) )

value = 50
SetRect( r, 189, 76, 202, 98 )
ignore = fn CreateLittleArrowsControl( w, @r, value, 0, 100, 3, c )
ignore = fn HIViewSetID( c, 0, _cArr )
fn InstallControlEvents( c )

SetRect( r, 147, 78, 183, 94 )
cfs.flags = _kControlUseJustMask
cfs.just = _teJustRight
s = str$( value )
ignore = fn CreateStaticTextControl( w, @r, fn CFSTR( s ), cfs, c )
ignore = fn HIViewSetID( c, 0, _cStat )

ShowWindow( w )
end fn


fn BuildMyWindow

RunApplicationEventLoop()
'----------