While I've got a thread going about how to do this the right way and actually implement an IDataObject, in the mean time I thought I'd post a trick that you can use to dragdrop any format without one.
Normally, to drag text to another app, you'd have to create an implementation of IDataObject in a class, then implement all its methods and support CF_TEXT and/or CF_UNICODETEXT and others you wanted. However, if you were just looking to copy files with CF_HDROP, you may have seen my other project where there's an API that does this for you-- SHCreateDataObject. There's not a direct equivalent for any other CF_ format, but it turns out that you can call that API without actually specifying a file, and still get back a fully functional default IDataObject from Windows instead of rolling your own custom one, which you can then add your desired formats to. This is still far less code and far easier than providing a custom implementation.
Requirements
-Windows Vista or higher*
-oleexp3.tlb with mIID.bas (although any typelib with a normal IDataObject def could be substituted)
Code
Primary code to create and drag, typically called from a MouseDown event:
The example above adds two formats to the blank IDataObject, CF_TEXT (IDO_AddTextA) and CF_UNICODETEXT (IDO_AddTextW):
You can follow the same basic procedure to add any formats you want to your IDataObject. As another example, here's how to drag a PNG image from the file on disk, which shows the technique for dragging file contents:
You can add multiple formats to the same object; it's the drop target that decides which it can accept and display.
Since it's a custom format, we don't get the benefit of a default icon anymore. But making a drag image isn't too hard; we can use the IDragSourceHelper interface for that. If you've got a control you're dragging from that does drag images, you can use InitializeFromWindow, but if you want full control you can create the entire image yourself. Here's an IDO_AddPNGEx routine that does just that:
A 32x32 drag image thumbnail of a PNG being dragged, next to it after being dropped and rendered at full size (see next post):
![]()
And finally, you can also set a default drop description (although drop targets frequently set their own):
![]()
First, in IDO_AddPNGEx, change pHelper.SetFlags 0& to pHelper.SetFlags DSH_ALLOWDROPDESCRIPTIONTEXT
Then immediately after IDO_AddPNGEx, add IDO_AddDropDesc pDataObj, DROPIMAGE_LABEL, "Drop %1 here", "MyPNG"
--------------------------------
* - Normally I would use the undocumented SHCreateFileDataObject and retain XP support, but with this usage the IDataObject it creates returns with several additional formats inserted with blank or corrupt data. If XP support is a requirement you can try it and see if the formats are a problem for your usage or not.
Normally, to drag text to another app, you'd have to create an implementation of IDataObject in a class, then implement all its methods and support CF_TEXT and/or CF_UNICODETEXT and others you wanted. However, if you were just looking to copy files with CF_HDROP, you may have seen my other project where there's an API that does this for you-- SHCreateDataObject. There's not a direct equivalent for any other CF_ format, but it turns out that you can call that API without actually specifying a file, and still get back a fully functional default IDataObject from Windows instead of rolling your own custom one, which you can then add your desired formats to. This is still far less code and far easier than providing a custom implementation.
Requirements
-Windows Vista or higher*
-oleexp3.tlb with mIID.bas (although any typelib with a normal IDataObject def could be substituted)
Code
Primary code to create and drag, typically called from a MouseDown event:
Code:
Public Declare Function SHCreateDataObject Lib "shell32" (ByVal pidlFolder As Long, ByVal cidl As Long, ByVal apidl As Long, pdtInner As Any, riid As UUID, ppv As Any) As Long
Public Declare Function SHDoDragDrop Lib "shell32" (ByVal hwnd As Long, ByVal pdtobj As Long, ByVal pdsrc As Long, ByVal dwEffect As Long, pdwEffect As Long) As Long
Public Sub DoDrag()
Dim pDataObj As oleexp3.IDataObject
Call SHCreateDataObject(0&, 0&, 0&, ByVal 0&, IID_IDataObject, pDataObj)
If (pDataObj Is Nothing) Then
Debug.Print "couldn't get ido"
Else
Debug.Print "got ido"
IDO_AddTextW pDataObj, "TextWTest"
IDO_AddTextA pDataObj, "TextATest"
Dim lp As Long
Dim hr As Long
hr = SHDoDragDrop(Me.hwnd, ObjPtr(pDataObj), 0&, DROPEFFECT_COPY, lp)
Set pDataObj = Nothing
End If
End SubCode:
Public Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Public Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Public Sub IDO_AddTextW(ido As oleexp3.IDataObject, sText As String)
Dim fmt As FORMATETC
Dim stg As STGMEDIUM
Dim hGlobal As Long, lpGlobal As Long
Dim sz As String
sz = sText & vbNullChar
hGlobal = GlobalAlloc(GPTR, LenB(sz))
If hGlobal Then
lpGlobal = GlobalLock(hGlobal)
Call CopyMemory(ByVal lpGlobal, ByVal StrPtr(sz), LenB(sz))
Call GlobalUnlock(hGlobal)
stg.TYMED = TYMED_HGLOBAL
stg.Data = lpGlobal
fmt.cfFormat = CF_UNICODETEXT
fmt.dwAspect = DVASPECT_CONTENT
fmt.lIndex = -1
fmt.TYMED = TYMED_HGLOBAL
ido.SetData fmt, stg, 1
End If
End Sub
Public Sub IDO_AddTextA(ido As oleexp3.IDataObject, sText As String)
Dim fmt As FORMATETC
Dim stg As STGMEDIUM
Dim hGlobal As Long, lpGlobal As Long
Dim b() As Byte
hGlobal = GlobalAlloc(GPTR, Len(sText) + 1)
If hGlobal Then
lpGlobal = GlobalLock(hGlobal)
b = StrConv(sText & vbNullChar, vbFromUnicode)
CopyMemory ByVal lpGlobal, b(0), UBound(b) + 1
Call GlobalUnlock(hGlobal)
stg.TYMED = TYMED_HGLOBAL
stg.Data = lpGlobal
fmt.cfFormat = CF_TEXT
fmt.dwAspect = DVASPECT_CONTENT
fmt.lIndex = -1
fmt.TYMED = TYMED_HGLOBAL
ido.SetData fmt, stg, 1
End If
End SubCode:
Public Declare Function RegisterClipboardFormatW Lib "user32" (ByVal lpszFormat As Long) As Long
Public Declare Function CreateFileW Lib "kernel32" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Public Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOverlapped As Any) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Const FILE_READ_DATA = &H1
Public Const FILE_SHARE_READ = &H1&
Public Const OPEN_EXISTING = 3&
Public Sub IDO_AddPNG(pDataObj As oleexp3.IDataObject, sPng As String)
Dim fmt As FORMATETC
Dim stg As STGMEDIUM
Dim hGlobal As Long, lpGlobal As Long
Dim hFile As Long, nFile As Long, lp As Long
Dim bPNG() As Byte
hFile = CreateFileW(StrPtr(sPng), FILE_READ_DATA, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
If hFile Then
nFile = GetFileSize(hFile, lp)
Debug.Print "high=" & nFile & ",low=" & lp
ReDim bPNG(nFile)
ReadFile hFile, bPNG(0), nFile, lp, 0&
CloseHandle hFile
If lp > 0& Then
hGlobal = GlobalAlloc(GPTR, UBound(bPNG) + 1)
If hGlobal Then
lpGlobal = GlobalLock(hGlobal)
CopyMemory ByVal lpGlobal, bPNG(0), UBound(bPNG) + 1
Call GlobalUnlock(hGlobal)
stg.TYMED = TYMED_HGLOBAL
stg.Data = lpGlobal
fmt.cfFormat = RegisterClipboardFormatW(StrPtr(CFSTR_PNG))
fmt.dwAspect = DVASPECT_CONTENT
fmt.lIndex = -1
fmt.TYMED = TYMED_HGLOBAL
pDataObj.SetData fmt, stg, 1
End If 'memalloc
End If 'bytesread>0
End If
End SubSince it's a custom format, we don't get the benefit of a default icon anymore. But making a drag image isn't too hard; we can use the IDragSourceHelper interface for that. If you've got a control you're dragging from that does drag images, you can use InitializeFromWindow, but if you want full control you can create the entire image yourself. Here's an IDO_AddPNGEx routine that does just that:
Code:
Public Declare Function ILCreateFromPathW Lib "shell32" (ByVal pwszPath As Long) As Long
Public Declare Function SHCreateItemFromIDList Lib "shell32" (ByVal pidl As Long, riid As UUID, ppv As Any) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal PV As Long) ' Frees memory allocated by the shell
Public Sub IDO_AddPNGEx(pDataObj As oleexp3.IDataObject, sPng As String)
Dim fmt As FORMATETC
Dim stg As STGMEDIUM
Dim hGlobal As Long, lpGlobal As Long
Dim lpFmt As Long
Dim hFile As Long, nFile As Long, lp As Long
Dim bPNG() As Byte
hFile = CreateFileW(StrPtr(sPng), FILE_READ_DATA, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
If hFile Then
nFile = GetFileSize(hFile, lp)
Debug.Print "high=" & nFile & ",low=" & lp
ReDim bPNG(nFile)
ReadFile hFile, bPNG(0), nFile, lp, 0&
CloseHandle hFile
If lp > 0& Then
hGlobal = GlobalAlloc(GPTR, UBound(bPNG) + 1)
If hGlobal Then
lpGlobal = GlobalLock(hGlobal)
CopyMemory ByVal lpGlobal, bPNG(0), UBound(bPNG) + 1
Call GlobalUnlock(hGlobal)
stg.TYMED = TYMED_HGLOBAL
stg.Data = lpGlobal
fmt.cfFormat = CF_PNG
fmt.dwAspect = DVASPECT_CONTENT
fmt.lIndex = -1
fmt.TYMED = TYMED_HGLOBAL
pDataObj.SetData fmt, stg, 1
'set thumbnail for drag
Dim pHelper As IDragSourceHelper2
Set pHelper = New DragDropHelper
Dim tImg As SHDRAGIMAGE
GetFileThumbForIDSH sPng, tImg
pHelper.SetFlags 0&
pHelper.InitializeFromBitmap tImg, pDataObj
End If
End If
End If
End Sub
Private Sub GetFileThumbForIDSH(sFile As String, tSDI As SHDRAGIMAGE, Optional cx As Long = 16, Optional cy As Long = 16)
'This method is Vista-only; you can fall back to IExtractImage or others if you're trying to support XP still
Dim pidl As Long
Dim isiif As IShellItemImageFactory
pidl = ILCreateFromPathW(StrPtr(sFile))
Call SHCreateItemFromIDList(pidl, IID_IShellItemImageFactory, isiif)
If (isiif Is Nothing) = False Then
isiif.GetImage cx, cy, SIIGBF_THUMBNAILONLY, tSDI.hbmpDragImage
tSDI.sizeDragImage.cx = cx
tSDI.sizeDragImage.cy = cy
' tSDI.ptOffset.x = 15 'you can add an offset to see it better, but the drop x,y won't change
' tSDI.ptOffset.Y = 15
Else
Debug.Print "GetFileThumbForIDSH::Failed to get IShellItemImageFactory"
End If
Call CoTaskMemFree(pidl)
End Sub
And finally, you can also set a default drop description (although drop targets frequently set their own):
First, in IDO_AddPNGEx, change pHelper.SetFlags 0& to pHelper.SetFlags DSH_ALLOWDROPDESCRIPTIONTEXT
Then immediately after IDO_AddPNGEx, add IDO_AddDropDesc pDataObj, DROPIMAGE_LABEL, "Drop %1 here", "MyPNG"
Code:
Public Sub IDO_AddDropDesc(ido As oleexp3.IDataObject, nType As DROPIMAGETYPE, sMsg As String, sIns As String)
Dim fmt As FORMATETC
Dim stg As STGMEDIUM
Dim tDD As DROPDESCRIPTION
Dim iTmp1() As Integer
Dim iTmp2() As Integer
Dim hGlobal As Long, lpGlobal As Long
Dim i As Long
On Error GoTo e0
Str2WCHAR sMsg, iTmp1
Str2WCHAR sIns, iTmp2
For i = 0 To UBound(iTmp1)
tDD.szMessage(i) = iTmp1(i)
Next i
For i = 0 To UBound(iTmp2)
tDD.szInsert(i) = iTmp2(i)
Next i
tDD.type = nType
hGlobal = GlobalAlloc(GHND, LenB(tDD))
If hGlobal Then
lpGlobal = GlobalLock(hGlobal)
Call CopyMemory(ByVal lpGlobal, tDD, LenB(tDD))
Call GlobalUnlock(hGlobal)
stg.TYMED = TYMED_HGLOBAL
stg.Data = lpGlobal
fmt.cfFormat = RegisterClipboardFormatW(StrPtr(CFSTR_DROPDESCRIPTION)) 'CF_DROPDESCRIPTION
fmt.dwAspect = DVASPECT_CONTENT
fmt.lIndex = -1
fmt.TYMED = TYMED_HGLOBAL
ido.SetData fmt, stg, 1
End If
Exit Sub
e0:
Debug.Print "IDO_AddDropDesc->" & Err.Description
End Sub
Private Sub Str2WCHAR(sz As String, iOut() As Integer)
Dim i As Long
ReDim iOut(255)
For i = 1 To Len(sz)
iOut(i - 1) = AscW(Mid(sz, i, 1))
Next i
End Sub* - Normally I would use the undocumented SHCreateFileDataObject and retain XP support, but with this usage the IDataObject it creates returns with several additional formats inserted with blank or corrupt data. If XP support is a requirement you can try it and see if the formats are a problem for your usage or not.