PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Visual Help for drag&drop in ListView

https://www.purebasic.fr/english/viewtopic.php?t=74320

Page 2 of 3

Re: Visual Help for drag&drop in ListView

Posted: Wed Jan 08, 2020 8:44 pm
by Shardik
I have rewritten my last example with two ListIcons into a single ListIcon example and it was really simple. I only had to delete the second ListIconGadget, reduce the width of the window and change all occurances of gadget number 1 to 0. Please try it and report any bugs... :wink:

Code: Select all

Structure LVINSERTMARK
  cbSize.L
  dwFlags.L
  iItem.L
  dwReserved.L
EndStructure

Define DraggingIsActive.I
Define HeaderHeight.I
Define Rectangle.RECT
Define RowIndex.I
Define RowHeight.I
Define RowInsertionIndex.I

Procedure WindowCallback(WindowHandle.I, Msg.I, WParam.I, LParam.I)
  Shared DraggingIsActive.I

  Protected *NMHdr.NMHDR

  Select Msg
    Case #WM_NOTIFY
      *NMHdr = LParam

      If *NMHdr\hwndFrom = GadgetID(0)       
        If *NMHdr\code = #LVN_ITEMCHANGING
          If DraggingIsActive And GetGadgetState(0) = -1
            ; ----- Disable highlighting of item under cursor
            ProcedureReturn #True
          EndIf
        EndIf
      EndIf
  EndSelect

  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

