Visual Help for drag&drop in ListView

Just starting out? Need help? Post your questions and find answers here.
camille
User
User
Posts: 71
Joined: Tue Nov 19, 2019 12:52 pm

Re: Visual Help for drag&drop in ListView

Post by camille »

Have you already tried RASHAD's modification of my example which uses SetWindowsTheme with "Explorer" to eliminate the highlighting?
Does it fully eliminate the highlighting for you?

It does modify it here on my system (Windows Server 2019, 10.0.17763.107), but it is still a light blue (and not a darker one without the modification) that is visible when hovering over a column...
tatanas
Enthusiast
Enthusiast
Posts: 260
Joined: Wed Nov 06, 2019 10:28 am
Location: France

Re: Visual Help for drag&drop in ListView

Post by tatanas »

Same here too.
There is still a light blue selection.

EDIT : it works better but it hangs when you select an item in the right listview and retry a drag.

Code: Select all

EnableExplicit

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

Define HeaderHeight.I
Define Rectangle.RECT
Define Row.I
Define RowHeight.I
Define RowInsertionIndex.I
Global drag = #False

Procedure WinProc(hWnd, Msg, wParam, lParam)
   Protected result = #PB_ProcessPureBasicEvents   
   Protected *tInfo.NMITEMACTIVATE

   Select Msg
         
      Case #WM_NOTIFY
     
         Protected *tNMHDR.NMHDR = lParam
         
         Select *tNMHDR\hwndFrom
               
            Case GadgetID(1)       
               Select *tNMHDR\code
						Case #LVN_ITEMCHANGING
							If drag
								ProcedureReturn #True ; disable Highlight
							Else
								ProcedureReturn #False ; normal behaviour
							EndIf
                     
               EndSelect
                           
         EndSelect
                        
   EndSelect
   ProcedureReturn result
EndProcedure

