Drag & Drop with Line Mark without using D&D lib [Windows]

Share your advanced PureBasic knowledge/code with the community.
Post Reply
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4663
Joined: Sun Apr 12, 2009 6:27 am

Drag & Drop with Line Mark without using D&D lib [Windows]

Post by RASHAD »

Hi everybody and Happy New Year
Very flexible

Code: Select all

Global Dragf,ColorBrush,NormalBrush

Procedure WindowCallback(hwnd, msg, wParam, lParam)
  result = #PB_ProcessPureBasicEvents
  Select msg
    Case #WM_NOTIFY
      *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_NOTIFYSUBITEMDRAW
           
          Case #CDDS_ITEMPREPAINT | #CDDS_SUBITEM
            thisRow = *lvCD\nmcd\dwItemSpec
            thisCol = *lvCD\iSubItem
           
            subItemRect.RECT\left = #LVIR_LABEL
            subItemRect.RECT\top = *lvCD\iSubItem
           
            SendMessage_(GadgetID(0), #LVM_GETSUBITEMRECT, thisRow, @subItemRect)
            SetTextColor_(*lvCD\nmcd\hdc, $000000)
            If GetGadgetState(0) = thisRow
              If dragf = 1                      
                FillRect_(*lvCD\nmcd\hdc, subItemRect, ColorBrush)
              Else
                FillRect_(*lvCD\nmcd\hdc, subItemRect, NormalBrush)
                SetTextColor_(*lvCD\nmcd\hdc, $FFFFFF)
              EndIf
            EndIf
            InflateRect_(subItemRect,-2,0)                        
            Text$ = GetGadgetItemText(0,thisRow,thisCol)
            DrawText_(*lvCD\nmcd\hdc, Text$, Len(Text$), subItemRect, #DT_VCENTER | #DT_END_ELLIPSIS)
            result = #CDRF_SKIPDEFAULT
        EndSelect
      EndIf
  EndSelect
  ProcedureReturn result
EndProcedure

Procedure DragDrop(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

LoadFont(0,"Tahoma",14)
If OpenWindow(0, 0, 0, 800, 600, "Set Select Color", #PB_Window_SystemMenu|#PB_Window_ScreenCentered | #PB_Window_SizeGadget)
  SetWindowCallback(@WindowCallback())
  ListIconGadget(0, 10, 10, 780, 580, "Column 0", 200, #PB_ListIcon_FullRowSelect | #PB_ListIcon_GridLines | #PB_ListIcon_AlwaysShowSelection )
  AddGadgetColumn(0, 1, "Column 1", 200)
  AddGadgetColumn(0, 2, "Column 2", 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))
  RowHeight = SendMessage_(GadgetID(0), #LVM_GETITEMSPACING, #True, 0) >> 16
  
  CreateImage(0,RowHeight,RowHeight)
  StartDrawing(ImageOutput(0))
    Box(0,0,RowHeight,RowHeight,$FFFFFF)
    Box(0,RowHeight-3,RowHeight,3,$0000FF)   
  StopDrawing()  
  ColorBrush = CreatePatternBrush_(ImageID(0)) 
  
  CreateImage(1,RowHeight,RowHeight)
  StartDrawing(ImageOutput(1))
    Box(0,0,RowHeight,RowHeight,$FE9146)   
  StopDrawing()  
  NormalBrush = CreatePatternBrush_(ImageID(1))
  
  FreeImage(0)
  FreeImage(1)
    
Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Quit = 1
      
    Case #WM_MOUSEMOVE
      If GetAsyncKeyState_(#VK_LBUTTON) & $8000 = $8000 
        GetCursorPos_(p.POINT)
        ScreenToClient_(GadgetID(0),@p)
        Dragf = 1
        SendMessage_(GadgetID(0), #LVM_SETEXTENDEDLISTVIEWSTYLE,0,SendMessage_(GadgetID(0),#LVM_GETEXTENDEDLISTVIEWSTYLE,0,0)| #LVS_EX_TRACKSELECT)
        SendMessage_(GadgetID(0), #LVM_SETHOVERTIME, 0, 1)
        Drop = GetGadgetState(0)
        If p\y < 2*RowHeight
          SendMessage_(GadgetID(0),#WM_VSCROLL,#SB_LINEUP, 0)
        ElseIf p\y > (GadgetHeight(0)-2*RowHeight)
          SendMessage_(GadgetID(0),#WM_VSCROLL,#SB_LINEDOWN, 0)
        EndIf
      EndIf     
      
    Case #WM_LBUTTONDOWN
      Drag = GetGadgetState(0)
   
    Case #WM_LBUTTONUP
      If Dragf = 1 And Drag >= 0
        Dragf = 0
        SendMessage_(GadgetID(0), #LVM_SETEXTENDEDLISTVIEWSTYLE,0,SendMessage_(GadgetID(0),#LVM_GETEXTENDEDLISTVIEWSTYLE,0,0) &~ #LVS_EX_TRACKSELECT)
        If Drag > Drop 
          Drop + 1
        EndIf
        DragDrop(0, Drag,Drop)
      EndIf
  EndSelect
Until Quit = 1
 
EndIf
End
Edit : Bug fixed
Edit 2: Scroll Up or Down while dragging enabled
Last edited by RASHAD on Mon Jan 06, 2020 5:33 pm, edited 2 times in total.
Egypt my love
Top
camille
User
User
Posts: 66
Joined: Tue Nov 19, 2019 12:52 pm

Re: Drag & Drop with Line Mark without using D&D lib [Window

Post by camille »

Thanks RASHAD for sharing it!
Top
User avatar
Paul
PureBasic Expert
PureBasic Expert
Posts: 1252
Joined: Fri Apr 25, 2003 4:34 pm
Location: Canada
Contact:
Contact Paul

Re: Drag & Drop with Line Mark without using D&D lib [Window

Post by Paul »

I think there is a bug...
If I click the column header and drag slightly, a copy of it suddenly appears at the bottom of the list.
Image Image
Top
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4663
Joined: Sun Apr 12, 2009 6:27 am

Re: Drag & Drop with Line Mark without using D&D lib [Window

Post by RASHAD »

Happy New Year guys
@camille
I am working on it
Be tuned

@Paul
Thanks for the catch
Previous post updated
Egypt my love
Top
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4663
Joined: Sun Apr 12, 2009 6:27 am

Re: Drag & Drop with Line Mark without using D&D lib [Window

Post by RASHAD »

Previous post updated again
Egypt my love
Top
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4663
Joined: Sun Apr 12, 2009 6:27 am

Re: Drag & Drop with Line Mark without using D&D lib [Window

Post by RASHAD »

Now the best (from my view) using Shardik tech.

Code: Select all

Import "UxTheme.lib"
  SetWindowTheme(hwnd, classname.p-unicode, titlename)
EndImport

Structure LVINSERTMARK
  cbSize.I
  dwFlags.L
  iItem.I
  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
  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
    ; ----- 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

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

LoadFont(0,"Tahoma",14)
OpenWindow(0, 0, 0, 800, 600, "Drag'n drop test", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)

ListIconGadget(0, 10, 10, 780, 580, "Test", 200 , #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))

SetWindowTheme(GadgetID(0), "explorer", 0)
EnableGadgetDrop(0, #PB_Drop_Private, #PB_Drag_Move, 1)
SetDragCallback(@DragCallback())

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

Exit = #False
DragItem = -1

Repeat
Event = WaitWindowEvent()
Select Event
  Case #WM_MOUSELEAVE
    dragf = 1    
  Case #PB_Event_Gadget
   Select EventType()
    Case #PB_EventType_DragStart
      SetWindowTheme(GadgetID(0), "explorer", 0)
      DragItem = GetGadgetState(0)
      DragPrivate(1, #PB_Drag_Move) 
   EndSelect
   
  Case #PB_Event_GadgetDrop
   If EventDropPrivate() = 1
    SetWindowTheme(GadgetID(0), "LISTVIEW", 0)
    TargetItem = GetGadgetState(0)
    ListIconGadgetMove(0, DragItem, TargetItem)
    SendMessage_(GadgetID(0),#LVM_SETINSERTMARKCOLOR,0,$FFFFFF)
    SetGadgetState(0,-1)
   EndIf
  Case #PB_Event_CloseWindow
   Exit = #True
EndSelect

Until Exit
Egypt my love
Top
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5353
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Drag & Drop with Line Mark without using D&D lib [Window

Post by Kwai chang caine »

Thanks RASHAD works great here :D
I suppose your code also can works with virtual ListIcon ? if yes, very usefull for me :wink:
Thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
Top
camille
User
User
Posts: 66
Joined: Tue Nov 19, 2019 12:52 pm

Re: Drag & Drop with Line Mark without using D&D lib [Window

Post by camille »

@RASHAD

Thanks again for sharing your code!

There is still a small issue (at least here on Windows Server 2019).
The row where you're hovering over (where the drop will happen) has a light blue highlight.

I've uploaded a picture here:
https://imgur.com/a/FOVD44n

Please note: For the test I've commented out the font loading and reduced the amout of items in the list view from 1000 to 100.

Any chance that this can be resolved?
Top
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4663
Joined: Sun Apr 12, 2009 6:27 am

Re: Drag & Drop with Line Mark without using D&D lib [Window

Post by RASHAD »

Hi camille
See if the next one is close to your needs

Code: Select all


Import "UxTheme.lib"
  SetWindowTheme(hwnd, classname.p-unicode, titlename)
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
  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
    ; ----- 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

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())  ;No Focus rectangle

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)
HeaderHeight = Rectangle\bottom - Rectangle\top

; ----- Get height of single row
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
Edit : Bug fixed for PB x64
Egypt my love
Top
Post Reply

Return to “Tricks 'n' Tips”