PureBasic Forums - English

Posted: **Mon Jan 06, 2020 10:35 am**

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

Posted: **Mon Jan 06, 2020 11:35 am**

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

Posted: **Mon Jan 06, 2020 11:56 am**

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

Posted: **Mon Jan 06, 2020 1:00 pm**

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.

Posted: **Tue Jan 07, 2020 10:44 am**

@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

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

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