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

If it's windowless then you should just be able to register the hwnd it's drawing on, like Form1.hWnd if it's directly on the form.

I tried that before posting and it doesn't work. I guess it's not windowless?

Is it inside some container like a PictureBox or Frame?

This is the regular wmp.dll 'Windows Media Player' component?

Just checked that and it's a windowless control and registering the container it's in (Form, if not in a frame/picturebox/UC) works fine. Remember you can't drag/drop between elevated and unelevated, so if you're running as admin or running the IDE as admin then running from the IDE, it won't work. Theoretically there's supposed to be steps you can take to make it work, but I've been having trouble with that.

It's the regular wmp.dll version 12.0.19041.3636 and is placed straight into the form (no container). I'm running the project in the VB6 SP2 Ide in Windows 10 64 bit 22H2. It's .windowlessVideo property returns False.

It's common to run the IDE as admin; if so, that's the problem as explained in the last post.

If you register the form; is that problem that dragdrop works elsewhere on the form but not on the WMP control? Or does it not work anywhere on the form?

windowlessVideo was false for my test too, so whatever that's talking about, it's not the control as a whole.

I'm not running the IDE as administrator. I don't know how to register the form, if you mean register it using regvr32. Isn't the form created at runtime by the vb6 runtime?

I use other controls in the form as drop targets on other instances of your class and they work as expected.

If I set the form as drop target the drag image is correctly displayed on the regions not covered by other controls (including WMP), but I just noticed that if I release the left button of the mouse there a wait cursor is displayed for a few seconds but the Drop event is not triggered. The DropMode of the form is set to None, as I believe it should be.

If I instead drag the file into the region ocupied by the WMP control the "forbidden" icon is displayed. The control doesn't expose Ole events (as expected from windowless controls), so I have no way to set its DropMode to None or use the control's native Ole events instead of your class.

Otherwise this control has behavied as expected. I miss some functions that could be really useful. Among them one to tell me if a file is playable instead of displaying a warning, one to chose what audio stream in the container to use, one to display subtitles/captions and their displaying options, one to extract specific streams from the container, a frame server...

Register I mean as a drop target using the cDropTarget class this thread is for. OLEDropMode should be none; you do it with the form like:

Code:

---

Private WithEvents cDT As cDropTarget
Private Sub Form_Unload(Cancel As Integer)
cDT.Detach
End Sub
Private Sub cDT_Drop(pDataObj As oleexp.IDataObject, grfKeyState As Long, ptx As Long, pty As Long, pdwEffect As oleexp.DROPEFFECTS)
MsgBox "Drop files"
End Sub

---

This works for me with Win10 1809/wmp.dll 12.0.17763.194; both IDE and compiled.

Quote:

---

If I set the form as drop target the drag image is correctly displayed on the regions not covered by other controls (including WMP), but I just noticed that if I release the left button of the mouse there a wait cursor is displayed for a few seconds but the Drop event is not triggered.

---

Is this just on a form with a WMP control or all forms?

Quote:

---

I use other controls in the form as drop targets on other instances of your class and they work as expected.

---

Is this on the same form? What happens if you register *only* the form? If you register just the form, everything on it should be a drop target, then you can use the DragOver even to determine whether the particular x,y point should show as one or not (by setting pdwEffect).

Quote:

---

Originally Posted by fafalone

Register I mean as a drop target using the cDropTarget class this thread is for. OLEDropMode should be none; you do it with the form like:

Code:

---

Private WithEvents cDT As cDropTarget
Private Sub Form_Unload(Cancel As Integer)
cDT.Detach
End Sub
Private Sub cDT_Drop(pDataObj As oleexp.IDataObject, grfKeyState As Long, ptx As Long, pty As Long, pdwEffect As oleexp.DROPEFFECTS)
MsgBox "Drop files"
End Sub

---

This works for me with Win10 1809/wmp.dll 12.0.17763.194; both IDE and compiled.

---

Good for you! I guess something's wrecked in my OS or the VB6 IDE or who knows where...
I don't have another PC running W10 now. I have a PC running XP and an XP OS running in a VirtualBox in the W10 PC. I may try installing VB6 on them and see what happens.
I'll see if the form registration as a drop target by your class succeds. Maybe it doesn't. I didn't think of it before.

