[futurebasic] PICT drag and drop (code 2)

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

From: Robert Covington <artlythere@...>
Date: Wed, 24 Sep 2003 10:23:29 -0400
Shorter, improved Pict D&D  version (I hope), with no offset of dropped 
image, moved all to Mouse loop, no more Kazillion samples of the same 
handle.

Removed more unneeded items and corrected FN names here and there.

Robert


// Begin FB3 Program, beware email line wrap and lost constant 
underscores

'~'A
'                       Runtime : Rntm Appearance.Incl
'                      Debugger : Off
'               DIM'd Vars Only : On
'              No Re-DIM'd Vars : On
'                    CALL Req'd : Off
'                 Register Vars : On
'~'B

/*
  Originally:
Robert P.   15 October 2001
Alain P.    24 July 2002 (revised for IsWindowCollapsed that crashed in 
PPC, and
             SavePanePenState & RestorePanePenState seem to have 
disappeared from the runtime

(RC: The above pane-in-the-neck may no longer apply, I might have 
whacked those areas)

Today, this morning, this cosmic time:

Robert Covington, 24 September 2003 : Trashed it all to make a PICT 
Drag and drop.
Changed things all over, whacked all the Text  specific stuff .
Note: PPC will leave a cursor trail in the hilited image when using 
non-ghosted dragging.
( Same problem is in the original) Also leaves the pict image darker in 
that case (?)
This baby works best in OS X I can see.

  RC Phase 2: Got rid of too-many-sampling On Event approach, moved all 
to mouse loop.
More cleanup.
*/

#if ndef _appearanceRuntime
compile shutdown "Must be compiled as Appearance Compliant ¬
(or as an Appearance project)"
#endif
Include "Tlbx DragMgr.Incl"

'~'1
// These 3 are part of a forthcoming Carbon compatibility header file 
"QD Accessors.Incl"
// They can be removed when that file becomes official. In Carbon they 
will be Toolbox routines.
override local fn GetPortBitMapForCopyBits( port as ptr )
end fn = port + 2

override local fn GetPortVisibleRegion( port as .CGrafPort, visRgn as 
RgnHandle )
if visRgn then CopyRgn( port.visRgn, visRgn )
end fn = visRgn

include "Tlbx DragMgr.Incl"
include "Tlbx Files.Incl"

_evntOptionKey  =  0x0800
_crsrCopy       = -20486

// Cheap Phony Selection Rect. Use a Global Rect in real life, don't be 
a weirdo. :)
_sLeft   = 20
_sTop    = 20
_sRight  = 120
_sBottom = 80

_myFlavor = _"PICT" // this demo works only for Picts


Toolbox fn AECoerceDesc( AEDesc * theAEDesc, DescType toType, ¬
AEDesc * result ) = OSErr

begin record DragSupportRecord
dim present       as boolean
dim floatingWnd   as boolean
dim PPCDragLib    as boolean
dim imageSupport  as boolean
dim startInFloat  as boolean
dim imageUpdates  as boolean
dim dragInContent as boolean
dim canAccept     as boolean
dim trackRgn      as RgnHandle
dim sourceRgn     as RgnHandle
end record


dim gMyDragSupportRecord as DragSupportRecord

Dim gTrackProc   as Proc
Dim gReceiveProc as Proc

DIM gOriginPt    as Point // Actually, an offset, not the origin

end globals



'~Functions called by track and receive

local mode
dim @ mseDwnMod  as short
dim @ mseUpMod   as short
dim @ modifiers  as short
local fn IsCopy( theDrag as DragRef, endOfDrag as boolean)
'~'1
modifiers = 0
// test the option key down
long if ( fn GetDragModifiers( theDrag, modifiers, mseDwnMod, mseUpMod 
) ¬
== _noErr )
// when do we want to test?
long if endOfDrag
modifiers = modifiers or mseUpMod
xelse
modifiers = modifiers or mseDwnMod
end if
end if
end fn = ( (modifiers and _evntOptionKey) == _evntOptionKey )


