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

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!

You'd want to use SHDoDragDrop.

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

Code:

---

                      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.

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

Code:

---

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!

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

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.

I really like this project of yours. Is it possible to do without libraries in order to do something?

Perhaps you know how to arouse interface IDropTargetHelper? I would like to have a code without library dependencies.

Today I wanted to share the code, but copying a library that takes up as much as 1.5 MB of space is a big problem, especially if you want to share it on this forum (vbforums) where every byte counts...

It's easy to make code that can be easily copied and installed simply through Ctrl+C and Ctrl+V without any external dependencies. Can I count on this?

You shouldn't include the file in every project or code snippet. It's a shared reference and installing multiple copies winds up with all projects using whichever copy was used first. A lot of people use oleexp; it's not some rare file only applicable to a single code snippet or project. You should just post the code with a "Requires oleexp.tlb for the IDE" note. At some point you need to expect people to have, or take 30 seconds to obtain, a handful of common 3rd party tools if you want to share simple, easy to understand, flexible code like my post, instead of copying around 100x larger impenetrable, hard to extend messes of DispCallFunc and virtual objects full of pointer voodoo only 1% of users can understand.

If that's really what you want to do that's your prerogative but I'm not taking 3-4 hours to do it for you unless you want to discuss hiring me to do it as a paid contractual project. I already spent hundreds of hours making oleexp so people could do these things in minutes instead of hours or days with a handful of lines instead of hundreds.

Now if you want to use twinBASIC, you can do it without a typelib without DispCallFunc because tB lets you define interfaces and coclasses in the project using BASIC-style syntax. In fact there's a link to that in the first post. It was one of my first tB projects and does it entirely self-contained without using my even larger WinDevLib project.