Quote:

---

Originally Posted by fafalone

Is this just on a form with a WMP control or all forms?

---

No other forms in this project (it's a subtitling app I created for my own use back in 2008 and I use almost daily).

Quote:

---

Originally Posted by fafalone

Is this on the same form? What happens if you register *only* the form? If you register just the form, everything on it should be a drop target, then you can use the DragOver even to determine whether the particular x,y point should show as one or not (by setting pdwEffect).

---

Yes, it's the same form. Before my first post I tried registering only the form but I don't remember if all the controls were acting as targets. I'll test that.

I just tried that. No control is acting as drop target. And now I realize that the form isn't either. I made a mistake before; I was dragging into an invisible label and it's there where the drag image was displayed. Weird!

I use your class in other project (a music player) not including a WMP. 3 forms there with 3 drop targets, but no form is a target. I can test setting a form as target there and see what happens.

Edit:
I just tested the return value of .Attach; it's -2147221247. I guess this means that the registration succeded.

Code:

---

Debug.Print cIDT.Attach(Me.hWnd)

---

Edit 2:
Sorry, another mistake: the label I dragged into wasn't invisible, it's opaque and its background color is the same as the form's background.

-2147221247 is an error:

[Description("This window has already been registered as a drop target")] Public Const DRAGDROP_E_ALREADYREGISTERED = &H80040101

Try the attached project. It's what I used to test this, just a new project with a wmp control placed on a form. Hopefully they haven't changed the wmp object GUID so it loads it automatically, but if for some reason the control doesn't load, just manually go check the reference and place a new one, changing no form or control properties.

Thanks for that! You're taking a lot of trouble to help me. I really appreciate it.

Your code works!!

Fortunatelly the WMP GUID was the same. I just had to change the reference to oleexp (mine is 5.01 and is located in a different path) and add your class. All so easy and fast!

Now I'll have to go through my code and compare it with yours. If I can't spot anything suspicious I'll replace your code into my project whenever possible. I'll let you know how it goes.

One thing that can be messing things is my sublassing the form (nothing serious there, just the rawinput stuff). Also there's subclassing into Krool's VBCCR17 controls. I used them instead of those from MS. Other thing that can be messing things is the mClipboardTxt module (from https://www.vbforums.com/showthread....=1#post5067907
). If it proves to be interfering I'll have a hard time because it's paramount for my app. If that's the case and I can't make it and your class live together I'll have to do without your class.

Thanks again!

No problem, glad some progress is being made :)

There shouldn't be any problems with subclassing or VBCCR; I use this same technique for drag drop in many projects; in ucShellBrowse, I use it directly on a ListView where the UC is subclassed, the ListView hwnd is subclassed, and the column header bar is subclassed, and it uses the IPAO stuff from Krool's VBCCR. The only issue might be if you're intercepting and canceling mouse move stuff.

What I'm not sure about is registering both the form and multiple objects on the form... that might cause some kind of conflict. If you already have multiple controls working successfully, then perhaps one option would be to place the WMP control in a container like a PictureBox (there's an BorderStyle property in the PB to remove the border so visually it's the same as being right on the form), and register the PictureBox hwnd as a drop target like you have with other controls.

That's a relief.

I'm not sure about cancelling mouse movements; I mess with those to make the voice recognition app (Dragon NaturallySpeaking) write in the right place on the Rich Text Box. I'll have to look into that.

About using the WMP inside a picture box, sure, that's easy. Otherwise I'll register only the form and address the dropped files according to the coordinates. That's easy too. I don't know which way is most efficient or if that matters at all.

I made some progress. To make a long story short:

I copied all the controls in my form (including the menus) into your form, one by one, testing the behavior of dragging files into your form each time I added a new control. I didn't add code, just left what you wrote.

Some controls caused the behavior I got in my form: no drag image displayed, Drop event not fired.
So far these are the culprits:

VB6 runtime Label
VBCCR17.LabelW
VBCCR17.TextBoxW

VBCCR17.TextBoxW doesn't cause the problem if it's embedded into a VB6 runtime Frame.
VB6 runtime Label & VBCCR17.LabelW cause the problem even if embedded into a VB6 runtime Frame, but only in the area inside the frame; the rest of the form isn't affected.

