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