PureBasic Forums - English

Posted: **Tue Jan 07, 2020 12:20 pm**

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

Posted: **Tue Jan 07, 2020 12:27 pm**

@tatanas

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

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

Posted: **Tue Jan 07, 2020 4:32 pm**

It's weird, I don't have the problem.
What's your config ?

Posted: **Tue Jan 07, 2020 4:49 pm**

Windows Server 2019 10.0.17763.107

PB v5.71 LTS x64

Posted: **Tue Jan 07, 2020 6:09 pm**

I have the same problem as Camille.
PureBasic 5.71 x64

see signature below

Posted: **Tue Jan 07, 2020 9:55 pm**

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

Posted: **Tue Jan 07, 2020 11:23 pm**

Thanks for the new version, Shardik!

I've noticed two bugs with it, though

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

Posted: **Wed Jan 08, 2020 9:05 am**

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).

Posted: **Wed Jan 08, 2020 1:50 pm**

camille wrote:I've noticed two bugs with it, though

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...

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.

Posted: **Wed Jan 08, 2020 3:16 pm**

Thank you Shardik!

The new version shows (after a quick test) one bug:
Step 1
Drag the Harry Rannit entry to the right
Drag the Ginger Brokeit entry to the right (below the Harry Rannit entry)

Step 2
Select the Harry Rannit entry on the right
Select the Harry Rannit entry on the left and try to drag it again to the right

Step 3
If this last drag has worked, do it again:
Select the topmost Harry Rannit on the right
Select Harry Rannit on the left
Drag it again

This procedure leads to a "Not Responding" app and the last drag doesn't show the insert line any more but just the usual + mouse cursor.

Sometimes it already fails on the second step, sometimes on the third. I've tried it about 15 times and I've never seen it surviving step 3.

As usual, recorded uploaded at:
https://imgur.com/a/TZUVcGz

Apart from that it looks very good!

If I could express another wish, it's the same as tatanas one: It would be superb if the whole thing could work just within a single list view (drag and drop inside the same list view) as well

Posted: **Wed Jan 08, 2020 4:41 pm**

camille, again thank you for your new bug report and your detailed description and video. I had also experienced that bug but always had difficulties to reproduce it.

For eliminating that bug please comment out

Code: Select all

    SetGadgetState(1, -1)

in procedure DragCallback() and copy/paste this line into the main event loop behind this line

Code: Select all

      If EventGadget() = 0 And EventType() = #PB_EventType_DragStart

Now every drag start of a row in the left ListIcon will immediately clear a highlighted line in the right ListIcon. Before this change a highlighted row in the right ListIcon was cleared upon entering of the drag cursor.

Of course I would change my last example if you confirm that the bug fix works / is acceptable and you won't find new or further bugs.

camille wrote:If I could express another wish, it's the same as tatanas one: It would be superb if the whole thing could work just within a single list view (drag and drop inside the same list view) as well

If you don't mind I would take care for the single ListIcon view after you don't find bugs anymore in the current two ListIcon view...

Posted: **Wed Jan 08, 2020 5:17 pm**

Great work, Shardik!

Your suggestion works absolutely fine and I'm not aware of any new / still existing bugs at the moment.
At least I can't provoke any

The current solution may need more code than all the other ones that are currently published but it has no visual glitches at all. That's worth every line of code^^

It works compiled as 32 and as 64 bit as well.

If you don't mind I would take care for the single ListIcon view after you don't find bugs anymore in the current two ListIcon view...

Posted: **Wed Jan 08, 2020 8:44 pm**

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...

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.

Posted: **Wed Jan 08, 2020 9:00 pm**

Buuuuugs! You want one? You get one!

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!

Posted: **Thu Jan 09, 2020 10:10 am**

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...

PureBasic Forums - English

Visual Help for drag&drop in ListView

Re: Visual Help for drag&drop in ListView

Re: Visual Help for drag&drop in ListView

Re: Visual Help for drag&drop in ListView

Re: Visual Help for drag&drop in ListView

Re: Visual Help for drag&drop in ListView

Re: Visual Help for drag&drop in ListView

Re: Visual Help for drag&drop in ListView

Re: Visual Help for drag&drop in ListView

Re: Visual Help for drag&drop in ListView

Re: Visual Help for drag&drop in ListView

Re: Visual Help for drag&drop in ListView

Re: Visual Help for drag&drop in ListView

Re: Visual Help for drag&drop in ListView

Re: Visual Help for drag&drop in ListView

Re: Visual Help for drag&drop in ListView