Procedure DragCallback(Action.I)
   Shared HeaderHeight.I
   Shared RowHeight.I
   Shared RowInsertionIndex.I
   
   Protected CursorPositon.POINT
   Protected InsertMark.LVINSERTMARK
   Protected Rectangle.RECT
   
   InsertMark\cbSize = SizeOf(LVINSERTMARK)
   GetCursorPos_(CursorPositon)
   GetWindowRect_(GadgetID(1), Rectangle)
   
   If PtInRect_(Rectangle, CursorPositon \ x + (CursorPositon \ y) << 32)
      MapWindowPoints_(0, GadgetID(1), CursorPositon, 1)
      
      ; ----- Display insertion line
      SendMessage_(GadgetID(1), #LVM_INSERTMARKHITTEST, @CursorPositon, @InsertMark)
   
      If SendMessage_(GadgetID(1), #LVM_SETINSERTMARK, 0, @InsertMark)
         RowInsertionIndex = InsertMark\iItem
         
         If (CursorPositon\y - HeaderHeight) % RowHeight > RowHeight * 0.5
            RowInsertionIndex + 1
         EndIf
      EndIf
      
      ProcedureReturn #True
   EndIf
EndProcedure

OpenWindow(0, 0, 0, 730, 500, "Drag row from left to right", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

ListIconGadget(0, 10, 10, WindowWidth(0) / 2 - 15, 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")

ListIconGadget(1, WindowWidth(0) / 2 + 5, 10, WindowWidth(0) / 2 - 15, WindowHeight(0) - 20,  "Name", 100, #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
AddGadgetColumn(1, 1, "Address", GadgetWidth(0) - GetGadgetItemAttribute(0, 0, #PB_ListIcon_ColumnWidth) - 4)

EnableGadgetDrop(1, #PB_Drop_Text, #PB_Drag_Copy)
SetDragCallback(@DragCallback())

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

; ----- Get height of single row
RowHeight = SendMessage_(GadgetID(0), #LVM_GETITEMSPACING, #True, 0) >> 16
SendMessage_(GadgetID(1), #LVM_SETINSERTMARKCOLOR, 0, $0000FF) ; couleur de la ligne d'insertion

SetWindowCallback(@WinProc(), 0)

Repeat
   Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
         Break
      Case #PB_Event_Gadget
         If EventGadget() = 0 And EventType() = #PB_EventType_DragStart
				drag = #True
            Row = GetGadgetState(0)
            
            If Row >= 0
               DragText(GetGadgetItemText(0, Row, 0) + #LF$ + GetGadgetItemText(0, Row, 1), #PB_Drag_Copy)
            EndIf
         EndIf
      Case #PB_Event_GadgetDrop
			drag = #False
         AddGadgetItem(1, RowInsertionIndex, EventDropText())
   EndSelect
ForEver
Windows 10 Pro x64
PureBasic 6.20 x64
User avatar
Shardik
Addict
Addict
Posts: 2058
Joined: Thu Apr 21, 2005 2:38 pm
Location: Germany

Re: Visual Help for drag&drop in ListView

Post by Shardik »

camille wrote:Does it fully eliminate the highlighting for you?

It does modify it here on my system (Windows Server 2019, 10.0.17763.107), but it is still a light blue (and not a darker one without the modification) that is visible when hovering over a column...
tatanas wrote:Same here too.
There is still a light blue selection.
Unfortunately you are both right.

I know that there always exists the possibility to use a callback like tatanas demonstrated and which also had been my first idea. But RASHAD's approach is so much simpler and shorter! I have now found a solution using RASHAD's approach. Please try and add the following code to my example or change RASHAD's code accordingly:

Code: Select all

Import "UxTheme.lib"
  SetWindowTheme(WindowHandle.I, SubAppName.P-Unicode, ClassNameList.P-Unicode)
EndImport

Code: Select all

SetWindowTheme(GadgetID(1), "", "STATUS")
camille
User
User
Posts: 71
Joined: Tue Nov 19, 2019 12:52 pm

Re: Visual Help for drag&drop in ListView

Post by camille »

Thanks for trying to "fix" this, Shardik!

With your latest modification the light blue is removed and it really looks like it should.

But...
There is a drawback.

Look at these pictures please:
01. Your code without the SetWindowTheme(GadgetID(1), "", "STATUS" line
https://imgur.com/a/UUlAML8

02. Your code including that line
https://imgur.com/a/3oUWNB2

The last one:
- The black border around the gadget is missing
- The column separation lines are shifted a bit to the left (marked in red) after the header row
tatanas
Enthusiast
Enthusiast
Posts: 260
Joined: Wed Nov 06, 2019 10:28 am
Location: France

Re: Visual Help for drag&drop in ListView

Post by tatanas »

You made my day Shardik ! :) And thank you to RASHAD too !

It is just I wanted to do :

Code: Select all

EnableExplicit

Import "UxTheme.lib"
  SetWindowTheme(WindowHandle.I, SubAppName.P-Unicode, ClassNameList.P-Unicode)
EndImport

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

Define HeaderHeight.I
Define Rectangle.RECT
Define Row.I
Define RowHeight.I
Define RowInsertionIndex.I


Procedure DragCallback(Action.I)
   Shared HeaderHeight.I
   Shared RowHeight.I
   Shared RowInsertionIndex.I
   
   Protected CursorPositon.POINT
   Protected InsertMark.LVINSERTMARK
   Protected Rectangle.RECT
   
   InsertMark\cbSize = SizeOf(LVINSERTMARK)
   GetCursorPos_(CursorPositon)
   GetWindowRect_(GadgetID(0), Rectangle)
   
   If PtInRect_(Rectangle, CursorPositon \ x + (CursorPositon \ y) << 32)
      MapWindowPoints_(0, GadgetID(0), CursorPositon, 1)
      
      ; ----- Display insertion line
      SendMessage_(GadgetID(0), #LVM_INSERTMARKHITTEST, @CursorPositon, @InsertMark)
   
      If SendMessage_(GadgetID(0), #LVM_SETINSERTMARK, 0, @InsertMark)
         RowInsertionIndex = InsertMark\iItem
         
         If (CursorPositon\y - HeaderHeight) % RowHeight > RowHeight * 0.5
            RowInsertionIndex + 1
         EndIf
      EndIf
      
      ProcedureReturn #True
   EndIf
EndProcedure

OpenWindow(0, 0, 0, 400, 500, "Drag row from left to right", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

ListIconGadget(0, 10, 10, 380, 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")
AddGadgetItem(0, -1, "Didi Foundit" + #LF$ + "321 Logo Drive, Mouse House, Downtown")
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")


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

; ----- 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
SendMessage_(GadgetID(0), #LVM_SETINSERTMARKCOLOR, 0, $0000FF)


Repeat
   Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
         Break
      Case #PB_Event_Gadget
         If EventGadget() = 0 And EventType() = #PB_EventType_DragStart
				SetWindowTheme(GadgetID(0), "", "STATUS")
            Row = GetGadgetState(0)
            
            If Row >= 0
               DragText(GetGadgetItemText(0, Row, 0) + #LF$ + GetGadgetItemText(0, Row, 1), #PB_Drag_Copy)
            EndIf
         EndIf
      Case #PB_Event_GadgetDrop
			SetWindowTheme(GadgetID(0), #Null$, #Null$)
        AddGadgetItem(0, RowInsertionIndex, EventDropText())

   EndSelect
ForEver
EDIT1 : Where did you find the value to use with SetWindowTheme() ?
EDIT2 : It seems I can't reapply the previous theme after changing it. SetWindowTheme(GadgetID(0), #Null$, #Null$) is not working as it should or I'm not using it correctly.
Windows 10 Pro x64
PureBasic 6.20 x64
camille
User
User
Posts: 71
Joined: Tue Nov 19, 2019 12:52 pm

Re: Visual Help for drag&drop in ListView

Post by camille »

@tatanas

Your last code seems to work nicely in the first place but this happens when you add enough elements to the list view:

1. Just moved one line to duplicate so that the scrollbar appears (it's still fine)
https://imgur.com/a/BCcf9pP

2. Moved another line to duplicate it (it's getting ugly from here)
https://imgur.com/a/fEhXpMR
tatanas
Enthusiast
Enthusiast
Posts: 260
Joined: Wed Nov 06, 2019 10:28 am
Location: France

Re: Visual Help for drag&drop in ListView

Post by tatanas »

I can't replicate your graphical bug but I found another way to achieve a better result with SetWindowTheme_() (note the '_' at the end of the function)

Code: Select all

EnableExplicit

; Import "UxTheme.lib"
;   SetWindowTheme(WindowHandle.I, SubAppName.P-Unicode, ClassNameList.P-Unicode)
; EndImport

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

Define HeaderHeight.I
Define Rectangle.RECT
Define Row.I
Define RowHeight.I
Define RowInsertionIndex.I


Procedure DragCallback(Action.I)
   Shared HeaderHeight.I
   Shared RowHeight.I
   Shared RowInsertionIndex.I
   
   Protected CursorPositon.POINT
   Protected InsertMark.LVINSERTMARK
   Protected Rectangle.RECT
   
   InsertMark\cbSize = SizeOf(LVINSERTMARK)
   GetCursorPos_(CursorPositon)
   GetWindowRect_(GadgetID(0), Rectangle)
   
   If PtInRect_(Rectangle, CursorPositon \ x + (CursorPositon \ y) << 32)
      MapWindowPoints_(0, GadgetID(0), CursorPositon, 1)
     
      ; ----- Display insertion line
      SendMessage_(GadgetID(0), #LVM_INSERTMARKHITTEST, @CursorPositon, @InsertMark)
   
      If SendMessage_(GadgetID(0), #LVM_SETINSERTMARK, 0, @InsertMark)
         RowInsertionIndex = InsertMark\iItem
         
         If (CursorPositon\y - HeaderHeight) % RowHeight > RowHeight * 0.5
            RowInsertionIndex + 1
         EndIf
      EndIf
     
      ProcedureReturn #True
   EndIf
EndProcedure

OpenWindow(0, 0, 0, 400, 500, "Drag row from left to right", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

ListIconGadget(0, 10, 10, 380, 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")
AddGadgetItem(0, -1, "Didi Foundit" + #LF$ + "321 Logo Drive, Mouse House, Downtown")
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")


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

; ----- 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
SendMessage_(GadgetID(0), #LVM_SETINSERTMARKCOLOR, 0, $0000FF)


Repeat
   Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
         Break
      Case #PB_Event_Gadget
         If EventGadget() = 0 And EventType() = #PB_EventType_DragStart
            SetWindowTheme_(GadgetID(0), #Null, "STATUS")
            Row = GetGadgetState(0)
           
            If Row >= 0
               DragText(GetGadgetItemText(0, Row, 0) + #LF$ + GetGadgetItemText(0, Row, 1), #PB_Drag_Copy)
            EndIf
         EndIf
      Case #PB_Event_GadgetDrop
         SetWindowTheme_(GadgetID(0), #Null, #Null)
        AddGadgetItem(0, RowInsertionIndex, EventDropText())

   EndSelect
ForEver
Windows 10 Pro x64
PureBasic 6.20 x64
camille
User
User
Posts: 71
Joined: Tue Nov 19, 2019 12:52 pm

Re: Visual Help for drag&drop in ListView

Post by camille »

@tatanas

Thanks, this is a lot better when it comes to entries when the scrollbar is already visible.
Unfortunately, it isn't 100% perfect :oops:

The blackouts of the scrollbar arrows (left, right, up, down) are still visible as long as
the drag&drop is in progress but the list view restores them to normal once the drag has happened.

Here is a gif animation that shows the behavior:
https://imgur.com/a/k7EujsY
tatanas
Enthusiast
Enthusiast
Posts: 260
Joined: Wed Nov 06, 2019 10:28 am
Location: France

Re: Visual Help for drag&drop in ListView

Post by tatanas »

It's weird, I don't have the problem.
What's your config ?
Windows 10 Pro x64
PureBasic 6.20 x64
camille
User
User
Posts: 71
Joined: Tue Nov 19, 2019 12:52 pm

Re: Visual Help for drag&drop in ListView

Post by camille »

Windows Server 2019 10.0.17763.107

PB v5.71 LTS x64
User avatar
blueb
Addict
Addict
Posts: 1111
Joined: Sat Apr 26, 2003 2:15 pm
Location: Cuernavaca, Mexico

Re: Visual Help for drag&drop in ListView

Post by blueb »

I have the same problem as Camille.
PureBasic 5.71 x64

see signature below
- It was too lonely at the top.

System : PB 6.21(x64) and Win 11 Pro (x64)
Hardware: AMD Ryzen 9 5900X w/64 gigs Ram, AMD RX 6950 XT Graphics w/16gigs Mem
User avatar
Shardik
Addict
Addict
Posts: 2058
Joined: Thu Apr 21, 2005 2:38 pm
Location: Germany

Re: Visual Help for drag&drop in ListView

Post by Shardik »

camille wrote:Thanks for trying to "fix" this, Shardik!

With your latest modification the light blue is removed and it really looks like it should.

But...
There is a drawback.

Look at these pictures please:
01. Your code without the SetWindowTheme(GadgetID(1), "", "STATUS" line
https://imgur.com/a/UUlAML8

02. Your code including that line
https://imgur.com/a/3oUWNB2

The last one:
- The black border around the gadget is missing
- The column separation lines are shifted a bit to the left (marked in red) after the header row
Thank you for your detailed error description and the two snapshots which document the shortcomings of my solution. Unfortunately my eye sight is not the best anymore and I did not put on my glasses, so I didn't notice your documented graphics quirks. I have therefore tried a "cleaner" but much more complicated solution using a callback like tatanas had tried. Thank you also to tatanas for his example using a WindowCallback which has the drawback that it hangs when trying to drag a row into the right ListIcon with a row currently selected. My solution tries to circumvent this bug. Please give it a try!

I also eliminated a bug that sometimes caused the dragged row to not be inserted properly at the position marked by the target line!

Code: Select all

EnableExplicit

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

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

Procedure WindowCallback(WindowHandle.I, Msg.I, WParam.I, LParam.I)
  Static RowIsSelected.I

  Shared DraggingIsActive.I

  Protected *NMHdr.NMHDR

  Select Msg
    Case #WM_NOTIFY
      *NMHdr = LParam

      If *NMHdr\hwndFrom = GadgetID(1)       
        Select *NMHdr\code
          Case #LVN_ITEMCHANGING
            If DraggingIsActive And RowIsSelected = #False
              ; ----- Disable highlighting of item under cursor
              ProcedureReturn #True
            EndIf
          Case #LVN_ITEMCHANGED
            ; ----- Check whether row in target ListIcon is selected
            If GetGadgetState(1) = -1
              RowIsSelected = #False
            Else
              RowIsSelected = #True
            EndIf
        EndSelect
      EndIf
  EndSelect

  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
Procedure DragCallback(Action.I)
  Shared DraggingIsActive.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(1), Rectangle)

  If PtInRect_(Rectangle, CursorPositon\x + (CursorPositon\y) << 32)
    MapWindowPoints_(0, GadgetID(1), CursorPositon, 1)

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

    ; ----- Display insertion line
    SendMessage_(GadgetID(1), #LVM_INSERTMARKHITTEST, @CursorPositon,
      @InsertMark)

    RowCount = CountGadgetItems(1)

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

      ; ----- Increase index if cursor is in lower part of row
      Protected Calc.I = (CursorPositon\y - HeaderHeight) % RowHeight

      If (CursorPositon\y - HeaderHeight) % RowHeight > RowHeight * 0.5
        RowInsertionIndex + 1
      EndIf
    EndIf

    ProcedureReturn #True
  EndIf
EndProcedure

OpenWindow(0, 100, 100, 730, 133, "Drag row from left to right")

ListIconGadget(0, 10, 10, WindowWidth(0) / 2 - 15, 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")

ListIconGadget(1, WindowWidth(0) / 2 + 5, 10, WindowWidth(0) / 2 - 15,
  WindowHeight(0) - 20,  "Name", 100,
  #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
AddGadgetColumn(1, 1, "Address", GadgetWidth(0) - GetGadgetItemAttribute(0,
  0, #PB_ListIcon_ColumnWidth) - 4)
EnableGadgetDrop(1, #PB_Drop_Text, #PB_Drag_Copy)
SetDragCallback(@DragCallback())

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

; ----- Get height of single row
RowHeight = SendMessage_(GadgetID(1), #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
        Row = GetGadgetState(0)
      
        If Row >= 0
          DragText(GetGadgetItemText(0, Row, 0) + #LF$ +
            GetGadgetItemText(0, Row, 1), #PB_Drag_Copy)
        EndIf
      EndIf
    Case #PB_Event_GadgetDrop
      DraggingIsActive = #False
      AddGadgetItem(1, RowInsertionIndex, EventDropText())
  EndSelect
ForEver
camille
User
User
Posts: 71
Joined: Tue Nov 19, 2019 12:52 pm

Re: Visual Help for drag&drop in ListView

Post by camille »

Thanks for the new version, Shardik!

I've noticed two bugs with it, though :D

1.
Drag one row from the left to the right (it doesn't matter which one).
Drag another row from the left to the right but DON'T release the mouse button but instead continue the drag and release the mouse button on the left list view.
The result is, that the highlighting stops to work on the right list view. You can't highlight the row on the right (that we've dragged in the first step) by clicking on it.
If you do a new drag from the left to the right (this time a normal one), highlighting will continue to work on the right side...
https://imgur.com/a/99dayeP

2.
Drag two rows from the left to the right (one after another).
Select one of the two rows on the right.
Select any row on the left (so that it is highlighted).
Drag that row to the right.
The result is, that the hovering effect is back on the right list view...
https://imgur.com/a/8ZUsBIq
tatanas
Enthusiast
Enthusiast
Posts: 260
Joined: Wed Nov 06, 2019 10:28 am
Location: France

Re: Visual Help for drag&drop in ListView

Post by tatanas »

I tryed your code with one listview and it hangs as soon as I drag an item (I guess #LVN_ITEMCHANGING is causing this mess).
Windows 10 Pro x64
PureBasic 6.20 x64
User avatar
Shardik
Addict
Addict
Posts: 2058
Joined: Thu Apr 21, 2005 2:38 pm
Location: Germany

Re: Visual Help for drag&drop in ListView

Post by Shardik »

camille wrote:I've noticed two bugs with it, though :D
Thank you for your videos demonstrating the two bugs. I have fixed them. I had to define an additional DropCallback() to detect the end of a dragging operation (successful: #PB_Drag_Finish, cancelled: #PB_Drag_Leave). In that callback I also fixed a further bug: in some cases after cancelling a dragging operation the insertion marker was not removed... :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(1)       
        If *NMHdr\code = #LVN_ITEMCHANGING
          If DraggingIsActive And GetGadgetState(1) = -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(1), Rectangle)

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

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

    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(1), #LVM_INSERTMARKHITTEST, @CursorPositon,
        @InsertMark)
      ; ----- Display insertion line
      SendMessage_(GadgetID(1), #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)

  If Status = #PB_Drag_Leave Or Status = #PB_Drag_Finish
    DraggingIsActive = #False

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

  If TargetHandle = GadgetID(1)
    Result = #True
  EndIf

  ProcedureReturn Result
EndProcedure

OpenWindow(0, 100, 100, 730, 133, "Drag row from left to right")

ListIconGadget(0, 10, 10, WindowWidth(0) / 2 - 15, 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")

ListIconGadget(1, WindowWidth(0) / 2 + 5, 10, WindowWidth(0) / 2 - 15,
  WindowHeight(0) - 20,  "Name", 100,
  #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect)
AddGadgetColumn(1, 1, "Address", GadgetWidth(0) - GetGadgetItemAttribute(0,
  0, #PB_ListIcon_ColumnWidth) - 4)
EnableGadgetDrop(1, #PB_Drop_Text, #PB_Drag_Copy)
SetDragCallback(@DragCallback())
SetDropCallback(@DropCallback())

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

; ----- Get height of single row
RowHeight = SendMessage_(GadgetID(1), #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 in target ListIcon
        SetGadgetState(1, -1)
     
        If RowIndex >= 0
          DragText(GetGadgetItemText(0, RowIndex, 0) + #LF$ +
            GetGadgetItemText(0, RowIndex, 1), #PB_Drag_Copy)
        EndIf
      EndIf
    Case #PB_Event_GadgetDrop
      AddGadgetItem(1, RowInsertionIndex, EventDropText())

      ; ----- Deselect any selected entry in target ListIcon
      SetGadgetState(1, -1)
  EndSelect
ForEver
Update: I have moved

Code: Select all

      ; ----- Deselect any selected entry in target ListIcon
      SetGadgetState(0, -1)
from the DragCallback() to the main event loop to eliminate a further bug reported by camille in the posting below.
Last edited by Shardik on Wed Jan 08, 2020 10:30 pm, edited 4 times in total.
Post Reply