ListIconGadget() with private drag and drop

[infratec]

Hi,

since it was not easy for me to figure it out, I thought it is a good idea
to share my result:

Code: Select all

Procedure ListIconGadgetMove(GadgetNo.i, Source.i, Dest.i)
 Source$ = GetGadgetItemText(GadgetNo, Source)
 If Source < Dest
  For i = Source To Dest - 1
   Help$ = GetGadgetItemText(GadgetNo, i + 1)
   SetGadgetItemText(GadgetNo, i, Help$)
  Next i
 Else
  For i = Source To Dest + 1 Step - 1
   Help$ = GetGadgetItemText(GadgetNo, i - 1)
   SetGadgetItemText(GadgetNo, i, Help$)
  Next i
 EndIf
 SetGadgetItemText(GadgetNo, i, Source$)
EndProcedure


OpenWindow(0, 0, 0, 330, 220, "Drag'n drop test", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
 
ListIconGadget(0, 10, 10, 310, 200, "Test", 300 , #PB_ListIcon_FullRowSelect|#PB_ListIcon_HeaderDragDrop)
For i = 1 To 10
 AddGadgetItem(0, -1, "Line " + Str(i))
Next i

EnableGadgetDrop(0, #PB_Drop_Private, #PB_Drag_Move, 1)


Exit = #False
DragItem = -1

Repeat
 Event = WaitWindowEvent()

 Select Event
  Case #PB_Event_Gadget
   Select EventType()
    Case #PB_EventType_DragStart
     DragItem = GetGadgetState(0)
     DragPrivate(1, #PB_Drag_Move)
   EndSelect
  Case #PB_Event_GadgetDrop
   If EventDropPrivate() = 1
    TargetItem = GetGadgetState(0)
    ListIconGadgetMove(0, DragItem, TargetItem)
   EndIf
  Case #PB_Event_CloseWindow
   Exit = #True
 EndSelect
 
Until Exit

Maybe someone can use it.

Oh, what it does:
You can move the entries with the mouse and left mouse button pressed.

Best regards,

Bernd

[Kwai chang caine]

It can be usefull
Thanks for sharing

[+18]

thaaaaaaaaaaaaaaaaaaaaaaaaaanks
nice coded

[Demivec]

When I start dragging an item the items that are dragged don't become highlighted, which means I may be dragging the wrong one. If I adjust the column for instance or simply highlight an item then everything works as I would expect.

Nice code.

[infratec]

Hi,
an extended version was neccessary:
With the original code, only the first column was moved and not the whole row.
Now the whole row is moved. And this cross platform.

Code: Select all

Procedure ListIconGadgetColumns(GadgetNo)
 i = 0
 While GetGadgetItemAttribute(GadgetNo, 0, #PB_ListIcon_ColumnWidth, i) > 0
  i + 1
 Wend
 ProcedureReturn i
EndProcedure

Procedure ListIconGadgetMove(GadgetNo.i, Source.i, Dest.i)
;Debug "Source: " + Str(Source) + " Dest: " + Str(Dest)
 If Dest >= 0
  Columns = ListIconGadgetColumns(GadgetNo) - 1
  For j = 0 To Columns
   Source$ = GetGadgetItemText(GadgetNo, Source, j)
   If Source < Dest
    For i = Source To Dest - 1
     Help$ = GetGadgetItemText(GadgetNo, i + 1, j)
     SetGadgetItemText(GadgetNo, i, Help$, j)
    Next i
   Else
    For i = Source To Dest + 1 Step - 1
     Help$ = GetGadgetItemText(GadgetNo, i - 1, j)
     SetGadgetItemText(GadgetNo, i, Help$, j)
    Next i
   EndIf
   SetGadgetItemText(GadgetNo, i, Source$, j)
  Next j
 EndIf
EndProcedure

OpenWindow(0, 0, 0, 330, 220, "Drag'n drop test", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)

ListIconGadget(0, 10, 10, 310, 200, "Test 1", 150 , #PB_ListIcon_FullRowSelect|#PB_ListIcon_HeaderDragDrop)
AddGadgetColumn(0, 1, "Test 2", 150)
For i = 1 To 10
AddGadgetItem(0, -1, "Line " + Str(i) + " Col 1" + Chr(10) + "Line " + Str(i) + " Col 2")
Next i

EnableGadgetDrop(0, #PB_Drop_Private, #PB_Drag_Move, 1)


Exit = #False
DragItem = -1

Repeat
Event = WaitWindowEvent()

Select Event
  Case #PB_Event_Gadget
   Select EventType()
    Case #PB_EventType_DragStart
     DragItem = GetGadgetState(0)
     DragPrivate(1, #PB_Drag_Move)
   EndSelect
  Case #PB_Event_GadgetDrop
   If EventDropPrivate() = 1
    TargetItem = GetGadgetState(0)
    ListIconGadgetMove(0, DragItem, TargetItem)
   EndIf
  Case #PB_Event_CloseWindow
   Exit = #True
EndSelect

Until Exit

Enjoy it,
Bernd

[Demivec]

The second version has some serious delay problems...

[infratec]

Hm,

here on my XP it works without any problems.
What's your OS?

[Demivec]

XP Sp3 32-bit

[infratec]

That's very strange, since I use exactly the same version.
For sure, the second version is slower how more columns are available.

Hm, can you check if it is the ListIconGadgetColumns() procedure?

Simply replace

Code: Select all

For j = 0 To ListIconGadgetColumns(GadgetNo) - 1

wtith

Code: Select all

For j = 0 To 1

Bernd

[Demivec]

It is the ListIconGadgetColumns() procedure.

In the procedure it counts up to infinity and never returns.

I think you would have to keep track of the number of columns manually. They are only distinguished by the number of Chr(10) values + 1 in any given line.

[infratec]

Hi,

I had a small 'bug':
ListIconGadgetColumns() was called in each for loop.
Now I changed the code above, so that a variable is set only once.

In 'coding questions' Shardik pointed me to an entry in the german forum.
They did it already like I do now. But the result is crazy:
It appears that the return value of the GetGadgetItemAttribute(GadgetNo, 0, #PB_ListIcon_ColumnWidth, i)
is not reliable.

I checked it here and I got always 150, as it should be.
Maybe the return value for a not existing column is not clear defined.
Maybe on some PCs it is 0 on others -1.
I changed now also the while statement.

Please check it again.

Bernd

[Demivec]

In 'coding questions' Shardik pointed me to an entry in the german forum.
They did it already like I do now. But the result is crazy:
It appears that the return value of the GetGadgetItemAttribute(GadgetNo, 0, #PB_ListIcon_ColumnWidth, i)
is not reliable.

I checked it here and I got always 150, as it should be.
Maybe the return value for a not existing column is not clear defined.
Maybe on some PCs it is 0 on others -1.

It still suffers from the same problem. The value I debugged for the non-existant colums was 1309644. So there are at least three values {0,-1,1309644} and I suspect many more.

I think the sure solution is to keep track of it manually somehow (i.e. if a column is added then add one to the gadget's column count).

[Marco2007]

If you drag a line after the last line -> the columntext will be moved. On purpose?

BTW: Why don`t you just use AddGadgetItem(#Gadget, Position, Text$)?

[infratec]

Hi Marco2007,

I don't use AddGadgetItem(), because in my original thought I only want to move
something and not to add something.
But I'll check your hint.

The bug with changing the column titles when you go below the last entry
is now fixed in the code.

Bernd

[infratec]

Hi Demivec,

than the function GetGadgetItemAttribute(GadgetNo, 0, #PB_ListIcon_ColumnWidth, i)
is buggy.

The problem is, that on my PC the bug is not available.

So I can tell Fred nothing about it.

Bernd