[futurebasic] Re: [FB] How to intercept mouse wheel event in standard handler windows?

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

From: Bernie <fblist@...>
Date: Tue, 26 Jul 2005 15:03:23 +0100
OK, for anyone following this thread, here's an update to the code I  
posted yesterday. It now restricts mouse wheel and trackpad scrolling  
to the active window. As RP suggested, it works best when the handler  
is installed on the control, rather than the window or application.  
I'm not able to check if it still works with a mouse wheel. I'm  
pretty sure it does but perhaps someone can confirm it?

Bernie


'----------
/*
    Restrict mouse wheel and trackpad scrolling to the active window.

    Bernie Wylde  (with assistance from Robert Purves),       26 July  
2005

*/

include "Tlbx CoreGraphics.Incl"
include "Tlbx HIView.Incl"

_kEventTrackpadScrolled = 11


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 InstallControlHandler( c as ControlRef )
'~'1
dim as Handle    @ h
dim as OSStatus    ignore
begin globals
dim as proc sControlEventUPP // 'static' var
end globals
long if ( sControlEventUPP == _nil )
sControlEventUPP = fn NewEventHandlerUPP( [Proc "ControlEventHandler"  
+ _FBprocToProcPtrOffset] )
end if

h = fn NewHandle( 0 )
long if ( h )
'~'<
fn AddEventToHandle( _kEventClassMouse, _kEventMouseWheelMoved, h )
fn AddEventToHandle( _kEventClassMouse, _kEventTrackpadScrolled, h )
'~'<
ignore = fn InstallEventHandler( fn GetControlEventTarget( c ),  
sControlEventUPP, ¬
                                  fn GetHandleSize( h )\\( sizeof 
( EventTypeSpec )), #[h], #0, #0 )
DisposeHandle( h )
end if
end fn


long if 0
"ControlEventHandler"
enterproc fn ControlEventHandler( nextHandler as EventHandlerCallRef,  
theEvent as EventRef, userData as Ptr ) = OSStatus
'~'1
dim as UInt32        eventClass, eventKind
dim as WindowRef   @ w
dim as ControlRef  @ c
dim as OSStatus      ignore, result

result = _eventNotHandledErr

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

select eventClass
case _kEventClassMouse
ignore = fn GetEventParameter( theEvent, _kEventParamWindowRef,  
_typeWindowRef, #0, sizeof( WindowRef ), #0, @w )
select eventKind
case _kEventMouseWheelMoved, _kEventTrackpadScrolled
if ( w != fn GetUserFocusWindow() ) then result = _noErr// don't scroll
end select
end select

exitproc = result
end if


local fn WindowGetContentView( 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 BuildScrollView( w as WindowRef )
'~'1
dim as HIRect       hiRect
dim as Rect         r
dim as ptr          textData, p
dim as HIViewRef  @ scrollView, imageView, contentView
dim as long         size, j, numChars
dim as OSStatus     err
dim as CGImageRef @ outImage

textData = fn NewPtr( 3200 )
size = fn GetPtrSize( textData )
j = 0
p = textData
while ( j < size )
p.nil`` =   _"A" + rnd( _"z" - _"A" ) - 1
j++
p++
wend

SetRect( r, 10, 10, 600, 600 )
appearance button -1,,,,,, @r, _kControlEditTextProc
def SetButtonData( 1, _kControlEditTextPart,  
_kControlEditTextTextTag, size, #textData )
err = fn HIViewCreateOffScreenImage( button&( 1 ), 0, @hiRect,  
outImage )
button close( 1 )

err = fn HIScrollViewCreate 
( _kHIScrollViewOptionsVertScroll_kHIScrollViewOptionsHorizScroll,  
scrollView )
err = fn HIScrollViewSetScrollBarAutoHide( scrollView, _true )
err = fn HIViewSetVisible( scrollView, _true )
err = fn HIViewAddSubview( fn WindowGetContentView( w ), scrollView )

hiRect.origin.x = 20 : hiRect.origin.y = 20
hiRect.size.width = window( _width ) - 40 : hiRect.size.height =  
window( _height ) - 40
err = fn HIViewSetFrame( scrollView, @hiRect )

err = fn HIImageViewCreate( outImage, imageView )
err = fn CGImageRelease( outImage )
err = fn HIViewSetVisible( imageView, _true )

err = fn HIViewAddSubview( scrollView, imageView )

fn InstallControlHandler( scrollView )
end fn


local mode
local fn BuildWnd( wNum as long, rW as ^Rect )
'~'1
dim as Rect  r

r = rW
appearance window -wNum, "Scroll View Demo", @r,  
_kDocumentWindowClass,  
_kWindowStandardHandlerAttribute_kWindowCompositingAttribute_kWindowMeta 
lAttribute
fn BuildScrollView( window( _wndRef ) )

appearance window wNum
end fn


dim as Rect  r

SetRect( r, 40, 50, 400, 400 )
fn BuildWnd( 1, r )

SetRect( r, 420, 50, 780, 400 )
fn BuildWnd( 2, r )

do
HandleEvents
until 0
'----------