Listbox Drag & Drop

For 'default' appearance listboxes, this seems to work.

#pragma TextEncoding="UTF-8"
#pragma rtGlobals=3
#pragma version=1.70

constant kJitter = 3 // pixels

menu "Macros"
	"Drag and Drop Demo"
end

function DragAndDropDemo()
	KillWindow/Z demo
	Make/O/T LB1ListWave = {"cat","dog","rabbit","horse","pig","cow"}
	Make/O/T LB2ListWave = {"blue","green","red","yellow","orange","pink"}
	redimension/N=(-1,1) LB2ListWave
	SetDimLabel 1, 0, Title, LB2ListWave
	Make/O/N=6 LB1SelWave = 0, LB2SelWave = 0
	NewPanel/K=1/N=demo/W=(100,100,400,350) as "drag & drop demo"
	ListBox LB1, win=demo, pos={10, 40}, size={130, 200}, listwave=LB1ListWave
	ListBox LB1, win=demo, selwave=LB1SelWave, mode=9, focusring=0
	ListBox LB1, win=demo, fsize=16, Proc=ListBoxProc
	ListBox LB2, win=demo, pos={160, 40}, size={130, 200}, listwave=LB2ListWave
	ListBox LB2, win=demo, selwave=LB2SelWave, mode=9, focusring=0
	ListBox LB2, win=demo, fsize=9, Proc=ListBoxProc
	PopupMenu DragPop, win=demo, pos={10, 10}, value="Drag Between Boxes;Drag to Reorder;", Proc=PopupDragType
end

function PopupDragType(STRUCT WMPopupAction &s)
	// mode 1 for reordering, mode 9 for drag between boxes
	ListBox LB1, win=$s.win, selRow=-1, mode=(s.popNum==1) ? 9 : 1
	ListBox LB2, win=$s.win, selRow=-1, mode=(s.popNum==1) ? 9 : 1
end

function ListBoxProc(STRUCT WMListboxAction &lba)
	ControlInfo/W=$lba.win DragPop
	if (V_Value == 1)
		DragAndDrop(lba)
	else
		DragReorder(lba)
	endif
end

function DragAndDrop(STRUCT WMListboxAction &lba)

	if (!(lba.eventCode & 3)) // neither mouseup nor mousedown
		return 0
	endif

	variable f = 72/PanelResolution(lba.win) // point/pixel
	int dragStarted = strlen(GetUserData(lba.win, lba.ctrlName, "drag"))
	string otherListBox = SelectString(cmpstr(lba.ctrlName, "LB1")==0, "LB1", "LB2")

	if (lba.eventCode==2 && dragStarted) // mouseup, drag completed
		// find whether mouse is within OTHER listbox
		if (isInControl(lba.mouseLoc, lba.win, otherListBox))
			ControlInfo/W=$lba.win $otherListBox
			variable beforeItem = round(V_startRow + (lba.mouseLoc.v-V_top/f)/V_rowHeight)
			wave/SDFR=$S_DataFolder otherListBoxWave=$S_Value
			beforeItem = limit(beforeItem, 0, numpnts(otherListBoxWave))
			MoveSelection(otherListBox, lba.selwave, lba.listwave, beforeItem)
		endif
		ListBox $lba.ctrlName, win=$lba.win, userdata(drag)=""
	endif

	if (lba.eventCode==1 && dragStarted==0) // mousedown, new drag
		if ( lba.row < 0 || lba.row >= (DimSize(lba.listWave, 0)) )
			return 0
		endif

		// prevent a single click on an already selected item from deselecting items
		// unless it's a command-click or shift-click
		// resetting lba.selwave in the selection event doesn't have the desired effect.
		wave/Z sel = $lba.ctrlName
		if (lba.eventmod<2 && waveexists(sel) && (numpnts(sel)==numpnts(lba.selwave)) && (sel[lba.row] & 9))
			duplicate/O sel lba.selwave
		else
			duplicate/O lba.selwave $lba.ctrlName
		endif

		// don't start drag until the mouse has moved sufficiently far
		variable dx, dy, buttondown
		do
			GetMouse/W=$lba.win
			buttondown = V_flag & 1
			dx = v_left - lba.mouseLoc.h // pixels
			dy = v_top - lba.mouseLoc.v // pixels
		while (buttondown && sqrt(dx^2+dy^2)<kJitter)
		if (!buttondown)
			return 0
		endif

		variable i, titlerow, startrow, endrow, numBoxes, mode, fontSize

		// figure out visible rows
		titlerow = (waveexists(lba.titlewave) || strlen(getdimlabel(lba.listwave, 1, 0))>0)
		ControlInfo/W=$lba.win $lba.ctrlName
		startrow = V_startRow
		endrow = min(numpnts(lba.selwave)-1, startrow + ceil((V_height/f/V_rowHeight)-1.1-titlerow))
		// record current value of mode & fsize
		string strMode, strFsize
		SplitString/E=("mode=\s?([[:digit:]]+)") S_recreation, strMode
		mode = strlen(strMode) ? str2num(strMode) : 1
		SplitString/E=("fSize=\s?([[:digit:]]+)") S_recreation, strFsize
		fontSize = strlen(strFsize) ? str2num(strFsize) : 9
		// stops cell selection as mouse moves by setting mode=0
		ListBox $lba.ctrlName, win=$lba.win, userdata(drag)="started", mode=0
		// userdata(drag) indicates dragging is active, cleared on mouseup

		// create a titlebox for every visible selected item
		numBoxes = 0
		string DBname, strTitle
		variable height, width, top , left
		for (i=startrow;i<=endrow;i++)
			if (lba.selwave[i] & 0x09)
				wave/T listwave=lba.listWave
				DBname = "DragBox" + num2str(numBoxes)
				height = f * (V_rowHeight - 1)
				width  = f * (lba.ctrlRect.right - lba.ctrlRect.left)
				top    = f * (lba.ctrlRect.top + (i - startrow + titlerow)*V_rowHeight + 1.5)
				left   = f * lba.ctrlRect.left
				sprintf strTitle, "\\sa%+03d\\x%+03d %s", 3-(fontSize>12), (20-fontSize)*0.625, listwave[i]
				TitleBox $DBname, win=$lba.win, title=strTitle, labelBack=(41760,52715,65482), pos={left, top}
				TitleBox $DBname, win=$lba.win, fsize=fontSize, fixedSize=1, frame=0, size={width, height}
				numBoxes ++
			endif
		endfor

		// save coordinates of other listbox
		ControlInfo/W=$lba.win $otherListBox
		struct rect pixelRect
		pixelRect.left   = v_left/f // point -> pixel
		pixelRect.right  = v_right/f
		pixelRect.top    = v_top/f
		pixelRect.bottom = pixelRect.top + v_height/f

		// monitor mouse movement until mouseup
		do
			GetMouse/W=$lba.win
			buttondown = V_flag & 1
			dx = v_left - lba.mouseLoc.h // pixels
			dy = v_top - lba.mouseLoc.v // pixels
			// keep current mouse position updated as mouse moves
			lba.mouseLoc.h = v_left
			lba.mouseLoc.v = v_top

			// move titleboxes with mouse
			for (i=0; i<numBoxes; i++)
				TitleBox/Z $"DragBox"+num2str(i), win=$lba.win, pos+={dx,dy}
			endfor

			// draw focus ring when mouse is over other listbox
			if (PointInRect(lba.mouseLoc, pixelRect)) // all units are pixels
				ListBox $otherListBox, win=$lba.win, focusRing=1
				ModifyControl $otherListBox activate
			else
				ModifyControl $lba.ctrlName activate
			endif

			DoUpdate/W=$lba.win
		while (buttondown) // this is blocking code :(

		// clear titleboxes and return listboxes to normal mode
		for (i=0; i<numBoxes; i++)
			KillControl/W=$lba.win $"DragBox"+num2str(i)
		endfor
		ListBox $otherListBox, win=$lba.win, focusRing=0
		ListBox $lba.ctrlName, win=$lba.win, mode=mode
		ModifyControl $lba.ctrlName activate
	endif // end of drag
	return 0
