Restored from previous forum. Originally posted by freak.
Hope it helps somebody....
Code: Select all
; --------------------------------------------------------------------------
; How to enable Drag'n'Drow in TreeView Gadgets
; by Timo Harter
;
; Usage:
; EnableDragDrop( #Gadget, DragMode, @DropProcedure() )
;
; #Gadget : Usual Gadget Number of the TreeGadget
;
; DragMode : #Drag_LeftMouse = enable draging with left Button
; #Drag_RightMouse = enable draging with right Button
; (they can be combined with '|' to enable both)
;
; @DropProcedure()
; Address of the Procedure that will be called if an Item has been
; dropped somehwere in the Window. This Procedure must have the following
; Syntax:
;
; Procedure DropProcedure(X.l, Y.l, Button.l, Item.l)
;
; EndProcedure
;
; X, Y will receive the Position in the Window, where the Item was dropped.
;
; Button will be #Drag_LeftMouse if the Item was dropped with the left Button or
; #Drag_RightMouse, if it was dropped withe the right Button.
;
; Item will receive the Item Index of the TreeView of the dropped Item
; (same Index as GetGadgetState() returns)
;
;
; Note:
; If the TreeView contains no Images, there will be some Space added, where Images yould be, as
; Drag'n drop wouldn't work otherwise.
;
; For more Information see Example below.
;
; -------------------------------------------------------------------------
#TVN_BEGINDRAG = -407
#TVN_BEGINRDRAG = -408
#TVS_DISABLEDRAGDROP = $10
#Drag_LeftMouse = 1
#Drag_RightMouse = 2
; Structure NMTREEVIEW
; hdr.NMHDR
; action.l
; itemOld.TV_ITEM
; itemNew.TV_ITEM
; ptDrag.POINT
; EndStructure
Global hWndTV.l, DropProc.l, DragDropMode.l, hDragIml.l, DragItem.l
Procedure.l DragDropCallback(Window.l, Message.l, wParam.l, lParam.l)
Protected DoDrag.l, DropX.l, DropY.l, hItem.l, hItem2.l, dItem.l
result = #PB_ProcessPureBasicEvents
Select Message
Case #WM_NOTIFY
*lp.NMHDR = lParam
If *lp\code = #TVN_BEGINDRAG And (DragDropMode & #Drag_LeftMouse): DoDrag = #True: EndIf
If *lp\code = #TVN_BEGINRDRAG And (DragDropMode & #Drag_RightMouse): DoDrag = #True: EndIf
If DoDrag
*pnmtv.NMTREEVIEW = lParam
DragItem = *pnmtv\itemNew\hItem
hDragIml = SendMessage_(hWndTV, #TVM_CREATEDRAGIMAGE, 0, DragItem)
SendMessage_(hWndTV, #TVM_SELECTITEM, #TVGN_CARET, #Null)
ImageList_BeginDrag_(hDragIml, 0, 0, 0)
ImageList_DragEnter_(GetParent_(hWndTV), 0, 0)
ImageList_DragShowNolock_(#True)
ImageList_DragLeave_(hWndTV)
ShowCursor_(#False)
SetCapture_(GetParent_(hWndTV))
SendMessage_(hWndTV, #TVM_SELECTITEM, #TVGN_CARET, DragItem)
EndIf
Case #WM_MOUSEMOVE
If hDragIml
DropX = PeekW(@lParam)
DropY = PeekW(@lParam+2)
ImageList_DragMove_(DropX, DropY+20)
ImageList_DragShowNolock_(#False)
ImageList_DragShowNolock_(#True)
EndIf
Case #WM_LBUTTONUP
If hDragIml And (DragDropMode & #Drag_LeftMouse)
ImageList_EndDrag_()
ReleaseCapture_()
ShowCursor_(#True)
ImageList_Destroy_(hDragIml)
hDragIml = #False
dItem = 0
hItem = SendMessage_(hWndTV, #TVM_GETNEXTITEM, #TVGN_ROOT, 0)
While hItem <> DragItem
hItem2 = SendMessage_(hwndTV, #TVM_GETNEXTITEM, #TVGN_CHILD, hItem)
Repeat
If hItem2 = #Null: hItem2 = SendMessage_(hwndTV, #TVM_GETNEXTITEM, #TVGN_NEXT, hItem): EndIf
If hItem2 = #Null: hItem = SendMessage_(hwndTV, #TVM_GETNEXTITEM, #TVGN_PARENT, hItem): EndIf
Until hItem2 <> #Null
hItem = hItem2
dItem + 1
Wend
CallFunctionFast(DropProc, WindowMouseX(0), WindowMouseY(0), #Drag_LeftMouse, dItem)
EndIf
Case #WM_RBUTTONUP
If hDragIml And (DragDropMode & #Drag_RightMouse)
ImageList_EndDrag_()
ReleaseCapture_()
ShowCursor_(#True)
ImageList_Destroy_(hDragIml)
hDragIml = #False
dItem = 0
hItem = SendMessage_(hWndTV, #TVM_GETNEXTITEM, #TVGN_ROOT, 0)
While hItem <> DragItem
hItem2 = SendMessage_(hwndTV, #TVM_GETNEXTITEM, #TVGN_CHILD, hItem)
Repeat
If hItem2 = #Null: hItem2 = SendMessage_(hwndTV, #TVM_GETNEXTITEM, #TVGN_NEXT, hItem): EndIf
If hItem2 = #Null: hItem = SendMessage_(hwndTV, #TVM_GETNEXTITEM, #TVGN_PARENT, hItem): EndIf
Until hItem2 <> #Null
hItem = hItem2
dItem + 1
Wend
CallFunctionFast(DropProc, WindowMouseX(0), WindowMouseY(0), #Drag_RightMouse, DragItem)
EndIf
EndSelect
ProcedureReturn result
EndProcedure
Procedure.l EnableDragDrop(TVGadget.l, DragMode.l, DropProcedure.l)
Protected Style.l, hIml.l
hWndTV = GadgetID(TVGadget)
DropProc = DropProcedure
DragDropMode = DragMode
Style = GetWindowLong_(hWndTV, #GWL_STYLE)
Style = Style & (~#TVS_DISABLEDRAGDROP)
SetWindowLong_(hWndTV, #GWL_STYLE, Style)
If SendMessage_(hWndTV, #TVM_GETIMAGELIST, #TVSIL_NORMAL, 0) = #Null
hIml = ImageList_Create_(16,16,#ILC_COLOR8,0,999)
SendMessage_(hWndTV, #TVM_SETIMAGELIST, #TVSIL_NORMAL, hIml)
EndIf
SetWindowCallback(@DragDropCallback())
ProcedureReturn #True
EndProcedure
; -------------------------------------------------------------------------
; Example Code:
; -------------------------------------------------------------------------
; this procedure will be called, if an Item was dropped in the Window
Procedure DropProcedure(X.l, Y.l, Button.l, Item.l)
If Button = #Drag_LeftMouse
MessageRequester("Drag'n Drop","Item Number "+Str(Item)+" has been dropped at X:"+Str(X)+" Y:"+Str(Y)+" using left Button.",#MB_ICONINFORMATION)
Else
MessageRequester("Drag'n Drop","Item Number "+Str(Item)+" has been dropped at X:"+Str(X)+" Y:"+Str(Y)+" using right Button.",#MB_ICONINFORMATION)
EndIf
EndProcedure
#Tree = 1
; open Window and create Gadget...
OpenWindow(0, 0, 0, 640, 480, "Drag'n Drop", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
TreeGadget(#Tree, 5, 5, 150, 250)
hImg = LoadIcon_(0,#IDI_APPLICATION)
AddGadgetItem(#Tree, 0, "Item1", hImg)
AddGadgetItem(#Tree, 0, "Item2")
AddGadgetItem(#Tree, 0, "Item3")
AddGadgetItem(#Tree, 0, "Item4")
; this enables Drag'n Drop, that's all
EnableDragDrop(#Tree, #Drag_LeftMouse|#Drag_RightMouse, @DropProcedure())
; wait for exit...
While WaitWindowEvent() <> #PB_Event_CloseWindow: Wend
End
; -------------------------------------------------------------------------
That's it...
Timo
--------------------------------
Programming today is a race between software engineers striving to build bigger and
better idiot-proof programs and the universe trying to produce bigger and better idiots.
...So far, the universe is winning.