local mode
dim @ attributes as DragAttributes
dim osErr        as OSErr
local fn IsDragInSameWnd( theDrag as DragRef )
'~'1
attributes = 0
osErr = fn GetDragAttributes( theDrag, attributes )
end fn = ( (attributes and _kDragInsideSenderWindow) != 0 )


// return TEHandle of edit field under mouse, or 0 if not over
// also return background color of EF pane
Clear local
dim   pictH    as handle
local fn PictHandleUnderMouse( thePt as point, theW as WindowRef )
DIM myRect as rect
// Use a global rect in Real life. Globals are your pal here.
setRect(myRect,_sLeft,_sTop,_sRight,_sBottom) // Generic Selection Rect
pictH = USR GETPICT(myRect)
  end fn = pictH


'~Functions called by track proc


local mode
dim   offsetPt      as point
dim   osErr         as OSErr
dim   imagePixMap   as ..PixMap
dim @ theGW         as CGrafPtr
dim @ oldPort       as CGrafPtr
dim @ oldDevice     as GDHandle
dim   r             as rect
dim visRgn          as RgnHandle
dim rgnBounds       as rect
local fn MakePictureImage( theDrag    as DragRef,¬
                              theRgn     as RgnHandle,¬
                              theMaskRgn as RgnHandle,¬
                              thePt      as point,¬
                              theW       as WindowRef )
'~'1
// clip to the window's vis rgn
visRgn = fn NewRgn
visRgn = fn GetPortVisibleRegion( fn GetWindowPort( theW ), visRgn )
SectRgn( theRgn, visRgn, theRgn )

