[RESOLVED] Design Feedback for DragDrop Listbox Items and OleDrag Drop Between Listboxes

[vb6forever]

I've done an independent workup for:
1) dragging listbox items in the same listbox
2) dragging listbox items between listboxes

I now need to combine the two.

With List1.OLEDrag in List1.MouseDown it always takes precedent so I need something else to differentiate between the two actions.

I could use the left or right mouse button, or
Use the keyboard for dragging up and down in the list and the left mouse for OLE, or
A key and left mouse button.

Don't know if there is a suggested default for this, but thought I'd ask for feedback on suggested best practice if anyone has run into this situation.

[SamOscarBrown]

An easy way (but maybe not so user-friendly is to do an If statement ---- If Shift = 2 then ...... (2-ctrl key).

IOW, to drag to the second box, Hold the Crtl key down...

But to REALLY understand your set up, how about posting your code?

[vb6forever]

SamOscarBrown:
Thanks for responding.
Re code: Not applicable as no problem with code itself.
Just curious if there is some User standard for doing these type of actions.
Based on your post, your belief that holding the Ctrl Key down while dragging (I assume your refer to OLE drag part here) is "standard" ?

[SamOscarBrown]

No....not my intention. Misread your post...thought you were looking for AN option. Mea Culpa.

[vb6forever]

SamOscarBrown:
Went with your suggestion to use Ctrl to Drag between.

Thanks

[wqweto]

Usually dragging operation is initiated when the end-user presses left mouse button within the control (or control item) and then moves the cursor without releasing the mouse button outside a threshold zone.

The size of the threshold rectangle is configurable with Windows system settings and can be retrieved using GetSystemMetrics API function.

Take a look at SM_CXDRAG/SM_CYDRAG description at the MSDN page for more info.

I guess Ctrl+Drag is expected to allow for some jitter from elder end-users as well i.e. not begin dragging operation until mouse is dragged outside threshold rectangle.

cheers,
</wqw>

[vb6forever]

wqweto:
Thanks for responding.
I initially had designed to test for nonclient area (listbox) but wasn't happy with results. Thanks for pointing out SM_CXDRAG/SM_CYDRAG. Taking into account the mouse rectangle might improve things.

[Krool]

Usually dragging operation is initiated when the end-user presses left mouse button within the control (or control item) and then moves the cursor without releasing the mouse button outside a threshold zone.

The size of the threshold rectangle is configurable with Windows system settings and can be retrieved using GetSystemMetrics API function.

Take a look at SM_CXDRAG/SM_CYDRAG description at the MSDN page for more info.

I guess Ctrl+Drag is expected to allow for some jitter from elder end-users as well i.e. not begin dragging operation until mouse is dragged outside threshold rectangle.

cheers,
</wqw>

That's where the DragDetect API helps.

[wqweto]

There is no working sample code on DragDetect API function in these forums, the API declare in VB6 API Viewer is wrong and on top of that the DragDetect usage (parameters) is not straight-forward (e.g. the point it accepts has to be in screen coordinates).

Here is a working sample of DragDetect delayed OLEDrag that works for items inside a ListBox and between two ListBoxes, just place List1 and List2 on an empty Form1 and paste this code:

Option Explicit

'=========================================================================
' API
'=========================================================================

Private Declare Function DragDetect Lib "user32" (ByVal hWnd As Long, ByVal lX As Long, ByVal lY As Long) As Long
Private Declare Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (ByVal lpString As String) As Integer
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function LBItemFromPt Lib "comctl32" (ByVal hWnd As Long, ByVal lX As Long, ByVal lY As Long, ByVal bAutoScroll As Long) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long

Private Type POINTAPI
    X               As Long
    Y               As Long
End Type

Private Type RECT
    Left            As Long
    Top             As Long
    Right           As Long
    Bottom          As Long
End Type

'=========================================================================
' Constants and member variables
'=========================================================================

Private m_hDragFormat       As Long
Private m_cDragged          As Collection

Private Sub Form_Load()
    Dim lIdx            As Long
    Dim vElem           As Variant
    
    For lIdx = 1 To 10
        For Each vElem In Split("Test|Proba|3-rd Item|Here we go again", "|")
            List1.AddItem vElem
        Next
    Next
    List1.OLEDropMode = vbOLEDropManual
    For Each vElem In Split("DragDetect|Lib|user32|ByVal hWnd|As Long|ByVal pt|As POINTAPI|As Long", "|")
        List2.AddItem vElem
    Next
    List2.OLEDropMode = vbOLEDropManual
    m_hDragFormat = RegisterClipboardFormat("My Internal Dragging Format")
End Sub

'=========================================================================
' List extension routines
'=========================================================================

Private Function pvListHitTest(oList As ListBox, X As Single, Y As Single, ByVal bAutoScroll As Boolean, Result As Long) As Boolean
    Const LB_GETITEMRECT As Long = &H198
    Dim uPoint          As POINTAPI
    Dim uRect           As RECT
    
    On Error GoTo EH
    uPoint.X = ScaleX(X, vbTwips, vbPixels)
    uPoint.Y = ScaleY(Y, vbTwips, vbPixels)
    Call ClientToScreen(oList.hWnd, uPoint)
    Result = LBItemFromPt(oList.hWnd, uPoint.X, uPoint.Y, -bAutoScroll)
    If Result >= 0 Then
        pvListHitTest = True '--- list item
    Else
        Call SendMessage(oList.hWnd, LB_GETITEMRECT, 0, uRect)
        uPoint.X = ScaleX(X, vbTwips, vbPixels)
        uPoint.Y = ScaleY(Y, vbTwips, vbPixels) + (uRect.Bottom - uRect.Top)
        Call GetClientRect(oList.hWnd, uRect)
        If uPoint.X >= uRect.Left And uPoint.X < uRect.Right And uPoint.Y >= uRect.Top And uPoint.Y < uRect.Bottom Then
            pvListHitTest = True '--- background
        End If
    End If
    Exit Function
EH:
    Debug.Print Err.Description & " [pvListHitTest]", Timer
End Function

Private Function pvListMouseDown(oList As ListBox, Button As Integer, X As Single, Y As Single) As Boolean
    Dim uPoint          As POINTAPI
    
    On Error GoTo EH
    If Button = vbLeftButton Then
        uPoint.X = ScaleX(X, vbTwips, vbPixels)
        uPoint.Y = ScaleY(Y, vbTwips, vbPixels)
        Call ClientToScreen(oList.hWnd, uPoint)
        If DragDetect(oList.hWnd, uPoint.X, uPoint.Y) <> 0 Then
            If oList.SelCount > 0 Then
                oList.OLEDrag
                '--- drag started
                pvListMouseDown = True
            End If
        End If
    End If
    Exit Function
EH:
    Debug.Print Err.Description & " [pvListMouseDown]", Timer
End Function

Private Sub pvListOLEStartDrag(oList As ListBox, Data As DataObject, AllowedEffects As Long)
    Dim baEmpty()       As Byte
    Dim lIdx            As Long
    
    On Error GoTo EH
    Set m_cDragged = New Collection
    For lIdx = oList.ListCount - 1 To 0 Step -1
        If oList.Selected(lIdx) Then
            m_cDragged.Add Array(oList, lIdx, oList.List(lIdx))
        End If
    Next
    If m_cDragged.Count > 0 Then
        Data.SetData baEmpty, m_hDragFormat
        AllowedEffects = vbDropEffectMove
    Else
        Set m_cDragged = Nothing
    End If
    Exit Sub
EH:
    Debug.Print Err.Description & " [pvListOLEStartDrag]", Timer
End Sub

Private Sub pvListOLEDragOver(oList As ListBox, Effect As Long, X As Single, Y As Single, State As Integer)
    Dim lListIdx        As Long
    
    On Error GoTo EH
    If m_cDragged Is Nothing Or State <> vbOver Then
        Effect = vbDropEffectNone
        Exit Sub
    End If
    If pvListHitTest(oList, X, Y, True, lListIdx) Then
        oList.ListIndex = lListIdx
    End If
    Effect = vbDropEffectMove
    Exit Sub
EH:
    Debug.Print Err.Description & " [pvListOLEDragOver]", Timer
End Sub

Private Sub pvListOLEDragDrop(oList As ListBox, Effect As Long)
    Dim lListIdx        As Long
    Dim vElem           As Variant
    Dim oSrc            As ListBox
    
    On Error GoTo EH
    If m_cDragged Is Nothing Then
        Effect = vbDropEffectNone
        Exit Sub
    End If
    lListIdx = IIf(oList.ListIndex >= 0, oList.ListIndex, oList.ListCount)
    For Each vElem In m_cDragged
        Set oSrc = vElem(0)
        oSrc.RemoveItem vElem(1)
        oList.AddItem vElem(2), lListIdx
        oList.ListIndex = lListIdx
    Next
    Set m_cDragged = Nothing
    Exit Sub
EH:
    Debug.Print Err.Description & " [pvListOLEDragDrop]", Timer
End Sub

'=========================================================================
' Control events
'=========================================================================

Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    pvListMouseDown List1, Button, X, Y
End Sub

Private Sub List1_OLEStartDrag(Data As DataObject, AllowedEffects As Long)
    pvListOLEStartDrag List1, Data, AllowedEffects
End Sub

Private Sub List1_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
    pvListOLEDragOver List1, Effect, X, Y, State
End Sub

Private Sub List1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    pvListOLEDragDrop List1, Effect
End Sub

Private Sub List2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    pvListMouseDown List2, Button, X, Y
End Sub

Private Sub List2_OLEStartDrag(Data As DataObject, AllowedEffects As Long)
    pvListOLEStartDrag List2, Data, AllowedEffects
End Sub

Private Sub List2_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
    pvListOLEDragOver List2, Effect, X, Y, State
End Sub

Private Sub List2_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    pvListOLEDragDrop List2, Effect
End Sub

This can be extended to support multi-items dragging (just add more entries in m_cDragged collection) and to transport ItemData too which are currently not implemented.

cheers,
</wqw>

[vb6forever]

Krool, wqweto: Thanks for responding.

Re: DragDetect API
Wasn't aware it existed.

wqweto:
Thanks a bunch for posting the code and your efforts on my behalf.
I and I'm sure the forum will appreciated the example.

[Krool]

To note is that the VBCCR ListBoxW has an handy "InsertMark". (Display before or after, use .HitTestInsertMark)
In the ComCtlsDemo you can reorder items on the ListBoxW. It can be also used to drag and insert from one list to another.

[wqweto]

To note is that the VBCCR ListBoxW has an handy "InsertMark". (Display before or after, use .HitTestInsertMark)
In the ComCtlsDemo you can reorder items on the ListBoxW. It can be also used to drag and insert from one list to another.

I just peeked at ListBoxW.ctl and found another interesting/obscure API function -- LBItemFromPt which is available since XP from comctl32.dll

Partuclarly its final bAutoScroll parameter will come handy when performing dragging into position that is outside the client area so it needs for the ListBox to scroll up or down.

Edit: Updated the sample code above to use LBItemFromPt for scrolling and to allow drag&drop of multiple selected items.

cheers,
</wqw>

[Krool]

I just peeked at ListBoxW.ctl and found another interesting/obscure API function -- LBItemFromPt which is available since XP from comctl32.dll

Partuclarly its final bAutoScroll parameter will come handy when performing dragging into position that is outside the client area so it needs for the ListBox to scroll up or down.

Edit: Updated the sample code above to use LBItemFromPt for scrolling and to allow drag&drop of multiple selected items.

cheers,
</wqw>

It's also a 32 bit item index and not 16 bit.

[vb6forever]

wqweto:
Do you want to stick your code in the code bank?
I would do it for you but your deserve the credit.

[wqweto]

There is no point reposting in CodeBank (besides bragging rights) because google searches find relevant topics by API declare or just keywords whichever subforum it's located in.

Doubt anyone is using vBulletin's inadequate built-in search to limit results by subforum.

cheers,
</wqw>