I replaced them with unharmful controls:
VB6 runtime Label > VB6 runtime TextBox
VB6 runtime Label > VB6 runtime Line
VBCCR17.LabelW > VBCCR17.TextBoxW embedded into a VB6 runtime Frame

I think I pretty much have all the needed controls in your form, but I'll know for sure when I add the code.
Appart from the controls I mentioned I use VBCCR17.Slider, VB6 runtime ListBox, Button, CheckBox, Timer. (I may be forgetting some). These didn't cause problems.

I'll keep you updated.

You're saying just adding a regular VB6 label to the form is causing it to stop working? I'm not able to reproduce that; did you change any of the properties?

Sorry I wasn't clear enough. This happened after adding about 20 other controls, many of them by pasting code from my .vbp file into yours. (I did it this way because it was faster than copying one by one their properties). And yes, I changed properties on many controls.

But you better do your own tests; I was tired and sleepy and in a hurry to get the app working. Now I'm affraid this isn't going to happen soon.

I won't have much time for this until next week. Duty calls.

Project updated 4 (07 May 2024): - Fix for Invalid FORMATETC and other errors with the DragDropHelper object.

And since I've never announced it in this thread before (and just added it to the main post now with the new update):

64bit Compatible twinBASIC version now available!

This project has a 64bit compatible version for twinBASIC that demonstrates defining interfaces in tB and dealing with some complications arising in 64bit with the unusual ByVal POINT arguments of IDropTarget.

Available on GitHub: https://github.com/fafalone/DragDropDemo

(The version there has also been updated to handle these errors)

Quote:

---

Originally Posted by fafalone

You're saying just adding a regular VB6 label to the form is causing it to stop working? I'm not able to reproduce that; did you change any of the properties?

---

The problem with the regular VB6 label desapeared after creating a new (empty) project and dragging the controls into the form from the toolbox instead of pasting code from the old vbp into the vbp of the new project. Don't know why but I'll stick to it. The problem still happens if I drag VBCCR17.TextBoxW or VBCCR17.LabelW into the form. I can live with that.

I have a new problem. I'm registering the form as drop target and I try to get what control in the form is the target of the drop comparing the candidates coordinates into the form to ptx and pty as returned by cDT_Drop. These ptx and pty seem to be in pixels, but are they? And relative to what? How can I convert ptx and pty to a point relative to internal form coordinates? I tried various approachs and didn't get it.

All APIs work in pixels, probably the coordinates are relative to your window. You can convert them to twips or whatever ScaleMode you have with ScaleX/ScaleY:

Code:

---

ScaleX(ptx, vbPixels, ScaleMode) ' converts pixels to whatever your form's ScaleMode is

---

That's the first thing I tried but it didn't work for me.

ptx seems to be always 0 when the drag enters the form from the left, which is a few pixels to the left of the form's border. If the drag comes from the right the drag enters the form a few pixels to the right of the border, too.

Probably ptx can be corrected to match its position relative to the form's work area (and consecuently to the position of each control inside it, but I'm not sure how.

As for pty, it seems to be 0 when the drag enters the form from the top. That's a few pixels above the top of the form, which is also a few pixels above the top of the form's work area, more so if the form has a title bar.

Perhaps ScreenToClient and form.Top / Left...etc. can be used to get that? I may try that approach.

Edit:
This seems to be closer:

Code:

---

            Dim pt As POINTAPI
            pt.x = ptx + ScaleX(Me.Left, vbTwips, vbPixels)
            pt.Y = pty + ScaleY(Me.top, vbTwips, vbPixels)
            ScreenToClient Me.hWnd, pt
            cDTx = ScaleX(pt.x, vbPixels, vbTwips) - Me.Left
            cDTy = ScaleY(pt.Y, vbPixels, vbTwips) - Me.top

---

I'll test it.

Project Updated - cDropTarget v0.5

This version adds a default-true optional argument to Attach to take over an existing registration. This works around a bug with windowless UserControls like VBCCR's LabelW where they register the entire window for dragdrop even if neither the form nor UC have OLEDragDrop enabled.

The 64bit compatible twinBASIC version has also been updated to match features, but tB does not currently have the bug with windowless UserControls.

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.