[futurebasic] Dragon Drop

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

From: Bernie <fblist@...>
Date: Thu, 12 May 2005 18:28:10 +0100
If all you want to do is drag an image within your app, here's a cheap  
alternative to D&D. Uses carbon events & fn CreateXXXXControl but I'm  
sure it can be converted to HandleEvents/FB appearance buttons.

Bernie


'----------

'~'A
'                       Runtime : Rntm Appearance.Incl
'                           CPU : Carbon
'                    CALL Req'd : Off
'~'B

/*
    Dragon Drop (cheap D&D)

    A novel way to D&D images within an app [opt-drag = copy]


    Bernie Wylde     12 May 2005

    <http://homepage.ntlworld.com/bernie.w/twm.htm>
*/

include "Tlbx HIView.Incl"
include "Tlbx Carbon Controls.Incl"

begin record ControlKindRec
dim as OSType signature
dim as OSType kind
end record
toolbox fn GetControlKind(ControlRef inControl, ControlKindRec *  
outControlKind) = OSStatus
toolbox fn ActivateWindow(WindowRef inWindow, Boolean inActivate) =  
OSStatus

_typeUInt32 = _"magn"
_kControlKindIcon    = _"icon"
_kControlKindPicture = _"pict"

#if ndef _kWindowMetalAttribute
_kWindowMetalAttribute       = (1 << 8)
_kWindowCompositingAttribute = (1 << 19)
#endif

local mode
local fn AddEventToHandle(eventClass as UInt32, eventKind as UInt32, h  
as Handle)
'~'1
dim as EventTypeSpec evnt
'~'1
evnt.eventClass = eventClass
evnt.eventKind  = eventKind
end fn = fn PtrAndHand(@evnt, h, SizeOf(EventTypeSpec))

