It supports any gadget that support the SetGadgetText() and GetGadgetText() functions, but it works only within the same application, and is Windows-only.
The entire drag & drop function is encapsulated into a single procedure, and could be easily plugged into any application, and simply called in the main events loop.
Tested with v5.21 x86 on WinXP and v5.22 x64 on Win7:
Code: Select all
;=================================================
;
; DragDropTx()
;
; drag & drop emulator
;
; by
;
; TI-994A - 18th May 2014
;
; developed in PureBasic 5.22 (x64)
; on Windows 7 Home Premium
; and tested in PureBasic 5.21 (x86)
; on Windows XP Pro (SP3)
;
; supports any gadget that support the
; SetGadgetText() & GetGadgetText() functions
; (Windows only)
;
; free to use, improve, share...
;
;=================================================
;*** DOES NOT SUPPORT GADGET NUMBER ZERO (0) ***
;=================================================
;=================================================
;DragDropTx() encapsulated into a single procedure
;=================================================
Procedure DragDropTx(event)
Static gNo, grabNo, h_gNo, stdCursor, dragCursor, dropCursor, grabText.s
If Not stdCursor Or Not dragCursor
stdCursor = LoadCursor_(0, #IDC_ARROW)
dragCursor = LoadCursor_(0, #IDC_NO)
dropCursor = LoadCursor_(0, #IDC_HAND)
EndIf
Macro hoveringGadget(gNo)
GetCursorPos_(cursor.POINT)
gNo = WindowFromPoint_(PeekQ(@cursor))
gNo = GetDlgCtrlID_(gNo)
If Not IsGadget(gNo)
gNo = 0
EndIf
EndMacro
Select event
Case #WM_MOUSEMOVE
If grabNo
hoveringGadget(h_gNo)
If h_gNo
SetCursor_(dropCursor)
Else
SetCursor_(dragCursor)
EndIf
EndIf
Case #WM_LBUTTONDOWN
hoveringGadget(gNo)
If gNo
grabText = GetGadgetText(gNo)
If Trim(grabText) <> ""
grabNo = gNo
SetCursor_(dropCursor)
EndIf
EndIf
Case #WM_LBUTTONUP
If grabNo
hoveringGadget(gNo)
If gNo And gNo <> grabNo
If GetAsyncKeyState_(#VK_CONTROL) & 32768
swapText.s = GetGadgetText(gNo)
SetGadgetText(grabNo, swapText)
EndIf
SetGadgetText(gNo, grabText)
EndIf
SetCursor_(stdCursor)
grabText = ""
grabNo = 0
gNo = 0
EndIf
EndSelect
EndProcedure
;=========
;demo code
;=========
instructions.s = "Just left click on any of the above gadgets, drag the mouse to another "
instructions + "gadget, and release it. The text from the first gadget will be copied into "
instructions + "the second gadget." + #CRLF$ + #CRLF$ + "When dragging, the mouse cursor "
instructions + "will change to a HAND icon whenever it hovers over another gadget. However "
instructions + "this drag and drop function will work only with gadgets that support the "
instructions + "SetGadgetText() and GetGadgetText() functions." + #CRLF$ + #CRLF$ + "Pressing "
instructions + "the control key on the keyboard before releasing it onto the second gadget "
instructions + "will cause the texts from the two gadgets to be swapped." + #CRLF$ + #CRLF$
instructions + "Due to the function structure, gadget number zero (0) is not supported."
wFlags = #PB_Window_SystemMenu | #PB_Window_ScreenCentered
OpenWindow(0, #PB_Any, #PB_Any, 400, 600, "DragDropTx() - drag & drop emulator by TI-994A", wFlags)
TextGadget(0, 20, 390, 360, 190, instructions)
TextGadget(1, 10, 10, 220, 30, "This is a TextGadget()", #SS_NOTIFY | #PB_Text_Border)
TextGadget(2, 10, 150, 220, 30, "This is another TextGadget()", #SS_NOTIFY | #PB_Text_Border)
StringGadget(3, 170, 230, 220, 30, "Some text on another StringGadget().")
StringGadget(4, 170, 60, 220, 30, "Some text on a StringGadget().")
ButtonGadget(5, 10, 320, 380, 30, "Drag My Caption Too!")
FrameGadget(6, 10, 370, 380, 220, " Instructions ")
SetGadgetColor(0, #PB_Gadget_FrontColor, RGB(150, 0, 0))
Repeat
event = WaitWindowEvent()
Select event
Case #PB_Event_CloseWindow
appQuit = 1
Case #WM_LBUTTONDOWN, #WM_LBUTTONUP, #WM_MOUSEMOVE
DragDropTx(event)
EndSelect
Until appQuit = 1

EDIT (19th May, 2014): Added a second cursor to indicate dragging. Thanks to KCC!