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

I made an x64-supporting version of this project in twinBASIC, with the interfaces defined right in the project instead of a TLB.

Not as virtual objects either, tB has a specific feature for using interfaces:

Code:

---

[ InterfaceId ("4657278B-411B-11D2-839A-00C04FD918D0") ]
Interface IDropTargetHelper Extends stdole.IUnknown
    Sub DragEnter(ByVal hwndTarget As LongPtr, ByVal pDataObject As DragDropDemo.IDataObject, ppt As POINT, ByVal dwEffect As DROPEFFECTS)
    Sub DragLeave()
    Sub DragOver(ppt As POINT, ByVal dwEffect As DROPEFFECTS)
    Sub Drop(ByVal pDataObject As DragDropDemo.IDataObject, ppt As POINT, ByVal dwEffect As DROPEFFECTS)
    Sub Show(ByVal fShow As Long)
End Interface

---

[twinBASIC] Explorer-style Drag-Drop Images with tB-defined x86+x64 interfaces

Quote:

---

Originally Posted by fafalone

Yeah I'm working on a much more full-featured class; every example posted is already implemented in my app, it's just a big step between that and releasing a stand-

Code:

---

If AcceptFmt(CF_DIB) Then
  tFMT.cfFormat = CF_DIB

---

---

what's AcceptFmt?

When I drop files with filenames' lenght exceeding MAX_PATH DragQueryFileW fails in Windows 10. I don't know if it fails in other versions. In those cases the clipboard format is CF_HDROP, which doesn't seem very specific...

I'm using an early version of cDropTarget.cls, the one which size is 4.744 bytes. This works OK with oleexp501.tlb. There are a few updates that don't seem to deal with the issue.

Is there a workaround for this issue?

Have you tried the method in post #2?

has anyone figured out how to drag drop across privilege levels? I have tried various messages with ChangeWindowMessageFilterEx but havent found the right combo for drag drop yet

Quote:

---

Originally Posted by fafalone

Have you tried the method in post #2?

---

I didn't but I may if you think it may do the trick. By the way, great work! Thanks!

Yes I read somewhere that by Windows 10, IShellItem could support long path names.

Great! I'll give it a try. Thanks!

Quote:

---

Originally Posted by dz32

has anyone figured out how to drag drop across privilege levels? I have tried various messages with ChangeWindowMessageFilterEx but havent found the right combo for drag drop yet

---

The official way to do it is enable UIAccess in the manifest. In addition to that, your exe must be signed and reside in a trusted location like Program Files.

I was actually looking at another, undocumented, way of doing it the other day, but I haven't tried it yet; if you run as SYSTEM (e.g. with my RunAsTI app, although I believe you'd need to modify it to steal the token from lsass.exe instead), you can enable SeTcbPrivilege and set the UiAccess token privilege; the article wasn't real clear on if this also bypassed the trusted location requirement. I'll give it a try later today.

Cool :) I will basically never use a manifest, be signed or run from program files lol. Fingers crossed on the token method!

Bad news; I was able to start programs with UIAccess enabled on the token, but it doesn't bypass the trusted location and signature requirements :(

Edit: Even more bad news, apparently self-signed certificates are no longer good enough.

Aghh sucks. From and usability standpoint I really miss xp in a number of ways !

Quote:

---

Originally Posted by fafalone

Have you tried the method in post #2?

---

Sorry to bother you. Can you please attach a complete example of that? I've been messing with it for 2 hours now and I'm lost.

I basically pasted the code from post #2 into the project attached on post #1, but I don't know what to do now. I don't see LVDH defined anywhere so I just commented out the line for the test. I also defined "Dim IID_IShellItemArray As UUID" because I don't see it defined. I don't know what to do with it. Then IDropTarget_Drop is called when I drop files into Picture1 but after the call to "SHCreateShellItemArrayFromDataObject(pDataObj, IID_IShellItemArray, psia)" psia contains Nothing. I guess I'm getting all wrong.

It's meant as an alternative to the DragQueryFiles method. First, the zip download containing oleexp.tlb comes with a file called mIID.bas, add that (Project menu->Add File...) so all the IID_ symbols are available. Then you'd replace the code in the cIDT_Drop event with

Code:

---

Private Sub cIDT_Drop(pDataObj As oleexp.IDataObject, grfKeyState As Long, ptx As Long, pty As Long, pdwEffect As oleexp.DROPEFFECTS)
    Dim psia As IShellItemArray
    Dim piesi As IEnumShellItems
    Dim pItem As IShellItem
    Dim lpFile As Long
    Dim pcl As Long
    Call SHCreateShellItemArrayFromDataObject(pDataObj, IID_IShellItemArray, psia)
    If (psia Is Nothing) = False Then
        psia.EnumItems piesi
        Do While (piesi.Next(1, pItem, pcl) = NOERROR)
            pItem.GetDisplayName SIGDN_FILESYSPATH, lpFile
            Debug.Print "Dropfile " & LPWSTRtoStr(lpFile)
        Loop
    End If
End Sub
Private Function LPWSTRtoStr(lPtr As LongPtr, Optional ByVal fFree As Boolean = True) As String
SysReAllocStringW VarPtr(LPWSTRtoStr), lPtr
If fFree Then
    Call CoTaskMemFree(lPtr)
End If
End Function

---

Thanks a lot, fafalone! That was it! It's working now.
I just droped a 289 characters pathname file and it's displayed correctly prepended with "\\?".
I wonder if this could also work on XP 32 bit. I guess not, but I'll check anyway.

Unfortunately SHCreateShellItemArrayFromDataObject, IEnumShellItems, and IShellItemArray are only available on Vista+, so it would work on Windows 7, but not XP. You could do something similar to get IShellItem representations; but I don't think they supported long paths on XP anyway. And that would be a pain to do, as so few IShellItem helper APIs were available on XP. You'd have to manually examine the IDataObject for the CFSTR_SHELLIDLIST format and extract it.

You're completely right. I checked that a few hours ago. None of those functions exist in XP. In the explorer the files with pathname lenght exceeding MAX_PATH are shown with their filenames truncated and the context menu offers very few items. Yo can't rename, move, copy or open the file. Even in the cmd window the names are shown truncated. I guess this mean that not just the shell is affected. But you're allowed to rename the folders up in the hierarchy containing the file, thus making the file useable again.

For using your code in XP and in W10 without modification I just included both methods (Shell & DragQueryFiles) in the Drop event handler. If the call to SHCreateShellItemArrayFromDataObject fails with error 453 then I use the DragQueryFiles method. This seems to work in XP and in W10.

Thanks again, you've been very helpful !

I would check the behavior on Win7 and 8 too because even though those APIs and interfaces are supported, I'm not sure if they had long path name support prior to 10. Of course it would be like XP and not work in Explorer either.

I don't currently have W8 or W7 to check that.

I have a wmp control in my form and I want to set it as drop target but its hWnd is not exposed, not as a property neither Spy++ detects it. Is there a way to achieve this?

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.