[futurebasic] Re: [FB] Drag and Drop - Problem with Drag Track Proc

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

From: Rich Love <carnationsoftware@...>
Date: Fri, 17 Dec 2010 04:33:32 -0600
Very nice!

Thanks for everyone's help.
That should get me started

Rich


On Dec 17, 2010, at 2:59 AM, Robert Purves wrote:

> 
> Alain Pastor wrote:
> 
>> Rich Love a écrit :
>>> When you drag any file into the window, it crashes.
>> 
>> <snip>
>> 
>> The following looks incorrect:
>>> #If CarbonLib
>>> gTrackProc = Fn NewDragTrackingHandlerUPP( [gTrackProc] )
>>> gRecvProc  = Fn NewDragReceiveHandlerUPP( [gRecvProc] )
>>> #ENDIF
>> 
>> I don't know why the brackets around gTrackProc and gRecvProc.
> 
> Yes, that's the cause of the crash. But the code is a repository of revolting hacks from FB3/4 and has high entropy from other causes. A cleaned-up version (below) is easier to read, and works.
> 
> Robert P.
> 
> '---------------------------------------
> include "Tlbx DragMgr.incl"
> include "Util_Files.incl"
> 
> begin globals
> dim dynamic    gFiles(_maxInt) as FSSpec // dynamic array of FSSpecs
> dim as proc    gTrackProc, gRecvProc // Drag & Drop procedures
> dim as Boolean gCanAccept
> end globals
> 
> /*
>   This function will grab the content of a given folder
>   and fill up a dynamic gFiles array of FSSpecs. It returns
>   the number of files retrieved.
> */
> local fn GetFilesInFolder( inFSpec as .FSSpec )
> '~'1
> dim as FSSpec      fs
> dim as FileScanRec fsr
> dim as long        nFiles : nFiles = 0
> 
> kill dynamic gFiles // reinitialize the dynamic array
> // FSSpec of dummy file inside folder, to start ScanFolder()
> fn FSMakeFSSpec( inFSpec.vRefNum, inFSpec.parID, ":" + inFSpec.name + ":any", @fs )
> fsr.scanIndex = 0
> fsr.recursive = _false
> do
> fsr.scanSpec = fs
> select fn ScanFolder( fsr )
> case 0 // found a file
> long if ( fsr.fndrFlags and _fInvisible ) // ignore
> xelse
> gFiles(nFiles) = fsr.scanSpec
> nFiles++
> end if
> case 1 // found a folder; ignore
> case else // done
> exit do
> end select
> until 0
> end fn = nFiles
> 
> /*
>   This function displays some info about the files
>   stored in the dynamic gFiles array of FSSpecs
> */
> local fn ShowFiles
> '~'1
> dim as long   numberOfFiles, i
> dim as FSSpec thisSpec
> dim as FInfo  info
> 
> numberOfFiles = fn DynamicNextElement( dynamic ( gFiles ) )
> print "numberOfFiles = " numberOfFiles
> long if ( numberOfFiles )
> for i = 0 to numberOfFiles - 1
> thisSpec = gFiles(i) ' copy spec from dynamic array to local FSSpec
> fn FSpGetFInfo( thisSpec, @info )
> print thisSpec.name, mki$( info.fdType ), mki$( info.fdCreator )
> next
> end if
> end fn
> 
> 
> /*
>   This function tells if a given FSSpec refers to a folder
> */
> local mode
> local fn IsFSSpecFolder( fSpec as .FSSpec )
> '~'1
> dim as Boolean    wasAlis, isFolder : isFolder = _false
> 
> fn ResolveAliasFile( #fSpec, _false, @isFolder, @wasAlis )
> end fn = isFolder
> 
> /*
>   This function is called when an item is dropped in
>   the main's window content area.
> */
> local fn DNDrecvProc( wPtr as WindowRef, refCon as ptr, theDrag as DragRef )
> '~'1
> dim as OSStatus     result : result = _userCanceledErr
> dim as DragItemRef  theItem
> dim as Size         size
> dim as HFSFlavor    flavor
> 
> fn HideDragHilite( theDrag )
> if gCanAccept == _false then exit fn
> size = sizeof( HFSFlavor )
> if fn GetDragItemReferenceNumber( theDrag, 1, @theItem ) then exit fn
> if fn GetFlavorData( theDrag, theItem, _"hfs ", @flavor, @size, 0 ) then exit fn
> long if ( fn IsFSSpecFolder( flavor.fileSpec ) )
> fn GetFilesInFolder( flavor.fileSpec ) // fill up a dynamic array of FSSpecs
> fn ShowFiles // display info about the array of files
> result = _noErr
> end if
> end fn = result
> 
> /*
>   This function is called during a drag operation
> */
> local fn DNDtrackProc( dragMsg as DragTrackingMessage, wPtr as WindowRef, refCon as ptr, theDrag as DragRef )
> '~'1
> dim as RgnHandle        tmpRgn
> dim as DragItemRef      theItem
> dim as Size             size
> dim as UInt16           itemCount
> dim as HFSFlavor        flavor
> dim as Rect             r
> 
> select dragMsg
> case _kDragTrackingEnterWindow, _kDragTrackingLeaveWindow
> gCanAccept = _false
> long if fn CountDragItems( theDrag, @itemCount ) == _noErr
> long if itemCount // at least 1 item
> long if ( _noErr == fn GetDragItemReferenceNumber( theDrag, 1, @theItem ) )
> size = sizeof( HFSFlavor )
> long if ( _noErr == fn GetFlavorData( theDrag, theItem, _"hfs ", @flavor, @size, 0 ) )
> gCanAccept = fn IsFSSpecFolder( flavor.fileSpec )
> exit "DNDDone"
> end if
> end if
> end if
> end if
> "DNDDone"
> long if gCanAccept
> fn GetPortBounds( fn GetWindowPort( wPtr ), @r )
> tmpRgn = fn NewRgn
> RectRgn( tmpRgn, r )
> fn ShowDragHilite( theDrag, tmpRgn, (dragMsg == _kDragTrackingEnterWindow) )
> DisposeRgn( tmpRgn )
> 
> long if dragMsg == _kDragTrackingEnterWindow
> cursor _plusCursor
> xelse
> cursor _arrowCursor
> end if
> end if
> end select
> 
> end fn = _noErr
> 
> 
> /*
>   This function installs the tracking and receive procedures
>   in the main window.
> */
> local fn InstallDD( wnd as long )
> '~'1
> dim as WindowRef  wPtr 
> 
> get window wnd, wPtr
> long if ( wPtr )
> gTrackProc = @fn DNDtrackProc
> gRecvProc  = @fn DNDrecvProc
> long if fn InstallTrackingHandler( gTrackProc, wPtr, #_nil ) == _noErr
> long if fn InstallReceiveHandler( gRecvProc, wPtr, #_nil ) != _noErr
> fn RemoveTrackingHandler( gTrackProc, wPtr )
> end if
> end if
> end if
> end fn
> 
> /*
>   This function remove the tracking and receive procedures
>   installed in the main window.
> */
> local fn RemoveDD( wnd as long )
> '~'1
> dim as WindowRef  wPtr 
> 
> get window wnd, wPtr
> long if ( wPtr )
> fn RemoveTrackingHandler( gTrackProc, wPtr )
> fn RemoveReceiveHandler( gRecvProc, wPtr )
> end if
> end fn
> 
> 
> '~Main
> 
> window 1, "Drag a Folder on me"
> fn InstallDD( 1 ) // install Drag & Drop in window #1
> do
> HandleEvents
> until gFBQuit
> '---------------------------------------
> 
> --
> To unsubscribe, send ANY message to: futurebasic-unsubscribe@...
> 


Rich Love - Carnation Software
Get 'Say it & Mail it' for iPhone
http://www.SayitMailit.com

MacWise Terminal emulation for Macintosh
http://www.CarnationSoftware.com
Twitter - http://twitter.com/CarnationSW
Email - RichLove@...
512 858-9234
















Attachments: