DefTreeDragHandler

>>-aMessageExtensions~DefTreeDragHandler-----------------------><

A tree view control cannot handle a drag-and-drop operation within the tree view. Therefore, you can connect the DefTreeDragHandler method with the BEGINDRAG or BEGINRDRAG notification message (see ConnectTreeNotify) to allow the moving of an item or a node with all its subitems from one parent node to another within a tree view. The cursor shape is changed to a crosshair during the drag operation. If the cursor is moved over the item dragged, the cursor shape is changed to a slashed circle. You can cancel the drag operation by clicking the other mouse button while holding the button that started the drag operation.

The DefTreeDragHandler is implemented as follows:

 
::method DefTreeDragHandler
   use arg id, item, pt
   tc = self~GetTreeControl(id)
   hc = tc~Cursor_Cross   /* change cursor and store current */
   parse value tc~GetRect with left top right bottom
   oldItem = 0
   nocurs = 0
   lmb = self~IsMouseButtonDown("LEFT")
   rmb = self~IsMouseButtonDown("RIGHT")
   call time "R"
   do while (lmb \= 0 | rmb \= 0) & \(lmb \= 0 & rmb \= 0)
     pos = self~CursorPos
     parse var pos x y
     parse value tc~ScreenToClient(x, y) with newx newy
      ht = tc~HitTest(newx, newy)
      if ht \= 0 & ht~wordpos("ONITEM") > 0 then do
          parse var ht newParent where
          /* check if droptarget is the current parent or one of the dragged
             item's children */
          if newParent \= Item & newParent \= tc~Parent(Item) & tc~IsAncestor,
             (Item,newParent) = 0
          then do
             is. = tc~ItemInfo(newParent)
             if is.!State~Wordpos("INDROP") = 0 then
             do
                call time "R"
                tc~DropHighlight(newParent)
                if nocurs \= 0 then do
                  tc~RestoreCursorShape(nocurs) /*restore old cursor (cross)*/
                  nocurs = 0
                end
             end
             else if time("E") > 1 then do  /* expand node after 1 second */
                 if is.!Children \= 0 & is.!State~Wordpos("EXPANDED") = 0 then
                 tc~expand(newParent)
             end
          end
          else do
             if nocurs = 0 then do
                nocurs = tc~Cursor_No  /* set no cursor and retrieve
                                              current cursor (cross) */
                tc~DropHighlight  /* remove drop highlight */
             end
          end
      end
      else do
          if newParent \= 0 then do
             /* necessary to redraw cursor when moving on a valid item again */
              tc~DropHighlight  /* remove drop highlight */
              newParent = 0
          end
          if nocurs = 0 then nocurs = tc~Cursor_No  /* set no cursor and
                                      retrieve current cursor (cross) */
          /* handle scrolling */
          fvItem = tc~FirstVisible
          if (ybottom) & (tc~NextVisible(fvItem) \= 0) then do
              tc~MakeFirstVisible(tc~NextVisible(fvItem))
              if y-bottom < 200 then call sleepms 200-(y-bottom)
          end
      end
      lmb = self~IsMouseButtonDown("LEFT")
      rmb = self~IsMouseButtonDown("RIGHT")
   end
   if ht~wordpos("ONITEM") > 0 & lmb = 0 & rmb = 0 then do /* if mouse on item
                                                  and both mouse buttons up */
       item = tc~MoveItem(Item, newParent, 1)  /* move item under newParent */
   end
   tc~DropHighlight(0)  /* remove drop highlight */
   tc~select(item)      /* select item */
   tc~EnsureVisible(item)
   tc~RestoreCursorShape(hc)  /* restore old cursor */
   pos = self~CursorPos
   parse var pos x y
   self~SetCursorPos(x+1, y+1)  /* move cursor to force redraw */