Code: Select all
Import "UxTheme.lib"
SetWindowTheme(hwnd, classname.p-unicode, titlename)
EndImport
Structure LVINSERTMARK
cbSize.l
dwFlags.l
iItem.l
dwReserved.l
EndStructure
Procedure DragCallback(Action)
Shared HeaderHeight
Shared RowHeight
Shared RowInsertionIndex
Protected CursorPositon.POINT
Protected InsertMark.LVINSERTMARK
Protected Rectangle.RECT
SendMessage_(GadgetID(0),#LVM_SETINSERTMARKCOLOR,0,$0000FF)
InsertMark\cbSize = SizeOf(LVINSERTMARK)
GetCursorPos_(CursorPositon)
GetWindowRect_(GadgetID(0), Rectangle)
If PtInRect_(Rectangle, CursorPositon \ x + (CursorPositon \ y) << 32)
MapWindowPoints_(0, GadgetID(0), CursorPositon, 1)
If CursorPositon\y < 2*RowHeight
SendMessage_(GadgetID(0),#WM_VSCROLL,#SB_LINEUP, 0)
ElseIf CursorPositon\y > (GadgetHeight(0)-2*RowHeight)
SendMessage_(GadgetID(0),#WM_VSCROLL,#SB_LINEDOWN, 0)
EndIf
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
Procedure ListIconGadgetMove(Gad, iFrom, iTo)
For i = 0 To CountGadgetItems(0)-1
Text$ = Text$ + GetGadgetItemText(Gad, iFrom,i)+Chr(10)
Next
RemoveGadgetItem(Gad,iFrom)
AddGadgetItem(Gad,iTo,Text$)
EndProcedure
Procedure winCB(hWnd, uMsg, wParam, lParam)
result = #PB_ProcessPureBasicEvents
Select uMsg
Case #WM_NOTIFY
*nmhdr.NMHDR = lParam
*lvCD.NMLVCUSTOMDRAW = lParam
If *lvCD\nmcd\hdr\hwndFrom=GadgetID(0) And *lvCD\nmcd\hdr\code = #NM_CUSTOMDRAW
Select *lvCD\nmcd\dwDrawStage
Case #CDDS_PREPAINT
result = #CDRF_NOTIFYITEMDRAW
Case #CDDS_ITEMPREPAINT
result = #CDRF_DODEFAULT | #CDRF_NOTIFYPOSTPAINT
Case #CDDS_ITEMPOSTPAINT
item = *lvCD\nmcd\dwItemSpec
If *lvCD\nmcd\uItemState & #CDIS_FOCUS
iconRect.RECT\left = #LVIR_ICON
SendMessage_(GadgetID(0), #LVM_GETITEMRECT, item, @iconRect)
itemRect.RECT\left = #LVIR_BOUNDS
SendMessage_(GadgetID(0), #LVM_GETITEMRECT, item, @itemRect)
itemRect\left + iconRect\left
DrawFocusRect_(*lvCD\nmcd\hdc, itemRect)
EndIf
result = #CDRF_DODEFAULT
EndSelect
EndIf
EndSelect
ProcedureReturn result
EndProcedure
LoadFont(0,"Tahoma",14)
OpenWindow(0, 0, 0, 800, 600, "Drag'n drop test", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered | #PB_Window_SizeGadget)
SetWindowCallback(@winCB())
ListIconGadget(0, 10, 10, 780, 580, "Test", 200 , #PB_ListIcon_GridLines | #PB_ListIcon_FullRowSelect|#PB_ListIcon_HeaderDragDrop)
AddGadgetColumn(0, 1, "Address", 200)
AddGadgetColumn(0, 2, "Address", 200)
For a=0 To 1000
addtext$ = "Column 0 item # " + Str(a) + Chr(10) + "Column 1 item # " + Str(a) + Chr(10) + "Column 2 item # " + Str(a)
AddGadgetItem(0,-1, addtext$)
Next
SetGadgetFont(0,FontID(0))
EnableGadgetDrop(0, #PB_Drop_Private, #PB_Drag_Move, 1)
SetDragCallback(@DragCallback())
GetClientRect_(SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0), @Rectangle.RECT)
HeaderHeight = Rectangle\bottom - Rectangle\top
RowHeight = SendMessage_(GadgetID(0), #LVM_GETITEMSPACING, #True, 0) >> 16
DragItem = -1
Repeat
Select WaitWindowEvent()
Case #WM_MOUSELEAVE
dragf = 1
Case #PB_Event_SizeWindow
ResizeGadget(0,#PB_Ignore,#PB_Ignore,WindowWidth(0)-20,WindowHeight(0)-20)
Case #PB_Event_Gadget
Select EventGadget()
Case 0
Select EventType()
Case #PB_EventType_DragStart
ShowScrollBar_(GadgetID(0),#SB_BOTH ,0)
SetWindowTheme(GadgetID(0), "" , "STATUS")
DragItem = GetGadgetState(0)
DragPrivate(1, #PB_Drag_Move)
EndSelect
EndSelect
Case #PB_Event_GadgetDrop
If EventDropPrivate() = 1
ShowScrollBar_(GadgetID(0),#SB_BOTH ,1)
SetWindowTheme(GadgetID(0), "Listview" , 0)
TargetItem = GetGadgetState(0)
If DragItem >= 0
ListIconGadgetMove(0, DragItem, TargetItem)
EndIf
SendMessage_(GadgetID(0),#LVM_SETINSERTMARKCOLOR,0, $FFFFFF)
SetGadgetState(0,TargetItem)
EndIf
Case #PB_Event_CloseWindow
Quit = 1
EndSelect
Until Quit = 1
Principle: At the start of the 'drag', create a list with the elements selected by the user. At the arrival of the 'drop' add the elements one by one.
)