TreeGadget - Drag'n'Drop - scroll automatically

[Perkin]

I've got a TreeGadget which is populated with entries to be drag'n'drop sorted, into an order a user is happy with (similar to a playlist).

Now I've got the d&d sorting done, but would like the TreeGadget to scroll automatically if the item being dragged is brought above the top or below the bottom of the gadget, so the item can be dragged in one motion, rather than dropping it - scrolling - re-drag and then drop.

Any suggestions?

For example, In following code I want to drag'n'drop Item0 between Item49 & Item50. This takes three d&d and two scrolls (and would be more if there was more items in the list). I would like to be able to do it in one drag'n'drop.

Code: Select all

#PrivateType = 0
#Tree = 51

Procedure TreeMoveItem(SourceItem,TargetItem)
; copy everything here (also colors and GetGadgetItemData() etc if you use that)                
	text.s=GetGadgetItemText(#Tree, SourceItem)
  RemoveGadgetItem(#Tree, SourceItem)
  AddGadgetItem(#Tree, TargetItem, text, 0, -1)
; paste details back here
  SetGadgetState(#Tree, TargetItem)
EndProcedure


If OpenWindow(0, 100, 100, 300, 400, "DRAG FOLLOW TEST", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)
  TreeGadget(#Tree,0,0,300,400,#PB_Tree_NoLines | #PB_Tree_NoButtons | #PB_Tree_AlwaysShowSelection)
  EnableGadgetDrop(#Tree, #PB_Drop_Private, #PB_Drag_Move, #PrivateType)
  For i = 0 To 50
    AddGadgetItem(#Tree, -1, "Item" + Str(i), 0, 0)
  Next i
    
  Repeat
    Event = WaitWindowEvent()
    Select Event
      Case #PB_Event_Gadget
        Select EventGadget()
    			Case #Tree
    			 	If EventType() = #PB_EventType_DragStart
			        SourceItem = GetGadgetState(#Tree)
  			      DragPrivate(#PrivateType, #PB_Drag_Move)
  			 		EndIf
	      EndSelect
      Case #PB_Event_GadgetDrop
	     	If EventDropType() = #PB_Drop_Private And EventDropPrivate() = #PrivateType
		      TargetItem = GetGadgetState(#Tree)
		      If TargetItem = -1
		        TargetItem  = CountGadgetItems(#Tree)
		      EndIf
		      If SourceItem <> TargetItem
		        If TargetItem > SourceItem
		        	TreeMoveItem(SourceItem,TargetItem)
		        ElseIf TargetItem <= SourceItem
			        TargetItem+1
			        TreeMoveItem(SourceItem,TargetItem)
		        EndIf
		      EndIf
	      EndIf
    EndSelect
  Until Event = #PB_Event_CloseWindow
EndIf
End

[srod]

The following quick hack is a little crude in that I hard-code some values, but might get you started. Note how I enable drops on the main window as well so that the drag callback continues to receive notifications even when the cursor is not over the tree gadget. This allows us to track the drag cursor (in a limited fashion) even when the cursor is not over the tree etc! You can remove this if you do not like it though.

If doing this for real, I would probably use a timer instead of a drag callback so that I can track the cursor far more effectively.

Code: Select all

Declare.i DragCallBack(Action)

OpenWindow(0,0,0,480,400,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu) 
  ListIconGadget(0,20,20,200,300,"Drag from", 195, #PB_ListIcon_FullRowSelect) 
  TreeGadget(1,250,20,200,300) 

  For i = 0 To 99
    AddGadgetItem(0, -1, "Row "+Str(i)) 
    AddGadgetItem(1, -1, "Row "+Str(i)) 
    AddGadgetItem(1, -1, "Row "+Str(i), 0, 1) 
  Next

  EnableGadgetDrop(1,#PB_Drop_Text, #PB_Drag_Copy) 
  ;We enable window drop so that our drag callback can receive drag notifications as well. This allows us to track the drag cursor
  ;even when it is not over the tree gadget.
    EnableWindowDrop(0,#PB_Drop_Text, #PB_Drag_Copy) 

  Repeat 
    ev = WaitWindowEvent() 
    Select ev 
      Case #PB_Event_GadgetDrop 
        If EventGadget() =1
          AddGadgetItem(EventGadget(), GetGadgetState(EventGadget()), EventDropText()) 
        EndIf
      Case #PB_Event_Gadget 
        If EventType() = #PB_EventType_DragStart  And EventGadget()=0
          dragtxt.s = GetGadgetItemText(EventGadget(), GetGadgetState(EventGadget())) 
          SetDragCallback(@DragCallBack())
          DragText(dragtxt, #PB_Drag_Copy) 
        EndIf 
  EndSelect 
  Until ev = #PB_Event_CloseWindow 


Procedure.i DragCallBack(Action)
  Protected pt.point, rc.RECT, top
  If action<>#PB_Drag_None
    GetCursorPos_(pt)
    GetWindowRect_(GadgetID(1), rc)
    ;Check if the tree gadget requires scrolling.
      MapWindowPoints_(0,GadgetID(1),pt,1)
      If pt\x >=0 And pt\x < GadgetWidth(1)
        If pt\y <=10 
          SendMessage_(GadgetID(1), #WM_VSCROLL, #SB_LINEUP, 0)
        ElseIf pt\y>=GadgetHeight(1)-10
          SendMessage_(GadgetID(1), #WM_VSCROLL, #SB_LINEDOWN, 0)
        EndIf
      EndIf
  EndIf
  ProcedureReturn 1
EndProcedure

[Perkin]

Thanks srod , that's a great start for me, I should be able to adapt it . (To my own evil purposes )

[zekitez@lycos.com]

Thanks srod , that's a great start for me, I should be able to adapt it .

Thank you again.
Just what I needed to get started and so simple (when you know how to ... ).
I only removed some parts from the example which, I assume, were 'crude parts'.

Code: Select all

Declare.i DragCallBack(Action)

OpenWindow(0,0,0,480,400,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu) 
ListIconGadget(0,20,20,200,300,"Drag from", 195, #PB_ListIcon_FullRowSelect) 
TreeGadget(1,250,20,200,300) 

For i = 0 To 99
   AddGadgetItem(0, -1, "Row "+Str(i)) 
   AddGadgetItem(1, -1, "Row "+Str(i)) 
   AddGadgetItem(1, -1, "Row "+Str(i), 0, 1) 
Next

EnableGadgetDrop(1,#PB_Drop_Text, #PB_Drag_Copy) 
;We enable window drop so that our drag callback can receive drag notifications as well. This allows us to track the drag cursor
;even when it is not over the tree gadget.
EnableWindowDrop(0,#PB_Drop_Text, #PB_Drag_Copy) 

Repeat 
   ev = WaitWindowEvent() 
   Select ev 
   Case #PB_Event_GadgetDrop 
      If EventGadget() =1
         AddGadgetItem(EventGadget(), GetGadgetState(EventGadget()), EventDropText()) 
      EndIf
   Case #PB_Event_Gadget 
      If EventType() = #PB_EventType_DragStart 
         If EventGadget()=0
            dragtxt.s = GetGadgetItemText(EventGadget(), GetGadgetState(EventGadget())) 
            SetDragCallback(@DragCallBack())
            DragText(dragtxt, #PB_Drag_Copy)
         ElseIf EventGadget()=1
            dragtxt.s = GetGadgetItemText(EventGadget(), GetGadgetState(EventGadget())) 
            SetDragCallback(@DragCallBack())
            DragText(dragtxt, #PB_Drag_Copy)
         EndIf
      EndIf 
   EndSelect 
Until ev = #PB_Event_CloseWindow 



Procedure.i DragCallBack(Action)
   Protected pt.point
   Debug "DragCallBack"
   If action<>#PB_Drag_None
       
      ;Check if the listicon gadget requires scrolling.
      GetCursorPos_(pt)
      MapWindowPoints_(0,GadgetID(0),pt,1)
      If pt\x >=0 And pt\x < GadgetWidth(0)
         If pt\y <=10 
            SendMessage_(GadgetID(0), #WM_VSCROLL, #SB_LINEUP, 0)
         ElseIf pt\y>=GadgetHeight(0)-10
            SendMessage_(GadgetID(0), #WM_VSCROLL, #SB_LINEDOWN, 0)
         EndIf
      Else
         ;Check if the tree gadget requires scrolling.
         GetCursorPos_(pt)
         MapWindowPoints_(0,GadgetID(1),pt,1)
         If pt\x >=0 And pt\x < GadgetWidth(1)
            If pt\y <=10 
               SendMessage_(GadgetID(1), #WM_VSCROLL, #SB_LINEUP, 0)
            ElseIf pt\y>=GadgetHeight(1)-10
               SendMessage_(GadgetID(1), #WM_VSCROLL, #SB_LINEDOWN, 0)
            EndIf
         EndIf 
      EndIf
   EndIf
   ProcedureReturn 1
   
EndProcedure