It took many months of wasting hours, giving up, and revisiting to finally get a working solution, and the only previous VB solution was monstrously complex. I understand very few people will find this useful, but wanted to share anyway due to the lack of answers I found while trying to get it working and the simplicity over other solutions.
Background
DragDrop functionality is easy if you're using, say, VB's ListView, but what if you're using a ListView created via CreateWindowEx that has no OLEStartDrag/OLESetData with pre-provided DataObject, and want to start a drag operation that can be dragged around Windows Explorer (or any drop target accepting dropped files)? Previous solutions have used the DoDragDrop API and then had to implement their own IDataObject and IDropSource interfaces, and I had yet to see one that supported multiple paths. Turns out that unless you require other-than-default behavior, you accomplish a full drag-to-explorer operation in just a few lines of code. The SHDoDragDrop API provides both a default drag source and a default drag icon showing the number of files, just like Explorer. It also supports the action options menu if you drag with the right button. And no further action is required, the receiving program handles the operation.
The included sample project doesn't use any subclassed/CreateWindowEx ListViews, but does show how you can initiate the operation from any arbitary point in code given a list of files.
Requirements
This code does require a typelib with the IDataObject interface such as olelib (either the original or my expansion) or OLEGuids to be added as a reference. Works with XP and above.
For the purposes of the below code, we'll assume you have your own routine to enumerate the full paths of the files that are selected. This code will typically be for a Begin Drag notification, such as LVN_BEGINDRAG.
Code:
Public Sub InitDrag(sSelFullPath() As String)
Dim hr0 As Long
Dim iData As IDataObject
Dim apidl() As Long
Dim cpidl As Long
Dim rpidl As Long
Dim pidlDesk As Long
Dim lRetDD As Long
Dim i As Long
Dim AllowedEffects As DROPEFFECTS
Call SHGetSpecialFolderLocation(0, CSIDL_DESKTOP, pidlDesk) 'we support multiple paths by creating an IDataObject with the desktop as the root and then supplying fully qualified pidls rather than child pidls
'EnumSelectedFiles - Whatever routine you have to get your selected files list, a standard routine like
' Do
' i = ListView_GetNextItem(hLVS, i, LVNI_SELECTED)
' If (i <> LVI_NOITEM) Then
ReDim apidl(UBound(sSelFullPath)) 'sSelFullPath would then contain the full path to the file, C:\folder\file.ext, //Computer/folder/file.ext
For i = 0 To UBound(apidl)
apidl(i) = GetPIDLFromPathW(sSelFullPath(i)) 'support function to return fully qualified pidls for each file, see below
Next i
cpidl = UBound(apidl) + 1
Call SHCreateDataObject(pidlDesk, cpidl, VarPtr(apidl(0)), ByVal 0&, IID_IDataObject, iData) 'even though the desktop pidl is just the zero-terminator, don't confuse that with passing zero instead of this-- results in an invalid drag source that can't be dropped anywhere
If iData Is Nothing Then
Debug.Print "Failed to created IDataObject"
Exit Sub
End If
AllowedEffects = DROPEFFECT_COPY Or DROPEFFECT_MOVE Or DROPEFFECT_LINK
hr0 = SHDoDragDrop(0&, ObjPtr(iData), 0, AllowedEffects, lRetDD) 'theoretically you can supply your own IDropSource implementation, but I never got it working
Debug.Print "hr0=" & hr0 & ",lRet=" & lRetDD 'hr0 contains the HRESULT of the call, and lRetDD is the result of the operation, see the full DROPEFFECT description for all possible values
Call CoTaskMemFree(pidlDesk)
For i = 0 To UBound(apidl)
Call CoTaskMemFree(apidl(i))
Next i
Set iData = Nothing
End Sub
'If instead this is in a WndProc, you'll probably want to cancel the notification by returning 1 and exiting before a DefWndProc call.
'Supporting declares and functions:
Public Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hWndOwner As Long, ByVal nFolder As Long, pidl As Long) As Long
Public Const CSIDL_DESKTOP = &H0
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long) ' Frees memory allocated by the shell
Public Declare Function SHCreateDataObject Lib "shell32" (ByVal pidlFolder As Long, ByVal cidl As Long, ByVal apidl As Long, pdtInner As Any, riid As UUID, ppv As Any) As Long
Public Declare Function SHDoDragDrop Lib "shell32" (ByVal hWnd As Long, ByVal pdtObj As Long, ByVal pdsrc As Long, ByVal dwEffect As Long, pdwEffect As Long) As Long
Public Declare Function ILCreateFromPathW Lib "shell32" (ByVal pwszPath As Long) As Long
Public Function GetPIDLFromPathW(sPath As String) As Long
GetPIDLFromPathW = ILCreateFromPathW(StrPtr(sPath))
End Function
Public Function IID_IDataObject() As UUID
'0000010e-0000-0000-C000-000000000046
Static IID As UUID
If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H10E, CInt(&H0), CInt(&H0), &HC0, &H0, &H0, &H0, &H0, &H0, &H0, &H46)
IID_IDataObject = IID
End Function
Public Sub DEFINE_UUID(Name As UUID, l As Long, w1 As Integer, w2 As Integer, B0 As Byte, b1 As Byte, b2 As Byte, B3 As Byte, b4 As Byte, b5 As Byte, b6 As Byte, b7 As Byte)
With Name
.Data1 = l
.Data2 = w1
.Data3 = w2
.Data4(0) = B0
.Data4(1) = b1
.Data4(2) = b2
.Data4(3) = B3
.Data4(4) = b4
.Data4(5) = b5
.Data4(6) = b6
.Data4(7) = b7
End With
End SubCode:
'from http://www.mvps.org/emorcillo/en/code/vb6/listviewdragdropimage.shtml
Public Sub ListView_StartDrag( _
ByVal hWndListView As Long, _
Optional ByVal X As Long = 20, _
Optional ByVal Y As Long = 20)
Dim tPoint As POINTAPI
Dim LITEM As Long
' Get the selected item
LITEM = SendMessage(hWndListView, LVM_GETNEXTITEM, -1, ByVal LVNI_SELECTED)
' Get a ImageList with
' the drag image
m_lIL = SendMessage(hWndListView, LVM_CREATEDRAGIMAGE, LITEM, tPoint)
' Start the image dragging
ImageList_BeginDrag m_lIL, 0, X, Y
ImageList_DragEnter 0, 0, 0
' Start the timer
m_lTimer = SetTimer(0, 0, 1, AddressOf pvTimerDragMove)
End Sub
Public Sub DragComplete()
' Stop the timer
KillTimer 0, m_lTimer
' End the image dragging
ImageList_EndDrag
' Destroy the ImageList
ImageList_Destroy m_lIL
End Sub
Private Sub pvTimerDragMove( _
ByVal hWnd As Long, _
ByVal uMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long)
Dim tPoint As POINTAPI
' Get the cursor position
GetCursorPos tPoint
' Move the image to the new cursor position
ImageList_DragMove tPoint.X, tPoint.Y
End Sub