local fn InstallControlEvents(c as ControlRef)
'~'1
dim as Handle   eventH
dim as OSStatus ignore
begin globals
dim as Ptr sControlEventHandlerUPP
end globals
long if (sControlEventHandlerUPP == 0)
sControlEventHandlerUPP = fn NewEventHandlerUPP([proc  
"ControlEventHandler" + _FBprocToProcPtrOffset])
end if
'~'1
eventH = fn NewHandle(0)
long if eventH
'~'<
fn AddEventToHandle(_kEventClassControl, _kEventControlClick, eventH)
'~'<
ignore = fn InstallEventHandler(fn GetControlEventTarget(c),  
sControlEventHandlerUPP, ¬
                                 fn  
GetHandleSize(eventH)\\(SizeOf(EventTypeSpec)), #[eventH], #0, #0)
DisposeHandle(eventH)
end if
end fn

local mode
local fn GetDocumentWindowUnderMouse(p as ^Point)
'~'1
dim as Rect      @ r
dim as Point     @ pt
dim as WindowRef @ w
dim as OSStatus    ignore
'~'1
pt = p
w = fn GetFrontWindowOfClass(_kDocumentWindowClass, _true)
while (w)
ignore = fn GetWindowBounds(w, _kWindowContentRgn, r)
if fn PtInRect(pt, r) then exit wend
w = fn GetNextWindow(w)
wend
end fn = w

local mode
local fn AddIconToWindow(w as WindowRef, rC as ^Rect)
'~'1
dim as ControlButtonContentInfo content
dim as Rect                   @ r
dim as ControlRef             @ c
dim as OSStatus                 ignore
'~'1
r = rC : c = 0
content.contentType = _kControlContentIconRef
ignore = fn GetIconRef(_kOnAppropriateDisk, _kSystemIconsCreator,  
_kGenericApplicationIcon, content.iconRef)
long if content.iconRef
ignore = fn CreateIconControl(w, @r, @content, _true, c)
ignore = fn ReleaseIconRef(content.iconRef)
end if
end fn = c

local mode
local fn AddPictToWindow(w as WindowRef, rC as ^Rect)
'~'1
dim as ControlButtonContentInfo content
dim as Rect                   @ r
dim as ControlRef             @ c
dim as OSStatus                 ignore
'~'1
r = rC : c = 0
content.contentType = _kControlContentPictRes
content.resID = 30333
ignore = fn CreatePictureControl(w, @r, @content, _true, c)
end fn = c

local mode
local fn Drag(c as ControlRef, modifiers as UInt32)
'~'1
dim as ControlKindRec        k
dim as Rect                @ rFrom, rTo, rOverlay, r
dim as point                 pt, oldPt
dim as WindowRef           @ wFrom, wTo, wOverlay
dim as ControlRef          @ cRef
dim as MouseTrackingResult @ result
dim as short                 moveX, moveY, offsetX, offsetY
dim as OSStatus              ignore
'~'1
cRef = c
ignore = fn GetControlKind(c, k)
'~'<
wFrom = fn GetControlOwner(c)
ignore = fn TrackMouseLocation(0, pt, result)
oldPt = pt
long if (result == _kMouseTrackingMouseDragged)
ignore = fn GetWindowBounds(wFrom, _kWindowContentRgn, rFrom)
GetControlBounds(c, r)
SetRect(rOverlay, rFrom.left + r.left, rFrom.top + r.top, rFrom.left +  
r.right, rFrom.top + r.bottom)
ignore = fn CreateNewWindow(_kOverlayWindowClass,  
_kWindowCompositingAttribute, @rOverlay, wOverlay)
SetRect(r, 0, 0, r.right - r.left, r.bottom - r.top)
select k.kind
case _kControlKindIcon    : c = fn AddIconToWindow(wOverlay, r)
case _kControlKindPicture : c = fn AddPictToWindow(wOverlay, r)
end select
ShowWindow(wOverlay)
offsetX = pt.h% - rOverlay.left
offsetY = pt.v% - rOverlay.top
'~'<
if (_optionKey% and modifiers) == 0 then HideControl(cRef)
while (result <> _kMouseTrackingMouseUp)
ignore = fn TrackMouseLocation(0, pt, result)
long if (result == _kMouseTrackingMouseDragged)
moveX = pt.h% - oldPt.h%
moveY = pt.v% - oldPt.v%
fn MoveWindow(wOverlay, pt.h% - offsetX, pt.v% - offsetY, _false)
oldPt = pt
end if
wend
'~'<
wTo = fn GetDocumentWindowUnderMouse(pt)
long if wTo
ignore = fn GetWindowBounds(wTo, _kWindowContentRgn, rTo)
ignore = fn GetWindowBounds(wOverlay, _kWindowContentRgn, rOverlay)
GetControlBounds(c, r)
OffsetRect(r, rOverlay.left - rTo.left, rOverlay.top - rTo.top)
select k.kind
case _kControlKindIcon    : c = fn AddIconToWindow(wTo, r)
case _kControlKindPicture : c = fn AddPictToWindow(wTo, r)
end select
fn InstallControlEvents(c)
ignore = fn ActivateWindow(wTo, _true)
if (_optionKey% and modifiers) == 0 then DisposeControl(cRef)
xelse
ShowControl(cRef)
end if
DisposeWindow(wOverlay)
end if
end fn

long if 0
"ControlEventHandler"
enterproc fn ControlEventHandler(handler as EventHandlerCallRef, evnt  
as EventRef, userData as Ptr) = OSStatus
'~'1
dim as UInt32       eventClass, eventKind, @ modifiers
dim as ControlRef @ c
dim as long         result
dim as OSStatus     ignore
'~'1
result = _EventNotHandledErr
eventClass = fn GetEventClass(evnt)
eventKind  = fn GetEventKind(evnt)
ignore = fn GetEventParameter(evnt, _kEventParamDirectObject,  
_TypeControlRef, #0, SizeOf(ControlRef), #0, @c)
ignore = fn GetEventParameter(evnt, _kEventParamKeyModifiers,  
_typeUInt32, #0, SizeOf(UInt32), #0, @modifiers)
select eventClass
case _kEventClassControl
select eventKind
case _kEventControlClick : fn Drag(c, modifiers)
end select
end select
exitproc = result
end if

local mode
local fn BuildWindows
'~'1
dim as Rect             @ r
dim as WindowRef        @ w
dim as WindowClass      @ wc
dim as WindowAttributes @ wa
dim as ControlRef       @ c
dim as OSStatus           ignore
'~'1
SetRect(r, 450, 50, 750, 300)
wc = _kDocumentWindowClass
wa =  
_kWindowStandardHandlerAttribute_kWindowCompositingAttribute_kWindowMeta 
lAttribute_kWindowResizableAttribute
ignore = fn CreateNewWindow(wc, wa, @r, w)
SetWTitle(w, "Dragon Drop 2")
'~'<
ShowWindow(w)
'~'<
SetRect(r, 20, 50, 320, 300)
ignore = fn CreateNewWindow(wc, wa, @r, w)
SetWTitle(w, "Dragon Drop 1")
'~'<
SetRect(r, 20, 20, 80, 80)
c = fn AddIconToWindow(w, r)
fn InstallControlEvents(c)

OffsetRect(r, 50, 90)
c = fn AddPictToWindow(w, r)
fn InstallControlEvents(c)
'~'<
ShowWindow(w)
'~'<
end fn

fn BuildWindows

RunApplicationEventLoop

'----------