Listbox Drag and drop Multiple Rows

This is API 1 but that should not make a difference… I am coding in 2019R1.1 but also tried the same project in 2023R4.

While at one time I was a listbox “expert” i have not done much with them for several years now an it’s even longer since I supposed dragging multiple rows so maybe I’m not understanding the docs about this any more.

In 2019R1 when I try to do drag rows with the code below shown below, it works fine when I try to drag one row … But does nothing happens when I try to drag multiple rows (no visible drag item).

Here is the code:

Function DragRow(drag As DragItem, row As Integer) Handles DragRow as Boolean
  If Not me.Selected(row) then Return False
  Dim DeltaY as Integer = me.MouseY -(me.HeaderHeight + (row-Me.ScrollPosition)*me.RowHeight) 
  drag.Text = Me.List(row)
  Dim ub As Integer = me.ListCount - 1

  For i  as Integer = me.ListIndex To ub
    If i = Row Then Continue
    If Me.Selected(i) Then
      drag.AddItem(0, me.HeaderHeight + (i-Me.ScrollPosition)*me.RowHeight + DeltaY,  me.Width, me.RowHeight)
      drag.Text = Me.List(i) 
    End If
  Return True // allow the drag
End Function

On 2023R4 I now see drag items for multiple rows… Too many of them!!! See below:

What am I doing wrong , or is this a bug?