end

// point and rect structures must have same units
function PointInRect(STRUCT point &pnt, STRUCT rect &r)
	return (pnt.h>r.left && pnt.h<r.right && pnt.v>r.top && pnt.v<r.bottom)
end

function isInControl(STRUCT point &mouse, string strWin, string strCtrl)
	ControlInfo/W=$strWin $strCtrl
	variable f = 72/PanelResolution(strWin)
	variable hpoint = mouse.h * f
	variable vpoint = mouse.v * f
	return ( hpoint>V_left && hpoint<(V_right) && vpoint>V_top && vpoint<(V_top+V_height) )
end

function MoveSelection(string toLB, wave selwave, wave/T listwave, variable beforeItem)
	Extract/free/T listwave, switchwave, (selwave & 0x09)
	Extract/O/T listwave, listwave, !(selwave & 0x09)
	Extract/O selwave, selwave, !(selwave & 0x09)
	wave destSelWave = $toLB + "SelWave"
	wave/T destListWave = $toLB + "ListWave"
	destSelWave = 0
	variable numItems = numpnts(switchwave)
	InsertPoints beforeItem, numItems, destSelWave, destListWave
	destSelWave[beforeItem, beforeItem+numItems-1] = 1
	destListWave[beforeItem, beforeItem+numItems-1] = switchwave[p-beforeItem]

	// save new selection for modified selection behaviour
	Duplicate/O destSelWave $toLB
end

function DragReorder(STRUCT WMListboxAction &lba)

	if (lba.eventCode == 2) // mouseup
		ListBox $lba.ctrlName, win=$lba.win, userdata(drag)=""
	endif

	if (lba.eventCode == 1) // mousedown
		ListBox $lba.ctrlName, win=$lba.win, userdata(drag)=num2str(lba.row)
		//userdata(drag) indicates dragging is active, cleared on mouseup
	endif

	if (lba.eventCode == 4) // selection of lba.row
		variable dragNum = str2num(GetUserData(lba.win,lba.ctrlName,"drag"))
		if(numtype(dragNum)!=0 || min(dragNum,lba.row)<0 || max(dragNum,lba.row)>=numpnts(lba.listwave))
			return 0
		endif
		Duplicate/free lba.selwave order
		order = (p == dragNum) ? lba.row - 0.5 + (lba.row > dragNum) : x
		Sort order, lba.listwave
		ListBox $lba.ctrlName, win=$lba.win, userdata(drag)=num2str(lba.row)
	endif
end