[VB6] Register any control as a drop target that shows the Explorer drag image

[jpfa]

Now I want to register controls as ole drag sources (supporting unicode, long file names, and displaying explorer-like drag image) (sort of the inverse operation of registering as drop target).

I believe I saw code for doing this maybe a year ago but now I can't find it. Can anyone help? Thanks!

[fafalone]

You'd want to use SHDoDragDrop.

Say you have a String array of full paths to the files you want, sSelectedFiles() ,

                       Dim iData As IDataObject
                       Dim apidl() As LongPtr
                       Dim cpidl As Long
                       Dim lRetDD As Long
                       
                       Dim AllowedEffects As DROPEFFECTS

                       ReDim apidl(UBound(sSelectedFiles)) '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) = ILCreateFromPathW(StrPtr(sSelectedFiles(i))) 'support function to return fully qualified pidls for each file, see below
                       Next i
                       cpidl = UBound(apidl) + 1
                       Dim psia As IShellItemArray
                       SHCreateShellItemArrayFromIDLists cpidl, VarPtr(apidl(0)), psia
                       If (psia Is Nothing) Then
                           Debug.Print "tvdrag->no psia"
                           Exit Function
                       End If
                       Debug.Print "Drag->Set psia"
                       psia.BindToHandler 0&, BHID_DataObject, IID_IDataObject, iData
            
                       AllowedEffects = DROPEFFECT_COPY Or DROPEFFECT_MOVE Or DROPEFFECT_LINK
                       Dim lBtnPD As Long
                       If (GetKeyState(VK_MBUTTON) And &H80) = &H80 Then
                         lBtnPD = VK_MBUTTON
                       End If
                       If (GetKeyState(VK_LBUTTON) And &H80) = &H80 Then
                         lBtnPD = VK_LBUTTON
                       End If
                       If (GetKeyState(VK_RBUTTON) And &H80) = &H80 Then
                         lBtnPD = VK_RBUTTON
                       End If
                       If (GetKeyState(VK_CONTROL) And &H80) = &H80 Then
                        lBtnPD = lBtnPD Or VK_CONTROL
                       End If
                       If (GetKeyState(VK_SHIFT) And &H80) = &H80 Then
                        lBtnPD = lBtnPD Or VK_SHIFT
                       End If
                       If (GetKeyState(VK_MENU) And &H80) = &H80 Then
                        lBtnPD = lBtnPD Or VK_MENU
                       End If
                       Dim hr0 As Long: 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
                       For i = 0 To UBound(apidl)
                           Call CoTaskMemFree(apidl(i))
                       Next i
                       Set iData = Nothing

I think everything there is in oleexp already, if not let me know if you get stuck on any APIs.

Unicode and automatic images like Explorer definitely, but I don't think this supports long paths though; the shell in general doesn't for a lot of stuff still. Maybe you could do it with a much more elaborate method *if* the interfaces support it, which I'd have to check but I'm not confident at all in it being a yes.

[jpfa]

Thanks, fafalone!

All my projects still use oleexp501.tlb. Must I update to v6.6 to get this working? Because I got a couple of type mismatchs on SHDoDragDrop.

I see it defined as

Function SHDoDragDrop(hwnd As Long, pdtobj As IDataObject, pdsrc As IDropSource, dwEffect As DROPEFFECTS, pdwEffect As DROPEFFECTS) As Long

The 2nd argument was easily fixed by using iData instead of ObjPtr(iData) there, but the 3rd argument expects a IDataObject and 0& doesn't seem to be automatically casted to that.

Furthermore, I expect 0& won't work on Windows XP. No problem, I can live with this for now.

Should I override oleexp's definition with a custom "Private Declare SHDoDragDrop..." or is there a better workaround to this?

So, the project isn't compiling so far. There may be other issues but I didn't want to go ahead making more modifications without first consulting you.

Thanks!

[fafalone]

You can use Nothing in place of 0... the code is just copied and slightly modified from ucShellBrowse, but I forgot I did a demo project of just this, which might be easier to follow: http://www.vbforums.com/showthread.p...e-SHDoDragDrop

[jpfa]

Passing Nothing instead of 0& did the trick. Thanks!
This is working now as expected on W10. It doesn't work on XP (shell api is lacking some functions).

I didn't yet try passing long filenames.

I have one cosmetic issue. Some of the controls I set as drag source aren't also drop targets. I use their mouse down event to start the drag. Then when I left click just to select items the drop forbidden cursor is shown until mouse up. This is the expected behavior, but a bit counterintuitive. I wonder if there's a more elegant way to handle this.

Your demo project seems to have interesting info. I'll study it in a while.

Update:
Your demo project has the code I needed to make this work on XP. As expected there's no drag image because I didn't implement a custom image. (The image is a good clue that you're actually dragging the items you meant to but I'll leave it out for now on XP).
To make the code work on XP and on W10 without modification I used late binding for SHCreateShellItemArrayFromIDLists. Early binding won't compile on XP because the entry point for the function can't be found. Using late binding I get a trapable error which I use to branch the execution to the old api.