Procedure DragCallback(Action.I)
  Shared HeaderHeight.I
  Shared RowHeight.I
  Shared RowInsertionIndex.I

  Protected CursorPositon.POINT
  Protected CursorRow.I
  Protected InsertMark.LVINSERTMARK
  Protected Rectangle.RECT
  Protected RowCount.I

  InsertMark\cbSize = SizeOf(LVINSERTMARK)
  GetCursorPos_(CursorPositon)
  GetWindowRect_(GadgetID(0), Rectangle)

  If PtInRect_(Rectangle, CursorPositon\x + (CursorPositon\y) << 32)
    ; ----- Convert x and y from coordinate space to window-relative space
    MapWindowPoints_(0, GadgetID(0), CursorPositon, 1)

    ; ----- Get row index of current cursor position
    CursorRow = (CursorPositon\y - HeaderHeight) / RowHeight
    RowCount = CountGadgetItems(0)

    If CursorRow >= RowCount
      ; ----- Cursor is in empty row below last item
      RowInsertionIndex = RowCount
    ElseIf CursorRow = -1
      CursorRow = 0
    Else
      ; ----- Get row insertion index
      SendMessage_(GadgetID(0), #LVM_INSERTMARKHITTEST, @CursorPositon,
        @InsertMark)
      ; ----- Display insertion line
      SendMessage_(GadgetID(0), #LVM_SETINSERTMARK, 0, @InsertMark)
      RowInsertionIndex = InsertMark\iItem

      ; ----- Increase index if cursor is in lower part of row
      If (CursorPositon\y - HeaderHeight) % RowHeight > RowHeight * 0.5
        RowInsertionIndex + 1
      EndIf
    EndIf

    ProcedureReturn #True
  EndIf
EndProcedure

Procedure DropCallback(TargetHandle.I, Status.I, Format.I, Action.I, x.I, y.I)
  Shared DraggingIsActive.I

  Protected InsertMark.LVINSERTMARK
  Protected Result.I = #False

  InsertMark\cbSize = SizeOf(LVINSERTMARK)

  Select Status
    Case #PB_Drag_Move, #PB_Drag_Enter
      DraggingIsActive = #True
    Case #PB_Drag_Leave, #PB_Drag_Finish
      DraggingIsActive = #False

      ; ----- Remove insertion line
      InsertMark\iItem = -1
      SendMessage_(GadgetID(0), #LVM_SETINSERTMARK, 0, @InsertMark)
  EndSelect

  If Status <> #PB_Drag_Leave
    Result = #True
  EndIf

  ProcedureReturn Result
EndProcedure

OpenWindow(0, 100, 100, 370, 150, "Drag 'n drop row inside gadget")

ListIconGadget(0, 10, 10, WindowWidth(0) - 20, WindowHeight(0) - 20,
  "Name", 100,
  #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
AddGadgetColumn(0, 1, "Address", GadgetWidth(0) - GetGadgetItemAttribute(0,
  0, #PB_ListIcon_ColumnWidth) - 4)
AddGadgetItem(0, -1, "Harry Rannit" + #LF$ +
  "12 Parliament Way, Battle Street, By the Bay")
AddGadgetItem(0, -1, "Ginger Brokeit" + #LF$ +
  "130 PureBasic Road, BigTown, CodeCity")
AddGadgetItem(0, -1, "Didi Foundit" + #LF$ +
  "321 Logo Drive, Mouse House, Downtown")
EnableGadgetDrop(0, #PB_Drop_Text, #PB_Drag_Copy)
SetDragCallback(@DragCallback())
SetDropCallback(@DropCallback())

; ----- Get height of header row
GetClientRect_(SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0), @Rectangle)
HeaderHeight = Rectangle\bottom - Rectangle\top

; ----- Get height of single row
RowHeight = SendMessage_(GadgetID(0), #LVM_GETITEMSPACING, #True, 0) >> 16

; ----- Initialize WindowCallback to suppress highlighting
SetWindowCallback(@WindowCallback(), 0)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Break
    Case #PB_Event_Gadget
      If EventGadget() = 0 And EventType() = #PB_EventType_DragStart
        DraggingIsActive = #True
        RowIndex = GetGadgetState(0)

        ; ----- Deselect any selected entry
        SetGadgetState(0, -1)
     
        If RowIndex >= 0
          DragText(GetGadgetItemText(0, RowIndex, 0) + #LF$ +
            GetGadgetItemText(0, RowIndex, 1), #PB_Drag_Copy)
        EndIf
      EndIf
    Case #PB_Event_GadgetDrop
      AddGadgetItem(0, RowInsertionIndex, EventDropText())

      ; ----- Deselect any selected entry
      SetGadgetState(0, -1)
  EndSelect
ForEver
Update: I have modified my example to remove the bug reported by camille in the following posting.

Re: Visual Help for drag&drop in ListView

Posted: Wed Jan 08, 2020 9:00 pm
by camille
Buuuuugs! You want one? You get one!

:oops:

Drag a row out of the list view (it doesn't matter if you are still inside the window boundaries or not) and drag
it into it again. The row highlighting is back.

I know this may be a rare case but if you move the mouse too fast this can easily happen.

Apart from that, it works fine!

Re: Visual Help for drag&drop in ListView

Posted: Thu Jan 09, 2020 10:10 am
by Shardik
camille wrote:Buuuuugs! You want one? You get one!
Thank you again for your bug report. I have modified my last example and tried to eliminate that bug. Please try again... :wink:

Re: Visual Help for drag&drop in ListView

Posted: Thu Jan 09, 2020 2:02 pm
by Mindphazer
Thank you Shardik for your code
Do you think it's possible to have a working code in which you move a line instead of making a copy of it ?

That would be great

Thanks

Re: Visual Help for drag&drop in ListView

Posted: Thu Jan 09, 2020 5:29 pm
by camille
@Shardik

Works fine! Thanks again!

@Mindphazer
You only need to replace the two occurrences of #PB_Drag_Copy with #PB_Drag_Move
and insert this:
RemoveGadgetItem(0, RowIndex)

Before the line:
AddGadgetItem(0, RowInsertionIndex, EventDropText())

Re: Visual Help for drag&drop in ListView

Posted: Thu Jan 09, 2020 6:44 pm
by Mindphazer
@camille
Thanks a lot, I was a bit too lazy to search :mrgreen:

Re: Visual Help for drag&drop in ListView

Posted: Sat Jan 11, 2020 11:35 am
by tatanas
If you need the text from the line you're dragging on overlapping textgadget, you can do this :
(comment/uncomment to get a transparent background version)

Code: Select all

Structure LVINSERTMARK
	cbSize.L
	dwFlags.L
	iItem.L
	dwReserved.L
EndStructure

Define DraggingIsActive.I
Define HeaderHeight.I
Define Rectangle.RECT
Define RowIndex.I
Define RowHeight.I
Define RowInsertionIndex.I
Global dragtext.s

Procedure myTextWidth(text$, Window)
	Protected Length = 0
	If StartDrawing(WindowOutput(Window))
		DrawingFont(GetStockObject_(#DEFAULT_GUI_FONT))
		Length = TextWidth(text$)
		StopDrawing()
	EndIf
	ProcedureReturn Length
EndProcedure

Procedure myTextHeight(text$, Window)
	Protected Length = 0
	If StartDrawing(WindowOutput(Window))
		DrawingFont(GetStockObject_(#DEFAULT_GUI_FONT))
		Length = TextHeight(text$)
		StopDrawing()
	EndIf
	ProcedureReturn Length
EndProcedure

Procedure WindowCallback(WindowHandle.I, Msg.I, WParam.I, LParam.I)
	Shared DraggingIsActive.I
	
	Protected *NMHdr.NMHDR
	
	Select Msg
		Case #WM_NOTIFY
			*NMHdr = LParam
			
			If *NMHdr\hwndFrom = GadgetID(0)       
				If *NMHdr\code = #LVN_ITEMCHANGING
					If DraggingIsActive And GetGadgetState(0) = -1
						; ----- Disable highlighting of item under cursor
						ProcedureReturn #True
					EndIf
				EndIf
			EndIf
			
		; uncomment this message if you test the transparent version
; 		Case #WM_CTLCOLORSTATIC
; 			Select LParam
; 				Case GadgetID(1)
; 					SetBkMode_(wparam,#TRANSPARENT)
; 					SetTextColor_(wParam,$FF0000)
; 					ProcedureReturn GetStockObject_(#HOLLOW_BRUSH)
; 			EndSelect
	EndSelect
	
	ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

Procedure DragCallback(Action.I)
	Shared HeaderHeight.I
	Shared RowHeight.I
	Shared RowInsertionIndex.I
	
	Protected CursorPositon.POINT
	Protected CursorRow.I
	Protected InsertMark.LVINSERTMARK
	Protected Rectangle.RECT
	Protected RowCount.I
	
	InsertMark\cbSize = SizeOf(LVINSERTMARK)
	GetCursorPos_(CursorPositon)
	GetWindowRect_(GadgetID(0), Rectangle)
	
	If PtInRect_(Rectangle, CursorPositon\x + (CursorPositon\y) << 32)
		; ----- Convert x and y from coordinate space to window-relative space
		MapWindowPoints_(0, GadgetID(0), CursorPositon, 1)
		
		; ----- Get row index of current cursor position
		CursorRow = (CursorPositon\y - HeaderHeight) / RowHeight
		RowCount = CountGadgetItems(0)
		
		If CursorRow >= RowCount
			; ----- Cursor is in empty row below last item
			RowInsertionIndex = RowCount
		ElseIf CursorRow = -1
			CursorRow = 0
		Else
			; ----- Get row insertion index
			SendMessage_(GadgetID(0), #LVM_INSERTMARKHITTEST, @CursorPositon, @InsertMark)
			; ----- Display insertion line
			SendMessage_(GadgetID(0), #LVM_SETINSERTMARK, 0, @InsertMark)
			RowInsertionIndex = InsertMark\iItem
			
			; ----- Increase index if cursor is in lower part of row
			If (CursorPositon\y - HeaderHeight) % RowHeight > RowHeight * 0.5
				RowInsertionIndex + 1
			EndIf

			ResizeGadget(1, CursorPositon\x + 30, CursorPositon\y + 10, #PB_Ignore, #PB_Ignore)
			GetWindowRect_(GadgetID(1), crc.RECT)
			MapWindowPoints_(0, WindowID(0), crc, 2)
			InvalidateRect_(WindowID(0), crc, 0)
		EndIf
		
		ProcedureReturn #True
	EndIf
EndProcedure

Procedure DropCallback(TargetHandle.I, Status.I, Format.I, Action.I, x.I, y.I)
	Shared DraggingIsActive.I
	
	Protected InsertMark.LVINSERTMARK
	Protected Result.I = #False
	
	InsertMark\cbSize = SizeOf(LVINSERTMARK)
	
	Select Status
		Case #PB_Drag_Move, #PB_Drag_Enter
			DraggingIsActive = #True
		Case #PB_Drag_Leave, #PB_Drag_Finish
			DraggingIsActive = #False
			
			; ----- Remove insertion line
			InsertMark\iItem = -1
			SendMessage_(GadgetID(0), #LVM_SETINSERTMARK, 0, @InsertMark)
	EndSelect
	
	If Status <> #PB_Drag_Leave
		Result = #True
	EndIf
	
	ProcedureReturn Result
EndProcedure

OpenWindow(0, 100, 100, 370, 150, "Drag 'n drop row inside gadget")

ListIconGadget(0, 10, 10, WindowWidth(0) - 20, WindowHeight(0) - 20, "Name", 100, #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
AddGadgetColumn(0, 1, "Address", GadgetWidth(0) - GetGadgetItemAttribute(0, 0, #PB_ListIcon_ColumnWidth) - 4)
AddGadgetItem(0, -1, "Harry Rannit" + #LF$ + "12 Parliament Way, Battle Street, By the Bay")
AddGadgetItem(0, -1, "Ginger Brokeit" + #LF$ + "130 PureBasic Road, BigTown, CodeCity")
AddGadgetItem(0, -1, "Didi Foundit" + #LF$ + "321 Logo Drive, Mouse House, Downtown")
EnableGadgetDrop(0, #PB_Drop_Text, #PB_Drag_Copy)
SetDragCallback(@DragCallback())
SetDropCallback(@DropCallback())

; ----- Get height of header row
GetClientRect_(SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0), @Rectangle)
HeaderHeight = Rectangle\bottom - Rectangle\top

; ----- Get height of single row
RowHeight = SendMessage_(GadgetID(0), #LVM_GETITEMSPACING, #True, 0) >> 16

; ----- Initialize WindowCallback to suppress highlighting
SetWindowCallback(@WindowCallback(), 0)

Repeat
	Select WaitWindowEvent()
		Case #PB_Event_CloseWindow
			Break
		Case #PB_Event_Gadget
			If EventGadget() = 0 And EventType() = #PB_EventType_DragStart
				DraggingIsActive = #True
				RowIndex = GetGadgetState(0)
				
				; ----- Deselect any selected entry
				SetGadgetState(0, -1)

				If RowIndex >= 0
					dragtext = GetGadgetItemText(0, RowIndex, 0)
					w = myTextWidth(dragtext, 0)
					h = myTextHeight(dragtext, 0)
					TextGadget(1, WindowMouseX(0) + 30, WindowMouseY(0) + 10, w, h, dragtext)
					
					; comment this 2 lines if you test the transparent version
					SetGadgetColor(1, #PB_Gadget_BackColor, #White)
					SetGadgetColor(1, #PB_Gadget_FrontColor, #Blue)

					DragText(GetGadgetItemText(0, RowIndex, 0) + #LF$ + GetGadgetItemText(0, RowIndex, 1), #PB_Drag_Copy)
				EndIf			
			
			EndIf
		Case #PB_Event_GadgetDrop
			FreeGadget(1)

			AddGadgetItem(0, RowInsertionIndex, EventDropText())
			
			; ----- Deselect any selected entry
			SetGadgetState(0, -1)
	EndSelect
ForEver
EDIT : It's working fine in this example but flickers a lot with my main code...

Re: Visual Help for drag&drop in ListView

Posted: Sat Jan 11, 2020 5:58 pm
by tatanas
Ok I know why it's flickering like hell. My listview is inside a panelgadget.

This code use an imagegadget instead of textgadget but the problem is still the same...

Code: Select all

Structure LVINSERTMARK
	cbSize.L
	dwFlags.L
	iItem.L
	dwReserved.L
EndStructure

Define DraggingIsActive.I
Define HeaderHeight.I
Define Rectangle.RECT
Define RowIndex.I
Define RowHeight.I
Define RowInsertionIndex.I
Global dragtext.s

Procedure myTextWidth(text$, Window)
	Protected Length = 0
	If StartDrawing(WindowOutput(Window))
		DrawingFont(GetStockObject_(#DEFAULT_GUI_FONT))
		Length = TextWidth(text$)
		StopDrawing()
	EndIf
	ProcedureReturn Length
EndProcedure

Procedure myTextHeight(text$, Window)
	Protected Length = 0
	If StartDrawing(WindowOutput(Window))
		DrawingFont(GetStockObject_(#DEFAULT_GUI_FONT))
		Length = TextHeight(text$)
		StopDrawing()
	EndIf
	ProcedureReturn Length
EndProcedure

Procedure WindowCallback(WindowHandle.I, Msg.I, WParam.I, LParam.I)
	Shared DraggingIsActive.I
	
	Protected *NMHdr.NMHDR
	
	Select Msg
		Case #WM_NOTIFY
			*NMHdr = LParam
			
			If *NMHdr\hwndFrom = GadgetID(0)       
				If *NMHdr\code = #LVN_ITEMCHANGING
					If DraggingIsActive And GetGadgetState(0) = -1
						; ----- Disable highlighting of item under cursor
						ProcedureReturn #True
					EndIf
				EndIf
			EndIf
			
		; uncomment this message if you test the transparent version
; 		Case #WM_CTLCOLORSTATIC
; 			Select LParam
; 				Case GadgetID(1)
; 					SetBkMode_(wparam,#TRANSPARENT)
; 					SetTextColor_(wParam,$FF0000)
; 					ProcedureReturn GetStockObject_(#HOLLOW_BRUSH)
; 			EndSelect
	EndSelect
	
	ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

Procedure DragCallback(Action.I)
	Shared HeaderHeight.I
	Shared RowHeight.I
	Shared RowInsertionIndex.I
	
	Protected CursorPositon.POINT
	Protected CursorRow.I
	Protected InsertMark.LVINSERTMARK
	Protected Rectangle.RECT
	Protected RowCount.I
	
	InsertMark\cbSize = SizeOf(LVINSERTMARK)
	GetCursorPos_(CursorPositon)
	GetWindowRect_(GadgetID(0), Rectangle)
	
	If PtInRect_(Rectangle, CursorPositon\x + (CursorPositon\y) << 32)
		; ----- Convert x and y from coordinate space to window-relative space
		MapWindowPoints_(0, GadgetID(0), CursorPositon, 1)
		
		; ----- Get row index of current cursor position
		CursorRow = (CursorPositon\y - HeaderHeight) / RowHeight
		RowCount = CountGadgetItems(0)
		
		If CursorRow >= RowCount
			; ----- Cursor is in empty row below last item
			RowInsertionIndex = RowCount
		ElseIf CursorRow = -1
			CursorRow = 0
		Else
			; ----- Get row insertion index
			SendMessage_(GadgetID(0), #LVM_INSERTMARKHITTEST, @CursorPositon, @InsertMark)
			; ----- Display insertion line
			SendMessage_(GadgetID(0), #LVM_SETINSERTMARK, 0, @InsertMark)
			RowInsertionIndex = InsertMark\iItem
			
			; ----- Increase index if cursor is in lower part of row
			If (CursorPositon\y - HeaderHeight) % RowHeight > RowHeight * 0.5
				RowInsertionIndex + 1
			EndIf
			
; 			ResizeGadget(1, CursorPositon\x + 30, CursorPositon\y + 10, #PB_Ignore, #PB_Ignore)
			ResizeGadget(1, CursorPositon\x + 30, CursorPositon\y + 10, #PB_Ignore, #PB_Ignore)
			
; 			GetWindowRect_(GadgetID(1), crc.RECT)
; 			MapWindowPoints_(0, WindowID(0), crc, 2)
; 			InvalidateRect_(WindowID(0), crc, 0)

		EndIf
		
		ProcedureReturn #True
	EndIf
EndProcedure

Procedure DropCallback(TargetHandle.I, Status.I, Format.I, Action.I, x.I, y.I)
	Shared DraggingIsActive.I
	
	Protected InsertMark.LVINSERTMARK
	Protected Result.I = #False
	
	InsertMark\cbSize = SizeOf(LVINSERTMARK)
	
	Select Status
		Case #PB_Drag_Move, #PB_Drag_Enter
			DraggingIsActive = #True
		Case #PB_Drag_Leave, #PB_Drag_Finish
			DraggingIsActive = #False
			
			; ----- Remove insertion line
			InsertMark\iItem = -1
			SendMessage_(GadgetID(0), #LVM_SETINSERTMARK, 0, @InsertMark)
	EndSelect
	
	If Status <> #PB_Drag_Leave
		Result = #True
	EndIf
	
	ProcedureReturn Result
EndProcedure

OpenWindow(0, 100, 100, 370, 180, "Drag 'n drop row inside gadget")

onglet = PanelGadget(#PB_Any, 5, 0, 360, 175)
AddGadgetItem(onglet, -1, "tab")
  
ListIconGadget(0, 5, 10, 340, 130, "Name", 100, #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
AddGadgetColumn(0, 1, "Address", GadgetWidth(0) - GetGadgetItemAttribute(0, 0, #PB_ListIcon_ColumnWidth) - 4)
AddGadgetItem(0, -1, "Harry Rannit" + #LF$ + "12 Parliament Way, Battle Street, By the Bay")
AddGadgetItem(0, -1, "Ginger Brokeit" + #LF$ + "130 PureBasic Road, BigTown, CodeCity")
AddGadgetItem(0, -1, "Didi Foundit" + #LF$ + "321 Logo Drive, Mouse House, Downtown")

CloseGadgetList()

EnableGadgetDrop(0, #PB_Drop_Text, #PB_Drag_Copy)
SetDragCallback(@DragCallback())
SetDropCallback(@DropCallback())

; ----- Get height of header row
GetClientRect_(SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0), @Rectangle)
HeaderHeight = Rectangle\bottom - Rectangle\top

; ----- Get height of single row
RowHeight = SendMessage_(GadgetID(0), #LVM_GETITEMSPACING, #True, 0) >> 16

; ----- Initialize WindowCallback to suppress highlighting
SetWindowCallback(@WindowCallback(), 0)

Repeat
	Select WaitWindowEvent()
		Case #PB_Event_CloseWindow
			Break
		Case #PB_Event_Gadget
			If EventGadget() = 0 And EventType() = #PB_EventType_DragStart
				DraggingIsActive = #True
				RowIndex = GetGadgetState(0)
				
				; ----- Deselect any selected entry
				SetGadgetState(0, -1)

				If RowIndex >= 0
					dragtext = GetGadgetItemText(0, RowIndex, 0)
					w = myTextWidth(dragtext, 0)
					h = myTextHeight(dragtext, 0)
; 					TextGadget(1, WindowMouseX(0) + 30, WindowMouseY(0) + 10, w, h, dragtext)
					
					; comment this 2 lines if you test the transparent version
; 					SetGadgetColor(1, #PB_Gadget_FrontColor, #White)
; 					SetGadgetColor(1, #PB_Gadget_BackColor, #Blue)
					
					CreateImage(9, w, h); , 32, #PB_Image_Transparent)
					StartDrawing(ImageOutput(9))
; 					DrawingMode(#PB_2DDrawing_AllChannels)
					DrawingFont(GetStockObject_(#DEFAULT_GUI_FONT))
					DrawText(0, 0, dragtext, #Blue, #White) ; RGBA(0, 0, 0, 255), RGBA(255, 255, 255, 0)
					StopDrawing()
					ImageGadget(1, 0, 0, 0, 0, ImageID(9))					

					DragText(GetGadgetItemText(0, RowIndex, 0) + #LF$ + GetGadgetItemText(0, RowIndex, 1), #PB_Drag_Copy)
				EndIf			
			
			EndIf
		Case #PB_Event_GadgetDrop
			FreeGadget(1)
			FreeImage(9)

			AddGadgetItem(0, RowInsertionIndex, EventDropText())
			
			; ----- Deselect any selected entry
			SetGadgetState(0, -1)
	EndSelect
ForEver

EDIT : For now the best way to avoid this flickering is to create a popup window and make image or text gadget inside. Then move the window according to the drag item.

Code: Select all

Structure LVINSERTMARK
	cbSize.L
	dwFlags.L
	iItem.L
	dwReserved.L
EndStructure

Define DraggingIsActive.I
Define HeaderHeight.I
Define Rectangle.RECT
Define RowIndex.I
Define RowHeight.I
Define RowInsertionIndex.I
Global dragtext.s

Procedure myTextWidth(text$, Window)
	Protected Length = 0
	If StartDrawing(WindowOutput(Window))
		DrawingFont(GetStockObject_(#DEFAULT_GUI_FONT))
		Length = TextWidth(text$)
		StopDrawing()
	EndIf
	ProcedureReturn Length
EndProcedure

Procedure myTextHeight(text$, Window)
	Protected Length = 0
	If StartDrawing(WindowOutput(Window))
		DrawingFont(GetStockObject_(#DEFAULT_GUI_FONT))
		Length = TextHeight(text$)
		StopDrawing()
	EndIf
	ProcedureReturn Length
EndProcedure

Procedure WindowCallback(WindowHandle.I, Msg.I, WParam.I, LParam.I)
	Shared DraggingIsActive.I
	
	Protected *NMHdr.NMHDR
	
	Select Msg
		Case #WM_NOTIFY
			*NMHdr = LParam
			
			If *NMHdr\hwndFrom = GadgetID(0)       
				If *NMHdr\code = #LVN_ITEMCHANGING
					If DraggingIsActive And GetGadgetState(0) = -1
						; ----- Disable highlighting of item under cursor
						ProcedureReturn #True
					EndIf
				EndIf
			EndIf
			
		; uncomment this message if you test the transparent version
; 		Case #WM_CTLCOLORSTATIC
; 			Select LParam
; 				Case GadgetID(1)
; 					SetBkMode_(wparam,#TRANSPARENT)
; 					SetTextColor_(wParam,$FF0000)
; 					ProcedureReturn GetStockObject_(#HOLLOW_BRUSH)
; 			EndSelect
	EndSelect
	
	ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

Procedure DragCallback(Action.I)
	Shared HeaderHeight.I
	Shared RowHeight.I
	Shared RowInsertionIndex.I
	
	Protected CursorPositon.POINT
	Protected CursorRow.I
	Protected InsertMark.LVINSERTMARK
	Protected Rectangle.RECT
	Protected RowCount.I
	
	InsertMark\cbSize = SizeOf(LVINSERTMARK)
	GetCursorPos_(CursorPositon)
	GetWindowRect_(GadgetID(0), Rectangle)
	
	If PtInRect_(Rectangle, CursorPositon\x + (CursorPositon\y) << 32)
		; ----- Convert x and y from coordinate space to window-relative space
		MapWindowPoints_(0, GadgetID(0), CursorPositon, 1)
		
		; ----- Get row index of current cursor position
		CursorRow = (CursorPositon\y - HeaderHeight) / RowHeight
		RowCount = CountGadgetItems(0)
		
		If CursorRow >= RowCount
			; ----- Cursor is in empty row below last item
			RowInsertionIndex = RowCount
		ElseIf CursorRow = -1
			CursorRow = 0
		Else
			; ----- Get row insertion index
			SendMessage_(GadgetID(0), #LVM_INSERTMARKHITTEST, @CursorPositon, @InsertMark)
			; ----- Display insertion line
			SendMessage_(GadgetID(0), #LVM_SETINSERTMARK, 0, @InsertMark)
			RowInsertionIndex = InsertMark\iItem
			
			; ----- Increase index if cursor is in lower part of row
			If (CursorPositon\y - HeaderHeight) % RowHeight > RowHeight * 0.5
				RowInsertionIndex + 1
			EndIf
			
			ResizeWindow(1, WindowX(0) + WindowMouseX(0) + 30, WindowY(0) + WindowMouseY(0) + 10, #PB_Ignore, #PB_Ignore)
		
		EndIf
		
		ProcedureReturn #True
	EndIf
EndProcedure

Procedure DropCallback(TargetHandle.I, Status.I, Format.I, Action.I, x.I, y.I)
	Shared DraggingIsActive.I
	
	Protected InsertMark.LVINSERTMARK
	Protected Result.I = #False
	
	InsertMark\cbSize = SizeOf(LVINSERTMARK)
	
	Select Status
		Case #PB_Drag_Move, #PB_Drag_Enter
			DraggingIsActive = #True
		Case #PB_Drag_Leave, #PB_Drag_Finish
			DraggingIsActive = #False
			
			; ----- Remove insertion line
			InsertMark\iItem = -1
			SendMessage_(GadgetID(0), #LVM_SETINSERTMARK, 0, @InsertMark)
	EndSelect
	
	If Status <> #PB_Drag_Leave
		Result = #True
	EndIf
	
	ProcedureReturn Result
EndProcedure

OpenWindow(0, 100, 100, 370, 180, "Drag 'n drop row inside gadget")

onglet = PanelGadget(#PB_Any, 5, 0, 360, 175)
AddGadgetItem(onglet, -1, "tab")
  
ListIconGadget(0, 5, 10, 340, 130, "Name", 100, #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
AddGadgetColumn(0, 1, "Address", GadgetWidth(0) - GetGadgetItemAttribute(0, 0, #PB_ListIcon_ColumnWidth) - 4)
AddGadgetItem(0, -1, "Harry Rannit" + #LF$ + "12 Parliament Way, Battle Street, By the Bay")
AddGadgetItem(0, -1, "Ginger Brokeit" + #LF$ + "130 PureBasic Road, BigTown, CodeCity")
AddGadgetItem(0, -1, "Didi Foundit" + #LF$ + "321 Logo Drive, Mouse House, Downtown")

CloseGadgetList()


EnableGadgetDrop(0, #PB_Drop_Text, #PB_Drag_Copy)
SetDragCallback(@DragCallback())
SetDropCallback(@DropCallback())

; ----- Get height of header row
GetClientRect_(SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0), @Rectangle)
HeaderHeight = Rectangle\bottom - Rectangle\top

; ----- Get height of single row
RowHeight = SendMessage_(GadgetID(0), #LVM_GETITEMSPACING, #True, 0) >> 16

; ----- Initialize WindowCallback to suppress highlighting
SetWindowCallback(@WindowCallback(), 0)

Repeat
	Select WaitWindowEvent()
		Case #PB_Event_CloseWindow
			Break
		Case #PB_Event_Gadget
			If EventGadget() = 0 And EventType() = #PB_EventType_DragStart
				DraggingIsActive = #True
				RowIndex = GetGadgetState(0)
				
				; ----- Deselect any selected entry
				SetGadgetState(0, -1)

				If RowIndex >= 0
					dragtext = GetGadgetItemText(0, RowIndex, 0)
					w = myTextWidth(dragtext, 0)
					h = myTextHeight(dragtext, 0)
					
					OpenWindow(1, WindowX(0) + WindowMouseX(0) + 30, WindowY(0) + WindowMouseY(0) + 10, w, h, "", #PB_Window_BorderLess, WindowID(0))
					TextGadget(1, 0, 0, w, h, dragtext)
					SetGadgetColor(1, #PB_Gadget_FrontColor, #White)
					SetGadgetColor(1, #PB_Gadget_BackColor, #Blue)

					DragText(GetGadgetItemText(0, RowIndex, 0) + #LF$ + GetGadgetItemText(0, RowIndex, 1), #PB_Drag_Copy)
				EndIf			
			
			EndIf
		Case #PB_Event_GadgetDrop
			CloseWindow(1)
			
			AddGadgetItem(0, RowInsertionIndex, EventDropText())
			
			; ----- Deselect any selected entry
			SetGadgetState(0, -1)
	EndSelect
ForEver
All times are UTC+01:00
Page 2 of 3

Powered by phpBB® Forum Software © phpBB Limited