[VB6] API File Drag from multiple paths w/o native OLE or dragsource, SHDoDragDrop

[fafalone]

I've done a little work on drag images... here's how to use IDragSourceHelper (included in the 2015/6/11 oleexp) to create a custom drag image with a 32x32 file icon. Although this makes the description text disappear... on XP you're out of luck, but Vista+ lets us switch to IDragSourceHelper2 where you have the option to make it appear (i've been trying to customize that text via DropDescription as an hGloblal add without much luck).

With your already fully initialized IDataObject (just before SHDoDragDrop),

            Dim idsh As IDragSourceHelper2
            Set idsh = New DragDropHelper

            If idsh Is Nothing Then
                Debug.Print "Failed to create idropsourcehelper"
                Exit Function
            End If
            
            Dim sdi As SHDRAGIMAGE
            Call CreateDragImageForIDSH(sSelFullPath(0), sdi) 'note: change to your own file path source
            If sdi.hbmpDragImage = 0 Then
                Debug.Print "Failed to create drag image"
                Exit Function
            End If
            idsh.SetFlags DSH_ALLOWDROPDESCRIPTIONTEXT 'will not be there if not set like this
            idsh.InitializeFromBitmap sdi, iData
            Call DeleteObject(sdi.hbmpDragImage)

And this example create drag image gets the icon... you can draw whatever you want here.. but from here on out I think it's manual drawing, I've been over tons of examples and none of them show how to create explorer's drag image
(original credit to Raymond Chen's Dragging A Shell Object post on Old New Thing, all I did was translate to VB)

Public Function CreateDragImageForIDSH(pszPath As String, psdi As SHDRAGIMAGE) As Long
Dim sfi As SHFILEINFO
Dim himl As Long

himl = SHGetFileInfoW(StrPtr(pszPath), 0, VarPtr(sfi), Len(sfi), SHGFI_SYSICONINDEX)
  If himl Then 'if (himl) {
    Dim cx As Long, cy As Long 'int cx, cy;
    Call ImageList_GetIconSize(himl, cx, cy) 'ImageList_GetIconSize(himl, &cx, &cy);
    psdi.sizeDragImage.cx = cx
    psdi.sizeDragImage.cy = cy
    psdi.ptOffset.X = cx
    psdi.ptOffset.Y = cy
    psdi.crColorKey = CLR_NONE
    Dim hDC As Long
    hDC = CreateCompatibleDC(0&)
    If hDC Then 'if (hdc) {
        psdi.hbmpDragImage = CreateBitmap(cx, cy, 1, 32, ByVal 0&) 'psdi->hbmpDragImage = CreateBitmap(cx, cy, 1, 32, NULL);
        If psdi.hbmpDragImage Then 'if (psdi->hbmpDragImage) {
            Dim hbmPrev As Long
            'hbmPrev = SelectBitmap(hdc, psdi.hbmpDragImage)
            hbmPrev = SelectObject(hDC, psdi.hbmpDragImage)
            Call ImageList_Draw(himl, sfi.iIcon, hDC, 0, 0, ILD_NORMAL)
            'SelectBitmap(hdc, hbmPrev);
            Call SelectObject(hDC, hbmPrev)
        End If
      
      Call DeleteDC(hDC)
    End If
End If
CreateDragImageForIDSH = psdi.hbmpDragImage
End Function

and finally some support (SHDRAGIMAGE is also in new typelib)

Public Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Public Declare Function ImageList_GetIconSize Lib "comctl32.dll" (ByVal himl As Long, lpcx As Long, lpcy As Long) As Boolean
Public Declare Function ImageList_Draw Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal hdcDst As Long, ByVal X As Long, ByVal Y As Long, ByVal fStyle As IL_DrawStyle) As Boolean
Private Const CLR_NONE = &HFFFFFFFF
Public Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Public Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Public Declare Function SHGetFileInfoW Lib "shell32" (ByVal pszPath As Long, ByVal dwFileAttributes As Long, ByVal psfi As Long, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
Public Type SHFILEINFO   ' shfi
  hIcon As Long
  iIcon As Long
  dwAttributes As Long
  szDisplayName As String * MAX_PATH
  szTypeName As String * 80
End Type
Public Const SHGFI_SYSICONINDEX = &H4000 

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 Sub
Public Function IID_IDragSourceHelper() As UUID
'{de5bf786-477a-11d2-839d-00c04fd918d0}
Static iid As UUID
 If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &HDE5BF786, CInt(&H477A), CInt(&H11D2), &H83, &H9D, &H0, &HC0, &H4F, &HD9, &H18, &HD0)
  IID_IDragSourceHelper = iid
  
End Function

Public Function IID_IDragSourceHelper2() As UUID
'{83E07D0D-0C5F-4163-BF1A-60B274051E40}"
Static iid As UUID
 If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &H83E07D0D, CInt(&HC5F), CInt(&H4163), &HBF, &H1A, &H60, &HB2, &H74, &H5, &H1E, &H40)
  IID_IDragSourceHelper2 = iid
  
End Function