//osErr = fn GetRegionBounds( theRgn, rgnBounds )
//r = rgnBounds
r;8 = fn GetRegionBounds( theRgn, rgnBounds )
OffsetRect( r, -rgnBounds.left, -rgnBounds.top )
GetGWorld( oldPort, oldDevice )
osErr = fn NewGWorld( theGW, 8, r, _nil, _nil, _useTempMem )
if osErr then osErr = fn NewGWorld( theGW, 8, r, _nil, _nil, 0 )
long if( osErr == _noErr)
SetGWorld( theGW, 0 )
EraseRect( r )
imagePixMap = fn GetGWorldPixMap( theGW )
osErr       = fn LockPixels( imagePixMap )
'~'2
CopyBits( #fn GetPortBitMapForCopyBits( oldPort ), ¬
#fn GetPortBitMapForCopyBits( theGW ), rgnBounds, r, _srcCopy, _nil )
'~'2
UnlockPixels( imagePixMap)
SetGWorld( oldPort, oldDevice )
CopyRgn( theRgn, theMaskRgn )
OffsetRgn( theMaskRgn, -rgnBounds.left, -rgnBounds.top )
SetPt( offsetPt, rgnBounds.left, rgnBounds.top )
LocalToGlobal( offsetPt )
'~'2
osErr = fn SetDragImage( theDrag, imagePixMap, theMaskRgn, offsetPt,¬
  _kDragStandardTranslucency )
'~'2
end if

end fn = theGW



// cursor routine ripped (with minor change) from runtime
local
dim crsrHndl   as handle
dim osStatus   as OSStatus
dim anim       as long
dim oldState   as byte
local fn SetMyCursor( crsrID as long )
'~'1
long if crsrID != gFBLastCursor

gFBLastCursor = crsrID // for System(_lastCurs)

crsrHndl = fn GetCCursor( crsrID ) // try color first
long if crsrHndl
oldState = fn HGetState( crsrHndl )
HNoPurge( crsrHndl )
SetCCursor( crsrHndl )
HSetState( crsrHndl, oldState )
DisposeCCursor( crsrHndl )
xelse
crsrHndl = fn GetCursor( crsrID ) // try plain
long if crsrHndl
oldState = fn HGetState( crsrHndl )
HLock( crsrHndl )
SetCursor( #[crsrHndl] )
HSetState( crsrHndl, oldState )
xelse
InitCursor
end if
end if
end if
end fn


/*     This returns _zTrue if the window is not shaded
        and thus the calling routine can continue
*/
#if CarbonLib
def fn IsThisWndNotShaded( theW as WindowRef ) = ( fn 
IsWindowCollapsed( theW ) == _false )
#else// prevent a bug in PPC 'Alain   ( 10/07/02 }
def fn IsThisWndNotShaded( theW as .CWindowRecord ) = ( fn EmptyRgn( 
theW.contRgn ) == _false )
#endif


local mode
local fn AddFlavoredData( theDrag as DragRef, theTEH as ..TERec, 
theFlavor as OSType )
'~'1
end fn = fn AddDragItemFlavor( theDrag, 1, theFlavor, #[theTEH], FN 
GetHandleSize(theTEH), 0 )


/*     returns _zTrue if the flavor is available
        or _false if not
*/
local mode
dim @ itemRef         as DragItemRef
dim @ currFlavorFlags as FlavorFlags
dim @ nItems          as short
dim   i               as short
dim   result          as boolean
local fn IsDMTypeAvailable( theDrag as DragRef, theFlavor as OSType )
'~'1
result = _badDragFlavorErr // default
long if ( fn CountDragItems( theDrag, nItems ) == _noErr ) // count how 
many items in drag
long if nItems// we have at least one item - walk through and see
for i = 1 to nItems
// get the reference number for each item
long if ( fn GetDragItemReferenceNumber( theDrag, i, itemRef) == _noErr 
)
// what flavor?
result = ( fn GetFlavorFlags( theDrag, itemRef, theFlavor, 
currFlavorFlags ) == _noErr )
if result then exit for
end if
next
end if
end if
end fn = result



local mode
dim   pictH      as Handle
dim   myRect   as rect
local fn DoTrackPictItemUnderMouse( theDrag as DragRef, thePt as point, 
w as WindowRef, dragSupport as .DragSupportRecord )
'~'1
long if fn IsThisWndNotShaded( w)
// look at DragInContent - if true we've already been here
long if dragSupport.dragInContent
// are we still in content? - if yes, do nothing
long if ( fn PtInRgn( thePt, dragSupport.trackRgn ) == _false)
// no longer in region - hide it and change record
dragSupport.dragInContent = _false
end if
end if
// now look again see if in the nab region?
long if ( dragSupport.dragInContent == _false)
pictH = fn PictHandleUnderMouse( thePt, w  )
long if pictH
// Use a global rect in Real life. Globals are your pal here.
setRect(myRect,_sLeft,_sTop,_sRight,_sBottom)
RectRgn( dragSupport.trackRgn, myRect ) // create the region
dragSupport.dragInContent = _zTrue // set the record straight
end if
end if
end if
end fn

clear local mode
dim   result       as OSErr
dim   dropSpec     as AEDesc
dim   spec         as FSSpec
dim   paramB       as CInfoPBRec
dim @ trashVRefNum as short
dim @ trashDirID   as long
local fn IsDropLocationFinderTrash( theDropLocation as .AEDesc )
'~'1
// Coerce the dropLocation descriptor to an FSSpec.
// If there's no dropLocation or it can't be coerced into
// an FSSpec, then it couldn't have been the Trash.
result = _false
'~'1
long if ( ( theDropLocation.descType != _typeNull) and (fn 
AECoerceDesc( #theDropLocation,¬
  _typeFSS, dropSpec) == _noErr) )
'~'1

blockmove [dropSpec.dataHandle], @spec, sizeof( FSSpec )
// Get the directory ID of the given dropLocation object.
paramB.ioNamePtr = @spec.name
paramB.ioVRefNum = spec.vRefNum
paramB.ioDrDirID = spec.parID
long if ( fn PBGetCatInfosync( paramB ) == _noErr)
// HUnlock( dropSpec.dataHandle)
long if ( fn AEDisposeDesc( dropSpec ) == _noErr)
// If the result is not a directory, can't be the Trash.
long if ( paramB.ioFlAttrib and bit( 4 ) )
// Get information about the Trash folder.
'~'2
long if ( fn FindFolder( spec.vRefNum, _kTrashFolderType, ¬
_kCreateFolder, trashVRefNum, trashDirID ) == _noErr )
'~'2
// If the directory ID of the dropLocation object is same
// as the directory ID returned by FindFolder, then the
// drop must have occurred into the Trash. cqfd.
result = ( paramB.ioDrDirID == trashDirID )
end if
end if
end if
end if
end if
end fn = result


local
dim @ oldPort       as CGrafPtr
dim   mousePt       as point
dim   pinnedMousePt as point
dim   newCrsr       as long
dim   result        as short
dim   osErr         as OSErr
'~'2
local fn DragTrackPictProc( theDragMsg as short, theDragW as WindowRef, 
¬
theDragRefCon as long, theDrag as DragRef )
'~'1
// set port + clip
GetPort( oldPort )
SetPortWindowPort( theDragW )

// do we need copy cursor
newCrsr = system( _lastCurs )
if ( fn IsCopy( theDrag, _false ) ) then newCrsr = _crsrCopy else 
newCrsr = 0

select theDragMsg
case _kDragTrackingEnterHandler
// set up any needed memory here
// zero variables
gMyDragSupportRecord.dragInContent = _false
gMyDragSupportRecord.canAccept = _false
// prepare region
gMyDragSupportRecord.trackRgn  = fn NewRgn
case _kDragTrackingEnterWindow
// can we accept
'~'2
if fn IsDMTypeAvailable( theDrag, _myFlavor ) then ¬
gMyDragSupportRecord.canAccept = _zTrue
'~'2
case _kDragTrackingInWindow
// can we do something with the drag,
long if gMyDragSupportRecord.canAccept
long if ( fn GetDragMouse( theDrag, mousePt, pinnedMousePt) == _noErr )
// mousepoint is in global coords, transpose to this window
fn GlobalToLocal( mousePt )
// now track the mouse in this window
'~'2
fn DoTrackPictItemUnderMouse( theDrag, mousePt, theDragW,¬
  gMyDragSupportRecord )
'~'2
end if
end if
case _kDragTrackingLeaveWindow
//  erase hilighting
long if ( gMyDragSupportRecord.canAccept and 
gMyDragSupportRecord.dragInContent )
osErr = fn HideDragHilite( theDrag )
end if
// zero variables
gMyDragSupportRecord.dragInContent = _false
gMyDragSupportRecord.canAccept     = _false
// fix crsr - no longer our business
newCrsr = 0
case _kDragTrackingLeaveHandler
long if ( gMyDragSupportRecord.canAccept and 
gMyDragSupportRecord.dragInContent )
osErr = fn HideDragHilite( theDrag )
end if
// zero variables
gMyDragSupportRecord.dragInContent = _false
gMyDragSupportRecord.canAccept = _false
// dispose of regions
long if gMyDragSupportRecord.trackRgn
DisposeRgn( gMyDragSupportRecord.trackRgn )
gMyDragSupportRecord.trackRgn = 0
end if
// fix crsr - no longer our business
newCrsr = 0
end select
// crsr business
if ( newCrsr != system( _lastCurs) ) then fn SetMyCursor( newCrsr )
// clear up
SetPort(  oldPort)
end fn = result




clear local
dim   pictH        as Handle
dim @ myRgn        as RgnHandle
dim @ dragRgn      as RgnHandle
dim @ maskRgn      as RgnHandle
dim   rgnBounds    as rect

dim @ myEvnt       as .EventRecord
dim @ oldPort      as pointer
dim @ w            as WindowRef
dim   imageGWorld  as CGrafPtr
dim @ dropLocation as AEDesc
dim   globalPt     as point
dim   localPt      as point
dim @ myDrag       as DragRef
dim   osErr        as OSErr
local fn DoTrackPictDrag
// copy in the event and mousePoint
myEvnt   = event
globalPt = myEvnt.where

// look for a window
if ( fn FindWindow( globalPt,w) != _inContent ) then exit fn
// need a window and inContent and not shaded
if ( fn IsThisWndNotShaded( w) == _false ) then exit fn

// port stuff
GetPort( oldPort)
SetPortWindowPort( w )
// change points
localPt = globalPt
GlobaltoLocal( localPt )
// prepare region
myRgn  = fn NewRgn
if ( myRgn == 0 ) then exit fn

DIM myRect as rect
// Use a global rect in Real life. Globals are your pal here.
setRect(myRect,_sLeft,_sTop,_sRight,_sBottom)
RectRgn(myRgn,myRect)

long if fn PtInRgn( localPt, myRgn )

long if fn WaitMouseMoved( globalPt )
  pictH = fn PICTHandleUnderMouse( localPt, w )
// did we get the handle?
long if pictH

gOriginPt = localPt
gOriginPt.h%  = gOriginPt.h% - _sLeft
gOriginPt.v% = gOriginPt.v%  - _sTop

// create a drag reference
if fn NewDrag( myDrag) then exit "DoTrackPictDragCleanUp"

// add the flavor
'~'2
if fn AddFlavoredData( myDrag, pictH, _myFlavor ) then ¬
exit "DoTrackPictDragCleanUp"
'~'2

// prepare region
dragRgn = fn NewRgn
maskRgn = fn NewRgn

// do we get regions?
'~'2
if ( ( dragRgn == 0) or ( maskRgn == 0) ) then ¬
exit "DoTrackPictDragCleanUp"
'~'2

// back up the drag region
CopyRgn( myRgn, dragRgn )
// is there ghost image support?
long if gMyDragSupportRecord.imageSupport
imageGWorld = fn MakePictureImage( myDrag, dragRgn, maskRgn, globalPt, 
w )
xelse
// create the drag outline
InsetRgn( dragRgn, 1, 1 )
DiffRgn( myRgn, dragRgn, myRgn )
end if
// make hilite region global

setPt(localPt,0,0)
LocalToGlobal( localPt )
OffsetRgn( myRgn, localPt.h%, localPt.v% )
DisposeRgn( dragRgn )
/*
Consolidated setting of the bounds rect is used below
This is what it does:
fn GetRegionBounds( myRgn, rgnBounds )
long if ( fn SetDragItemBounds( myDrag, 1, rgnBounds ) == _noErr )
*/
'~'2
long if ( fn SetDragItemBounds( myDrag, 1, #fn GetRegionBounds( myRgn, 
rgnBounds )¬
   ) == _noErr )
'~'2

long if ( fn TrackDrag( myDrag, #myEvnt, myRgn) == _noErr )
// was this taken to trash?
long if ( fn GetDropLocation( myDrag, dropLocation)  == _noErr )
// adjust if this was a move
'~'2
long if (( fn isCopy( myDrag, _zTrue ) == _false ) and ¬
fn IsDropLocationFinderTrash( dropLocation) )
'~'2
if PictH then KillPicture(pictH)
xelse
// Regular selection drag, move along
end if
end if
end if
end if
end if
// we got a drag - kill FB event
myEvnt.what = 0
end if

End if

"DoTrackPictDragCleanUp"
cursor _arrowCursor
// restore previous port
SetPort( oldPort)

// clean up
if ( myRgn )        then DisposeRgn( myRgn )
if ( myDrag )       then osErr = fn DisposeDrag( myDrag )
if ( imageGWorld )  then DisposeGWorld( imageGWorld )
if ( maskRgn )      then DisposeRgn( maskRgn )
if ( dropLocation ) then osErr = fn AEDisposeDesc( dropLocation )

end fn



'~Functions called by receive proc

local mode
local fn DecideMakeDropWindowFront( theW as WindowRef, theDrag as 
DragRef )
// if drag starts and finishes in non-active wnd then bring to front
// RC : corrected boolean check to make this work...
if ( fn IsDragInSameWnd( theDrag ) == _False) then window USR 
WPtr2WNum( theW )
end fn



Clear Local
dim @ oldPort as ptr
DIM dRect as Rect
local fn DoInsertPictAtPoint(  pictData as handle , thePt as point, 
theW as WindowRef )
'~'1
GetPort( oldPort)
SetPortWindowPort( theW )
long if pictData
dRect = [pictData] + _PicFrame // we sure hope that this is a Pict 
handle. ;)
offsetRect(dRect, -dRect.left%,-dRect.top%)
offsetRect(dRect,thePt.h%,thePt.v%)

offsetRect(dRect,-gOriginPt.h%,-gOriginPt.v%) // Original Offset 
restored.

long if FN emptyRect(dRect) = _False
DrawPicture(pictData,dRect)
Text _geneva, 9
Moveto(dRect.left% + 10,dRect.top% + 52)
Print "Can't drag me."
End if
End if
SetPort( oldPort )
end fn


local
dim @ itemRef         as DragItemRef
dim @ currFlavorFlags as FlavorFlags
dim @ dataSize        as long
dim @ myData          as handle
dim   mousePt         as point
dim   pinnedMousePt   as point
dim   result          as OSErr
dim @ nItems          as short
dim   i               as short
dim   osErr           as OSErr
'~'1
local fn DragRecvPictProc( theDragW as WindowRef, theDragRefCon as 
long, ¬
theDrag as DragRef )
'~'1
result = _dragNotAcceptedErr // default error
long if gMyDragSupportRecord.dragInContent
// get the drag/drop point
long if ( fn GetDragMouse( theDrag, mousePt, pinnedMousePt ) == _noErr )
// special check  - did the user drop in drag rgn? if yes -> cancel
GlobalToLocal( mousePt)
// did the user drop on original drag region? - then cancel
'~'1
if ( ( fn IsDragInSameWnd( theDrag ) ) and ( fn PtInRgn( mousePt, ¬
gMyDragSupportRecord.sourceRgn ) != _false ) ) then exit fn
'~'1

// get the number of items
osErr = fn CountDragItems( theDrag, nItems )
// did the goods get here without breaking?
long if ( ( osErr == _noErr) and nItems )
// we have at least one item - walk through and see
for i = 1 to nItems
// get the items by ref
long if ( fn GetDragItemReferenceNumber( theDrag, i, itemRef) == _noErr 
)
// is this my own internal drag flavor?

'~'1
long if ( fn GetFlavorFlags( theDrag, itemRef, _myFlavor, ¬
currFlavorFlags ) == _noErr )
'~'1
// get the content size
'~'1
long if ( fn GetFlavorDataSize( theDrag, itemRef, _myFlavor, ¬
dataSize ) == _noErr )
'~'1
// make a container for the data
myData = fn NewHandle( dataSize )
long if myData
HLock( myData )
// get the content
'~'2
long if ( fn GetFlavorData( theDrag, itemRef, _myFlavor,¬
  #[myData], dataSize, 0 ) == _noErr )
'~'2
// hide the drag region
// RC: Needed anymore??
long if ( fn HideDragHilite( theDrag) == _noErr )
// insert the data at the selection point
fn DoInsertPictAtPoint( myData, mousePt, theDragW )
fn DecideMakeDropWindowFront( theDragW, theDrag )
result = _noErr // set return value
end if
end if
// start cleaning
HUnlock( myData )
DisposeHandle( myData )
end if
end if
end if
end if
next
end if
end if
end if
end fn = result



'~Install/remove the handlers

// WindowRef 0 means install (or remove) for all windows

/*     this will return _noErr if all ok
        any other value means there was an error
*/


local fn InstallPICTHandler( w as WindowRef, theHandlerRefCon as long )
'~'1
dim osErr as OSErr
gTrackProc   = proc "DragTrackPictProc"
gReceiveProc = proc "DragRecvPictProc"
#if CarbonLib
gTrackProc = fn NewDragTrackingHandlerUPP([gTrackProc + 
_FBprocToProcPtrOffset])
gReceiveProc = fn NewDragReceiveHandlerUPP([gReceiveProc + 
_FBprocToProcPtrOffset])
#endif
osErr = fn InstallTrackingHandler( gTrackProc, w, #theHandlerRefCon )
// all went ok - continue
long if ( osErr == _noErr )
osErr = fn InstallReceiveHandler( gReceiveProc, w, #theHandlerRefCon )
xelse// oops! error - uninstall
osErr = fn RemoveTrackingHandler( gTrackProc, w ) : osErr = _zTrue
end if
end fn = osErr

clear local
local fn RemovePICTDragHandlers( w as WindowRef )
'~'1
dim osErr as OSErr
if gTrackProc   then osErr = fn RemoveTrackingHandler( gTrackProc, w )
if gReceiveProc then osErr = fn RemoveReceiveHandler( gReceiveProc , w )
end fn = osErr


local mode
dim @ response as long
local fn IsDragManagerAvailable( theDMrecord as .DragSupportRecord )
'~'1
theDMrecord.present = _false
long if ( fn Gestalt( _gestaltDragMgrAttr, response ) == _noErr )
theDMrecord.present      = response and _gestaltDragMgrPresent%
theDMrecord.floatingWnd  = response and _gestaltDragMgrFloatingWind%
theDMrecord.PPCDragLib   = response and _gestaltPPCDragLibPresent%
theDMrecord.imageSupport = response and _gestaltDragMgrHasImageSupport%
theDMrecord.startInFloat = response and 
_gestaltCanStartDragInFloatWindow%
theDMrecord.imageUpdates = response and _gestaltSetDragImageUpdates%
end if
end fn = theDMrecord.present



goto "DRAGPROCS:END"
"DragRecvPictProc"
'~'1
enterproc  fn Drag_Rec_Pict_Proc( dragW as WindowRef, dragRefCon as 
long, ¬
theDrag as DragRef ) = short
'~'1
exitproc = fn DragRecvPictProc( dragW, dragRefCon, theDrag )


"DragTrackPictProc"
'~'1
enterproc  fn Drag_Track_Pict_Proc( dragMsg as short, dragW as 
WindowRef,¬
DragRefCon as long, theDrag as DragRef ) = short
'~'1
exitproc = fn DragTrackPictProc( dragMsg, dragW, dragRefCon, theDrag )
"DRAGPROCS:END"


Local FN doMouse
DIM inRect as Rect
DIm pt as point
DIM msEvnt

msEvnt = Mouse(0)

Select msEvnt
case _Click1Ndrag
// Use a global rect for gosh sakes.
setRect(inRect,_sLeft,_sTop,_sRight,_sBottom) // Phony selection
'~'1
getMouse(pt)
long if FN PtInRect(pt,inRect) // Only in "selection rect"
if gMyDragSupportRecord.present then fn DoTrackPictDrag
End if
end Select

End FN

local mode
dim evnt as long
dim id   as long
local fn DoDialog
'~'1
evnt = dialog( 0)
id   = dialog( evnt )
select evnt
case _wndRefresh
DIM selectionRect as Rect
// Use a global rect in Real life. Globals are your pal here.
setRect(selectionRect,_sLeft,_sTop,_sRight,_sBottom)
Moveto(_sleft + 10,_sTop + 20)
Text _geneva, 9
Print "Pretend I am a"
Moveto(_sleft + 10,_sTop + 36)
Print "picture. Drag me."
FrameRect(selectionRect)
case _wndClick
window id
case _wndActivate
if ( id > 0 ) then window output id
case _cursOver
select id
case < 0   : cursor _iBeamCursor
case else  : cursor _arrowCursor
end select
end select
end fn


local
dim selectedMenu as short
dim selectedItem as short
local fn DoMenu
'~'1
selectedMenu = menu( _menuID)
selectedItem = menu( _itemID)
select selectedMenu
case 1
gFBQuit = _zTrue
end select
end fn


local fn Initialise
'~'1
menu 1, 0, _enable, "File"
menu 1, 1, _enable, "Quit/Q"
if fn IsDragManagerAvailable( gMyDragSupportRecord ) then ¬
fn InstallPICTHandler( 0, 0 )

end fn

local mode
dim osErr       as osErr
dim efForeRGB  as RGBColor
dim efBackRGB  as RGBColor
local fn BuildWindow( wNum as long )
window wNum, "Window" + str$( wNum )
osErr = fn SetThemeWindowBackground( window( _wndPointer ), ¬
_kThemeActiveDialogBackgroundBrush, _zTrue )
end fn


'~Main program

//on event fn DoEvent
ON mouse FN doMouse
on dialog fn DoDialog
on menu   fn DoMenu

fn Initialise// call before building windows
fn BuildWindow( 1 )
fn BuildWindow( 2 )


do
handleevents
until gFBQuit
if ( gMyDragSupportRecord.present ) then fn RemovePICTDragHandlers( 0 )

// End FB 3 Program