Ca servira sans doute à bien peu de gens puisque PureBasic comporte déjà une gestion assez complete du Drag &Drop qui répond de façon simple aux besoins les plus courants. Mais si vous avez besoin d'une gestion un peu particulière de ce mécanisme (ce qui était mon cas) il vous faudra plonger les mains dans le cambouis. Ce qui suit défriche bien le terrain :
Le premier code doit être enregistré dans un fichier PB que vous nommerez "dataobject.pb"
Code : Tout sélectionner
;***************************************************************************
;
; IMPLEMENTATION OF IDATAOBJET, IDROPSOURCE & IDROPTARGET
;
; By Zapman
; From a Nico code (http://www.purebasic.fr/english/viewtopic.php?p=201027&sid=a993c3617a34f5a2ee4ccdaa9a3dd8c4#p201027)
; And from "Implementing IDataObject" CATCH 22 : http://www.catch22.net/tuts/dragdrop/3
;
;***************************************************************************
;
;
;***************************************************************************
; CUSTOM STRUCTURES
; Don't look for those structures in the Microsoft documentation, you won't
; find them. They're only to help the implementation of
; iDataObject, IdropSource and IDropTarget in PureBasic
;***************************************************************************
;
#DataMax = 100
Structure iDataObjectData
*pIntf.IDataobject
Refcount.l
m_count.l ; number of STGMEDIUM and FORMATETC objects
m_stgmed.l[#DataMax];We'll store here pointers to a tab of STGMEDIUM objects
m_format.l[#DataMax];We'll store here pointers to a tab of FORMATETC objects
EndStructure
Structure iDropSourceData
*pIntf.IDropSource
Refcount.l
LastEffect.l
pDataobject.l ; we'll store here a pointer to the DataObject used for this DropSource
EndStructure
Structure iDropTargetData
*pIntf.IDropTarget
Refcount.l
TargetGadget.l ; We'll store here a pointer to the target Gadget
AcceptedFormats.s ; We'll store here the list of formats accepted by our targets
FormatMatchs.l ; On DragEnter, we'll store here 1 if the accepted formats and the DataSource formats match and 0 if not
FormatList.s ; We'll store here a list of formats available from the dataSource (this is only for the demo)
InfoWinHdl.l ; We'll store here a pointer to the target GadgetID wich will display infos (this is only for the demo)
EndStructure
Global NewList IDataObject.iDataObjectData()
Global NewList IDropSource.iDropSourceData()
Global NewList IDropTarget.iDropTargetData()
;
;
;***************************************************************************
; GENERAL FUNCTIONS
; By Zapman
;***************************************************************************
;
Procedure.s FormatMessage(lngErrorCode.l)
; Unknown author
MemoryID.l = AllocateMemory (255)
tchar.l = FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, #Null, lngErrorCode, 0, MemoryID, 255, #Null)
e$ = PeekS(MemoryID)
FreeMemory(MemoryID)
If tchar > 0
e$ = Trim(Left(e$, tchar))
Else
e$ = ""
EndIf
ProcedureReturn e$
EndProcedure
;
Procedure.s ProgNameFromCLSID(MyCLSID)
; By Zapman
*Buffer = AllocateMemory(100)
For ct = 1 To Len("CLSID\") ; Write "CLSID\" in Unicode Mode
PokeB(*Buffer+ct*2-2,Asc(Mid("CLSID\",ct,1)))
PokeB(*Buffer+ct*2-1,0)
Next
Slen = StringFromGUID2_(MyCLSID,*Buffer+Len("CLSID\")*2,100)*2 ; add the CLSID String (always coded in Unicode)
Slen+Len("CLSID\")*2
sk$ = ""
For ct = 1 To SLen Step 2 ; Get the string in Unicode OR Ascii depending on our compilation mode
sk$ + Chr(PeekC(*Buffer+ct-1))
Next
FreeMemory(*Buffer)
If SLen
Ret = RegOpenKeyEx_(#HKEY_CLASSES_ROOT,@sk$, 0, #KEY_ALL_ACCESS, @hKey)
If (Ret =#ERROR_SUCCESS)
; Query value of key To get Path And close the key
Ret = RegQueryValueEx_(hKey, #Null, #Null, #Null, #Null, @cSize)
If (Ret = #ERROR_SUCCESS)
*szPath = AllocateMemory(cSize)
Ret = RegQueryValueEx_(hKey, #Null, #Null, #Null, *szPath, @cSize)
If (Ret = #ERROR_SUCCESS)
RegCloseKey_(hKey);
File$ = PeekS(*szPath)
FreeMemory(*szPath)
EndIf
EndIf
EndIf
EndIf
If (Ret <>#ERROR_SUCCESS)
File$ = FormatMessage(Ret)
EndIf
ProcedureReturn File$
EndProcedure
;
Procedure SetCharPosFromXY(GadgetID,x,y)
; By Zapman
; Set cursor/carret position in a listview or editor gadget
; x and y are absolute coordinates (from top/left corner of the screen)
GetWindowRect_(GadgetID, rc.RECT)
x - rc\left
y - rc\top
CharPos = SendMessage_(GadgetID,#EM_CHARFROMPOS,0,(x | y <<16))
SendMessage_(GadgetID,#EM_SETSEL,CharPos,CharPos)
EndProcedure
Procedure DupGlobalMem(hMem.l)
; By Zapman
If hMem
len = GlobalSize_(hMem);
If len
source = GlobalLock_(hMem)
If source
dest = GlobalAlloc_(#GMEM_FIXED, len)
If dest
CopyMemory(source,dest,len)
Else
Debug "*************** ERROR in DupGlobalMem ****************"
Debug "dest is null"
Debug "******************************************************"
EndIf
EndIf
GlobalUnlock_(hMem)
Else
Debug "*************** ERROR in DupGlobalMem ****************"
Debug "len mem is null"
Debug "******************************************************"
EndIf
Else
Debug "*************** ERROR in DupGlobalMem ****************"
Debug "hmem is null"
Debug "******************************************************"
EndIf
ProcedureReturn dest;
EndProcedure
Procedure.s GetTymedName(Tymed)
; By Zapman
; This is just for the demo. Your can delete that in your final project
Select tymed
Case #TYMED_GDI
ret$ = "TYMED_GDI"
Case #TYMED_MFPICT
ret$ = "TYMED_MFPICT"
Case #TYMED_ENHMF
ret$ = "TYMED_ENHMF"
Case #TYMED_HGLOBAL
ret$ = "TYMED_HGLOBAL"
Case #TYMED_FILE
ret$ = "TTYMED_FILE"
Case #TYMED_ISTREAM
ret$ = "TYMED_ISTREAM"
Case #TYMED_ISTORAGE
ret$ = "TYMED_ISTORAGE"
EndSelect
ProcedureReturn ret$
EndProcedure
;
Procedure.s GetDropEffectName(dwEffect)
; By Zapman
; This is just for the demo. Your can delete that in your final project
ret$ = ""
If dwEffect = 0
ret$ = "NONE"
Else
If dwEffect&1
ret$ = "COPY/"
EndIf
If dwEffect&2
ret$ + "MOVE/"
EndIf
If dwEffect&4
ret$ + "LINK/"
EndIf
EndIf
If dwEffect<0
ret$+"SCROLL"
EndIf
If Right(ret$,1)="/"
ret$=Left(ret$,Len(ret$)-1)
EndIf
ProcedureReturn ret$
EndProcedure
;
Procedure.s GetClipboardFormatName(Format)
; By Zapman
ret$ = ""
Buffer$ = Space(255)
If GetClipboardFormatName_(Format, @Buffer$, 255) > 0
ret$ = Buffer$
EndIf
ProcedureReturn ret$
EndProcedure
Procedure.s GetFormatName(Format)
; By Zapman
; This is just for the demo. Your can delete that in your final project
Select Format
Case 1
ret$ = "CF_TEXT"
Case 2
ret$ = "CF_BITMAP"
Case 3
ret$ = "CF_METAFILEPICT"
Case 4
ret$ = "CF_SYLK"
Case 5
ret$ = "CF_DIF"
Case 6
ret$ = "CF_TIFF"
Case 7
ret$ = "CF_OEMTEXT"
Case 8
ret$ = "CF_DIB "
Case 9
ret$ = "CF_PALETTE"
Case 10
ret$ = "CF_PENDATA"
Case 11
ret$ = "CF_RIFF"
Case 12
ret$ = "CF_WAVE"
Case 13
ret$ = "CF_UNICODETEXT"
Case 14
ret$ = "CF_ENHMETAFILE"
Case 15
ret$ = "CF_HDROP"
Case 16
ret$ = "CF_LOCALE "
Case 17
ret$ = "CF_MAX/CF_DIBV5"
Case 18 ; (WINVER >= 0x0500)
ret$ = "CF_MAX"
Case $80
ret$ = "CF_OWNERDISPLAY"
Case $81
ret$ = "CF_DSPTEXT"
Case $82
ret$ = "CF_DSPBITMAP"
Case $83
ret$ = "CF_DSPMETAFILEPICT"
Case $8E
ret$ = "CF_DSPENHMETAFILE"
Case $0200
ret$ = "CF_PRIVATEFIRST"
Case $02FF
ret$ = "CF_PRIVATELAST"
Case $0300
ret$ = "CF_GDIOBJFIRST"
Case $03FF
ret$ = "CF_GDIOBJLAST"
Default
ret$ = GetClipboardFormatName(Format)
EndSelect
If ret$ = ""
ret$ = "Unknown ClipFormat: "+Str(Format)
EndIf
ProcedureReturn ret$
EndProcedure
;
Procedure LookupFormatEtc(*dataobject.iDataObjectData,*pFormatEtc.FORMATETC) ; This procedure is used by the DataObject Interface
; It checks each of our formats in turn to see If one matches with *pFormatEtc
;
; This procedure uses our particular iDataObjectData structure
; and depends on the choices we made to store pointers to
; our FORMATETC objects. It'll have to be adapted if you
; organize your implementation in another way.
If *dataobject And *pFormatEtc
For i = 0 To *dataobject\m_count-1
*DataFormatEtc.FORMATETC = *dataobject\m_format[i]
If *DataFormatEtc\tymed & *pFormatEtc\tymed
If *DataFormatEtc\cfFormat = *pFormatEtc\cfFormat
If *DataFormatEtc\dwAspect = *pFormatEtc\dwAspect
ProcedureReturn i ;index of stored format pointer
EndIf
EndIf
EndIf
Next
EndIf
ProcedureReturn -1;
EndProcedure
;
Procedure ComputeDropEffect_OnKey (grfKeyState,dwAllowed)
; By Zapman
dwEffect = dwAllowed;
If(grfKeyState & #MK_CONTROL)
dwEffect = dwAllowed & #DROPEFFECT_COPY;
ElseIf(grfKeyState & #MK_SHIFT)
dwEffect = dwAllowed & #DROPEFFECT_MOVE;
EndIf
ProcedureReturn dwEffect
EndProcedure
Procedure ComputeDropEffect (grfKeyState,PtX,PtY,dwAllowed) ; This procedure is used by the DropTarget interface
; By Zapman
dwEffect = 0;
; 1. check "pt" -> do we allow a drop at the specified coordinates?
; complete the function here if needed
; 2. work out that the drop-effect should be based on grfKeyState
dwEffect = ComputeDropEffect_OnKey (grfKeyState,dwAllowed)
;3 No key-modifiers were specified (Or drop effect Not allowed),
; so base the effect on those allowed by the dropsource
If((dwEffect = 0) Or (dwEffect=dwAllowed))
If(dwAllowed & #DROPEFFECT_COPY) : dwEffect = #DROPEFFECT_COPY : EndIf
If(dwAllowed & #DROPEFFECT_MOVE) : dwEffect = #DROPEFFECT_MOVE : EndIf
EndIf
ProcedureReturn dwEffect
EndProcedure
;
Procedure SetFormatEtc(*etc.FORMATETC,cfFormat,ptd=0,dwAspect=#DVASPECT_CONTENT,lindex=-1,tymed=#TYMED_HGLOBAL)
; By Zapman
*etc\cfFormat = cfFormat;
*etc\ptd = ptd
*etc\dwAspect = dwAspect
*etc\lindex = lindex
*etc\tymed = tymed
EndProcedure
;
Procedure SetStgMedium (*stgmed.STGMEDIUM,hmem,tymed=#TYMED_HGLOBAL,pUnkForRelease=#Null)
; By Zapman
*stgmed\tymed = tymed
*stgmed\hGlobal = hmem
*stgmed\pUnkForRelease = pUnkForRelease
EndProcedure
Procedure StringToHandle(MyString.s,AsciiUnicode)
; By Zapman
If (AsciiUnicode = #PB_Unicode And #PB_Compiler_Unicode) Or (AsciiUnicode = #PB_Ascii And #PB_Compiler_Unicode=0)
convert = 0
SOC = SizeOf(Character)
ElseIf (AsciiUnicode = #PB_Unicode And #PB_Compiler_Unicode=0) ; we need to convert the string to unicode mode
convert = #PB_Unicode
SOC = 2 ; Each Unicode character needs two bytes
Else; we need to convert the string to ascii mode
convert = #PB_Ascii
SOC = 1
EndIf
StringSize = SOC * (Len(MyString)+1) ; add one to the string length to contain the zero ending the string
hData = GlobalAlloc_(#GMEM_MOVEABLE,StringSize)
If hData
pData = GlobalLock_(hData)
If pData
If convert = 0
PokeS(pData,MyString,Len(MyString))
ElseIf convert = #PB_Unicode
PokeS(pData,MyString,Len(MyString),#PB_Unicode)
Else
PokeS(pData,MyString,Len(MyString),#PB_Ascii)
EndIf
Else
GlobalUnlock_(hData)
GlobalFree_(hData)
ProcedureReturn 0
EndIf
GlobalUnlock_(hData)
EndIf
ProcedureReturn hData
EndProcedure
;
Procedure.s HandleToString(hData)
; By Zapman
pData = GlobalLock_(hData)
If pData
ProcedureReturn PeekS(pData)
EndIf
GlobalUnlock_(hData)
EndProcedure
;
Procedure FilesListToHandle(MyString.s)
; copy string To a Global memory block inside a DROPFILE Structure
; the original string must be a list of filenames separated by the chr(10) character
; By Zapman
If Right(MyString,1)<>Chr(10) ; if we have no chr(10) at the end of the list, we add one
MyString + Chr(10)
EndIf
; the string included into the DROPFILES structure must be terminated by a double zero
MyString + Chr(10)
; chr(10) will be replaced by zero, so we'll get a string terminated by a double zero
StringSize = (SizeOf(Character) * Len(MyString)) ; to be compatible with Unicode compilation mode
hData = GlobalAlloc_(#GMEM_MOVEABLE,SizeOf(DROPFILES) + StringSize)
If hData
*pDrop.DROPFILES = GlobalLock_(hData)
If *pDrop
*pDrop\pFiles = SizeOf(DROPFILES) ; size of the DROPFILES structure
pData = *pDrop + *pDrop\pFiles ; data will be paste at the end of the DROPFILES structure
CopyMemory(@MyString,pData, StringSize)
For ct = pData To (pData+StringSize) Step SizeOf(Character) ; replace all chr(10) by zero
If PeekB(ct)=10 : PokeB(ct,0) : EndIf
Next
If #PB_Compiler_Unicode
; If we're compiling for Unicode, set the Unicode flag in the struct to
; indicate it contains Unicode strings.
*pDrop\fWide =#True;
Else
*pDrop\fWide =#False
EndIf
Else
GlobalUnlock_(hData)
GlobalFree_(hData)
ProcedureReturn 0
EndIf
GlobalUnlock_(hData)
EndIf
ProcedureReturn hData
EndProcedure
;
Procedure.s HandleToFilesList(handle)
; Extract FilesList from a DROPFILE Structure
; By Zapman
*pDrop.DROPFILES = GlobalLock_(handle)
*buffer = *pDrop + *pDrop\pFiles ; data is stored at this adress
If *pDrop\fWide =#True ; if FilesList is stored in unicode mode, each character has 2 bytes size
SOC = 2
Else
SOC = 1
EndIf
pos = -SOC
nbzero = 0
Repeat ; look for a double zero at the end of the FilesList
pos + SOC
If PeekB(*buffer+pos)=0
nbzero + 1
Else
nbzero = 0
EndIf
Until nbzero = 2 Or pos>1000 ; If we don't find a double zero, we stop to explore the memory after 1000 character
If nbzero = 2 ; OK, we now have the lenght of the FilesList
StringSize = pos
*buffer2 = AllocateMemory(StringSize)
CopyMemory(*buffer,*buffer2,StringSize) ; duplicate the buffer to leave the original buffer as it is
ct = 0
Repeat
If PeekB(*buffer2+ct)=0
PokeB(*buffer2+ct,10) ; replace zero by chr(10) in all the FilesList
EndIf
ct + SOC
Until ct = (StringSize-SOC)
If *pDrop\fWide =#True
MyString.s = PeekS(*buffer2,#PB_Any,#PB_Unicode)
Else
MyString.s = PeekS(*buffer2,#PB_Any,#PB_Ascii)
EndIf
FreeMemory(*buffer2)
EndIf
GlobalUnlock_(handle)
ProcedureReturn MyString
EndProcedure
;
;***************************************************************************
;
; IMPLEMENTATION OF IDATAOBJET
;
; By Zapman
; From a Nico code (http://www.purebasic.fr/english/viewtopic.php?p=201027&sid=a993c3617a34f5a2ee4ccdaa9a3dd8c4#p201027)
; And from "Implementing IDataObject" CATCH 22 : http://www.catch22.net/tuts/dragdrop/3
;
;***************************************************************************
;
Procedure dataobject_AddRef(*dataobject.iDataObjectData)
Debug "dataobject AddRef : "+Str(*dataobject\Refcount+1)
*dataobject\Refcount=*dataobject\Refcount+1
ProcedureReturn *dataobject\Refcount
EndProcedure
Procedure dataobject_Release(*dataobject.iDataObjectData)
Debug "dataobject Release : "+Str(*dataobject\Refcount-1)
*dataobject\Refcount=*dataobject\Refcount-1
If *dataobject\Refcount
ProcedureReturn *dataobject\Refcount
Else
ForEach IDataObject()
If IDataObject()=*dataobject
For ct = 1 To *dataobject\m_count
If *dataobject\m_stgmed[ct]
*medium.STGMEDIUM = *dataobject\m_stgmed[ct]
If *medium\tymed<>#TYMED_FILE ; I don't want to delete the source file if any
ReleaseStgMedium_(*medium) ; free memory
EndIf
EndIf
Next
DeleteElement (IDataObject())
Debug "dataobject is now deleted."
Break
EndIf
Next
ProcedureReturn 0
EndIf
EndProcedure
Procedure dataobject_QueryInterface(*dataobject.IDataobject, iid, *ppvObject.Long)
If CompareMemory (iid, ?IID_IUnknown, 16)=1 Or CompareMemory (iid, ?IID_IDataObject, 16)=1
Debug "dataobject QueryInterface"
*ppvObject\l = *dataobject
*dataobject\AddRef()
ProcedureReturn #S_OK
Else
*ppvObject\l=0
ProcedureReturn #E_NOINTERFACE
EndIf
EndProcedure
Procedure dataobject_GetData(*dataobject.iDataObjectData,*pformatetcIn.FORMATETC, *pmedium.STGMEDIUM)
; This implementation is not complete !
; You'll have to do some work if you want to use it with
; data which is different from hGlobal
If *pformatetcIn = 0
Debug "dataobject GetData : *pformatetcIn is null!!"
ProcedureReturn #DV_E_FORMATETC
EndIf
If *pmedium = 0
Debug "dataobject GetData : *pmedium is null!!"
ProcedureReturn #STG_E_MEDIUMFULL
EndIf
Index = LookupFormatEtc(*dataobject,*pformatetcIn)
If Index = -1
Debug "dataobject GetData for : " + GetFormatName(*pformatetcIn\cfFormat)+" ---> NOT AVAILABLE"
ProcedureReturn #DV_E_FORMATETC
Else
*medium.STGMEDIUM = *dataobject\m_stgmed[Index]
If *medium\tymed = #TYMED_HGLOBAL ; need to be adapted if the data in not hGlobal !!!
Debug "dataobject GetData for : " + GetFormatName(*pformatetcIn\cfFormat)+" ---> OK"
*pmedium\tymed = *medium\tymed
*pmedium\hGlobal = DupGlobalMem(*medium\hGlobal)
*pmedium\pUnkForRelease = *medium\pUnkForRelease
ProcedureReturn #S_OK
Else
Debug "dataobject GetData for : " + GetTymedName(*medium\tymed)+" ---> NOT IMPLEMENTED"
ProcedureReturn #E_NOTIMPL
EndIf
EndIf
EndProcedure
Procedure dataobject_GetDataHere(*dataobject, *pformatetc, *pmedium )
; This implementation is not done !
Debug "dataobject GetDataHere"
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure dataobject_QueryGetData(*dataobject.iDataObjectData, *pformatetc.FORMATETC )
If *pFormatEtc
If LookupFormatEtc(*dataobject,*pFormatEtc) = -1
Debug "dataobject QUERY GetData for : " + GetFormatName(*pformatetc\cfFormat)+" ---> NOT AVAILABLE"
ProcedureReturn #DV_E_FORMATETC
Else
Debug "dataobject QUERY GetData for : " + GetFormatName(*pformatetc\cfFormat)+" ---> OK"
ProcedureReturn #S_OK
EndIf
Else
Debug "dataobject QUERY GetData : formatetc is null!!"
ProcedureReturn #DV_E_FORMATETC
EndIf
EndProcedure
Procedure dataobject_GetCanonicalFormatEtc(*dataobject, *pformatectIn ,*pformatetcOut )
; This implementation is not done !
Debug "dataobject GetCanonicalFormatEtc"
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure dataobject_SetData(*dataobject.iDataObjectData, *pformatetc.FORMATETC , *pmedium.STGMEDIUM, fRelease )
;
Debug "dataobject SetData with: " +GetFormatName(*pformatetc\cfFormat)+" - "+GetTymedName(*pmedium\tymed)
;
If *dataobject\m_count<#DataMax
*dataobject\m_format[*dataobject\m_count] = *pformatetc
*dataobject\m_stgmed[*dataobject\m_count] = *pmedium
*dataobject\m_count + 1
RetValue = #S_OK
Else
Debug "dataobject SetData with: " +GetFormatName(*pformatetc\cfFormat)+" - "+GetTymedName(*pmedium\tymed)
Debug "dataobject SetData: Out of memory -> Limit of "+Str(#DataMax)+" data reached"
RetValue = #E_OUTOFMEMORY
EndIf
;
; ------------------- Here is a small demo about reading data added to a HDrop DataObject by Windows Explorer
;
If GetClipboardFormatName(*pformatetc\cfFormat)="TargetCLSID" And *pmedium\tymed=#TYMED_HGLOBAL
;
; We receive info from the target
source = GlobalLock_(*pmedium\hGlobal)
Debug "Target application is: " +ProgNameFromCLSID(source) ; Convert CLSID To String
GlobalUnlock_(*pmedium\hglobal)
EndIf
;
; ---------------------------------------------------------------------------------------------------------
;
ProcedureReturn RetValue
EndProcedure
Procedure dataobject_EnumFormatEtc(*dataobject.iDataObjectData, dwDirection , *ppenumFormatEtc.IEnumFORMATETC)
If dwDirection = #DATADIR_GET
; Will store a tab of our formatetc objects into a *ppenumFormatEtc enumeration
; ATTENTION : our m_format array is an array of POINTERS to formatetc objects
; What we need now is an array of formatetc objects!!!!
; So, we'll create this array now
Dim FormatEtcArray.FormatEtc(*dataobject\m_count-1)
For i = 0 To *dataobject\m_count-1
CopyMemory(*dataobject\m_format.l[i],@FormatEtcArray(i),SizeOf(FormatEtc))
Next
SHCreateStdEnumFmtEtc_(*dataobject\m_count,@FormatEtcArray(0),*ppenumFormatEtc)
Debug "dataobject EnumFormatEtc"
ProcedureReturn #S_OK
Else ; EnumFormatEtc for SetData is not implemented
ProcedureReturn #E_NOTIMPL
EndIf
EndProcedure
Procedure dataobject_DAdvise(*dataobject,*pformatetc, advf, *pAdvSink, *pdwConnection)
; This implementation is not done !
Debug "dataobject DAdvise"
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure dataobject_DUnadvise(*dataobject, dwConnection)
; This implementation is not done !
Debug "dataobject DUnadvise"
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure dataobject_EnumDAdvise(*dataobject, *ppenumAdvise)
; This implementation is not done !
Debug "dataobject EnumDAdvise"
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure CreateDataObject()
OleInitialize_(0)
AddElement (IDataObject())
IDataObject()\pIntf=?VTable_IDataObject_Interface
IDataObject()\m_count = 0
ProcedureReturn IDataObject()
EndProcedure
;
;
;***************************************************************************
;
; IMPLEMENTATION OF IDropSource
;
; By Zapman
:
;
; The goal of my implementation is to be able to drag a virtual file to Explorer
; or to any other application able to receive a file by the drag and drop way.
; By "virtual file", I mean that the file does'nt yet exist when the user begin
; to drag its name. It will be created on the fly when the receiving application
; will ask for the data after a successfull drop.
;
; I need this when developping a FTP client: the user drag a file from the FTP
; directory to Explorer, THEN and IF the drop is successful, I download the file
; from the FTP and give Explorer the data.
;
;
;***************************************************************************
;
#DRAGDROP_S_USEDEFAULTCURSORS = $00040102
Procedure DropSource_AddRef(*dropsource.iDropSourceData)
Debug "*DropSource AddRef : "+Str(*dropsource\Refcount+1)
*dropsource\Refcount=*dropsource\Refcount+1
ProcedureReturn *dropsource\Refcount
EndProcedure
Procedure DropSource_Release(*dropsource.iDropSourceData)
Debug "*DropSource Release : "+Str(*dropsource\Refcount-1)
*dropsource\Refcount=*dropsource\Refcount-1
If *dropsource\Refcount > 0
ProcedureReturn *dropsource\Refcount
Else
ForEach IDropSource()
If IDropSource()=*dropsource
Debug "IDropSource is now deleted"
DeleteElement(IDropSource()) : Break
EndIf
Next
*dropsource=0
ProcedureReturn 0
EndIf
EndProcedure
Procedure DropSource_QueryInterface(*dropsource.IDropSource, iid, *ppvObject.Long)
If CompareMemory(iid, ?IID_IUnknown, 16)=1 Or CompareMemory(iid, ?IID_IDropSource, 16)=1
Debug "*DropSource QueryInterface"
*ppvObject\l = *dropsource
*dropsource\AddRef()
ProcedureReturn #S_OK
Else
*ppvObject\l =0
ProcedureReturn #E_NOINTERFACE
EndIf
EndProcedure
Procedure.l DropSource_QueryContinueDrag(*dropsource.iDropSourceData,fEscapePressed.b, grfKeyState.l)
;Can return S_OK, DRAGDROP_S_DROP, or DRAGDROP_S_CANCEL
Debug "*DropSource_QueryContinueDrag : "+Str(fEscapePressed)+" - "+Str(grfKeyState)
If(fEscapePressed = #True)
ProcedureReturn #DRAGDROP_S_CANCEL
ElseIf (grfKeyState & #MK_LBUTTON)=0
;
; I Choose to allow only COPY and MOVE, but you can make a different choice
AllowedEffect = ComputeDropEffect_OnKey (grfKeyState,#DROPEFFECT_COPY|#DROPEFFECT_MOVE)
If *dropsource\LastEffect & AllowedEffect
;
Debug "*DropSource -----------------> Drop occured !!"
; -----------------------------------------------------------
;
; Particular implementation for my project :
:
; What follows will create files on fly when the user drops
; a filenam with success
;
*Dataobject.IDataObject = *dropsource\pDataObject ; retreive the data object from its pointer
; we did store the pointer using "CreateDropSource"
SetFormatEtc(pformatetc.FORMATETC,#CF_HDROP)
SetStgMedium (pmedium.STGMEDIUM,0)
If *Dataobject\GetData(pformatetc,pmedium) = #S_OK ; Check if the data object contains a Files list
If pmedium\tymed = #TYMED_HGLOBAL
Files$ = HandleToFilesList(pmedium\hGlobal)
index = 1
While StringField(Files$,index,Chr(10))
FileName$ = StringField(Files$,index,Chr(10))
Debug "---------------------------------"
Debug "Creating "+FileName$+" on the fly"
Debug "---------------------------------"
If CreateFile(0,FileName$)
WriteString(0,"Test content"+Str(index))
CloseFile(0)
EndIf
index + 1
Wend
EndIf
EndIf
; -----------------------------------------------------------
EndIf
ProcedureReturn #DRAGDROP_S_DROP
Else
ProcedureReturn #S_OK
EndIf
EndProcedure
Procedure.l DropSource_GiveFeedback(*dropsource.iDropSourceData,dwEffect.l)
;Can return S_OK or DRAGDROP_S_USEDEFAULTCURSORS
Debug "*DropSource_GiveFeedback : "+Str(dwEffect)+" ("+GetDropEffectName(dwEffect)+")"
*dropsource\LastEffect = dwEffect
ProcedureReturn #DRAGDROP_S_USEDEFAULTCURSORS
EndProcedure
Procedure.l CreateDropSource(*Dataobject.IDataobjectData)
OleInitialize_(0)
AddElement (IDropSource())
IDropSource()\pIntf=?VTable_IDropSource_Interface
IDropSource()\pDataobject = *Dataobject ; store a pointer to the current data object
ProcedureReturn IDropSource()
EndProcedure
;
;
;***************************************************************************
;
; IMPLEMENTATION OF IDroptarget
;
; By Zapman
;
;***************************************************************************
;
Procedure DropTarget_AddRef(*DropTarget.iDropTargetData)
Debug " DropTarget AddRef : "+Str(*DropTarget\Refcount+1)
*DropTarget\Refcount=*DropTarget\Refcount+1
ProcedureReturn *DropTarget\Refcount
EndProcedure
Procedure DropTarget_Release(*DropTarget.iDropTargetData)
Debug " DropTarget Release : "+Str(*DropTarget\Refcount-1)
*DropTarget\Refcount=*DropTarget\Refcount-1
If *DropTarget\Refcount > 0
ProcedureReturn *DropTarget\Refcount
Else
ForEach IDropTarget()
If IDropTarget()=*DropTarget
Debug "DropTarget is now deleted"
DeleteElement(IDropTarget()) : Break
EndIf
Next
*DropTarget=0
ProcedureReturn 0
EndIf
EndProcedure
Procedure DropTarget_QueryInterface(*DropTarget.IDropTarget, iid, *ppvObject.Long)
If CompareMemory(iid, ?IID_IUnknown, 16)=1 Or CompareMemory(iid, ?IID_IDropTarget, 16)=1
Debug " DropTarget QueryInterface"
*ppvObject\l = *DropTarget
*DropTarget\AddRef()
ProcedureReturn #S_OK
Else
*ppvObject\l=0
ProcedureReturn #E_NOINTERFACE
EndIf
EndProcedure
;
Procedure.l DropTarget_DragEnter(*DropTarget.IDropTarget,*Dataobject.IDataobject,grfKeyState.l,ptx,pty,*pdwEffect.l)
info$ = "DragEnter : grfKeyState = "+Str(grfKeyState)+" - point : "+Str(ptx)+"/"+Str(pty)+" - pdwEffect = "+GetDropEffectName(PeekL(*pdwEffect))
Debug " DropTarget_"+info$
If *pdwEffect=0
ProcedureReturn #E_INVALIDARG
Else
*Target.iDropTargetData = *DropTarget
SetFocus_(GadgetID(*Target\TargetGadget))
*Dataobject\EnumFormatEtc(#DATADIR_GET,@ppenumFormatEtc.IEnumFORMATETC) ; enumerate all the formats contained by the data object
*Target\FormatList = ""
*Target\FormatMatchs = 0
While ppenumFormatEtc\Next(1,@TempFormatEtc.FormatEtc, #Null) = #S_OK ; check if one of them match with the formats accepted by our drop target
If FindString(*Target\AcceptedFormats,"/"+Str(TempFormatEtc\cfFormat)+"/",0)
*Target\FormatMatchs = 1
EndIf
;
If FindString(*Target\FormatList,GetFormatName(TempFormatEtc\cfFormat),0)=0 ; For Demo only
*Target\FormatList + GetFormatName(TempFormatEtc\cfFormat)+" - "; For Demo only
Debug "---------------------------------------"+GetFormatName(TempFormatEtc\cfFormat)
EndIf; For Demo only
GlobalFree_(@TempFormatEtc)
Wend
; ------------- For Demo ------------
If Right(*Target\FormatList,3)=" - "
*Target\FormatList = Left(*Target\FormatList,Len(*Target\FormatList)-3)
EndIf
If IsGadget(*Target\InfoWinHdl)
If *Target\FormatList
info$ + Chr(13) + "DragSource available formats: "+ *Target\FormatList
EndIf
SetGadgetText(*Target\InfoWinHdl,info$)
EndIf
; -----------------------------------
Effect = PeekL(*pdwEffect) & ComputeDropEffect (grfKeyState,PtX,PtY,#DROPEFFECT_COPY); our DropTarget implementation will only accept DROPEFFECT_COPY from the source
If Effect = 0
*Target\FormatMatchs = 0
EndIf
PokeL(*pdwEffect,Effect) ; set the return value
If *Target\FormatMatchs
If GadgetType(*Target\TargetGadget) = #PB_GadgetType_String Or GadgetType(*Target\TargetGadget) = #PB_GadgetType_Editor
SetCharPosFromXY(GadgetID(*Target\TargetGadget),ptx,pty)
EndIf
EndIf
ProcedureReturn #S_OK
EndIf
EndProcedure
;
Procedure.l DropTarget_DragOver(*DropTarget.IDropTarget,grfKeyState.l,ptx,pty,*pdwEffect.l)
*Target.iDropTargetData = *DropTarget
; ------------- For Demo ------------
info$ = "DragOver "+" - point : "+Str(ptx)+"/"+Str(pty)+" - grfKeyState = "+Str(grfKeyState)+" - DropEffect : "+GetDropEffectName(PeekL(*pdwEffect))
Debug " DropTarget_"+info$
If *Target\FormatList ; in our implementation, the Format List has be initialized by DragEnter
info$ + Chr(13) + "DragSource available formats: "+ *Target\FormatList
EndIf
If IsGadget(*Target\InfoWinHdl)
SetGadgetText(*Target\InfoWinHdl,info$)
EndIf
; -----------------------------------
If *Target\FormatMatchs = 0 ; The formats available from the drop source and accepted by our target don't match
PokeL(*pdwEffect,#DROPEFFECT_NONE) ; set the return value
Else
If GadgetType(*Target\TargetGadget) = #PB_GadgetType_String Or GadgetType(*Target\TargetGadget) = #PB_GadgetType_Editor
SetCharPosFromXY(GadgetID(*Target\TargetGadget),ptx,pty)
EndIf
EndIf
ProcedureReturn #S_OK
EndProcedure
Procedure.l DropTarget_DragLeave(*DropTargetData.iDropTargetData)
; ------------- For Demo ------------
Debug " DropTarget_DragLeave"
SetGadgetText(*DropTargetData\InfoWinHdl,"DragLeave")
; -----------------------------------
ProcedureReturn #S_OK
EndProcedure
Procedure.l DropTarget_Drop(*DropTarget.IDropTarget,*Dataobject.IDataobject,grfKeyState.l,ptx,pty,*pdwEffect.l)
; ------------- For Demo ------------
info$ = "Drop : "+" - point : "+Str(ptx)+"/"+Str(pty)+" - grfKeyState = "+Str(grfKeyState)+" - DropEffect : "+GetDropEffectName(PeekL(*pdwEffect))
Debug " DropTarget_"+info$
; -----------------------------------
*Target.iDropTargetData = *DropTarget
If *Target\FormatMatchs = 0 ; The formats available from the drop source and those accepted by our target don't match
PokeL(*pdwEffect,#DROPEFFECT_NONE) ; set the return value
ProcedureReturn #S_OK
EndIf
; -----------------------------------------------------------
;
; Particular implementation for this project :
;
; What must be done when the drop is successfull depends on the type of target gagdet
; and on what your application is made for.
; So, you'll have to adapt the following code.
If GadgetType(*Target\TargetGadget) = #PB_GadgetType_String Or GadgetType(*Target\TargetGadget) = #PB_GadgetType_Editor
SFormat = 0
If #PB_Compiler_Unicode
; we'll try to get the text in unicode mode
; if it does'nt work, we'll get it in ascii mode
SetFormatEtc(pformatetc.FORMATETC,#CF_UNICODETEXT)
If *Dataobject\QueryGetData(pformatetc) = #S_OK
SFormat = #PB_Unicode
EndIf
EndIf
If SFormat = 0
SetFormatEtc(pformatetc.FORMATETC,#CF_TEXT)
SFormat = #PB_Ascii
EndIf
If SFormat = #PB_Unicode Or *Dataobject\QueryGetData(pformatetc) = #S_OK
SetStgMedium (pmedium.STGMEDIUM,0)
If *Dataobject\GetData(pformatetc,pmedium) = #S_OK
If pmedium\tymed = #TYMED_HGLOBAL
MyData = GlobalLock_(pmedium\hGlobal)
MyString.s = PeekS(MyData,#PB_Any,SFormat)
GlobalUnlock_(pmedium\hGlobal)
SendMessage_(GadgetID(*Target\TargetGadget), #EM_REPLACESEL, #True, @MyString)
;
PokeL(*pdwEffect,#DROPEFFECT_COPY) ; set the return value
;
; ------------- For Demo ------------
If SFormat = #PB_Ascii
Info$ + Chr(13)+"Text has been dropped in ascii mode (CF_TEXT/TYMED_HGLOBAL)"
Else
Info$ + Chr(13)+"Text has been dropped in Unicode mode (CF_UNICODETEXT/TYMED_HGLOBAL)"
EndIf
; -----------------------------------
EndIf
EndIf
EndIf
EndIf
; -----------------------------------------------------------
;
; ------------- For Demo ------------
If IsGadget(*Target\InfoWinHdl)
SetGadgetText(*Target\InfoWinHdl,info$)
EndIf
; -----------------------------------
ProcedureReturn #S_OK
EndProcedure
Procedure.l CreateDropTarget(TargetGadget,InfoGadget,AcceptedFormats$)
OleInitialize_(0)
AddElement (IDropTarget())
IDropTarget()\pIntf=?VTable_IDropTarget_Interface
IDropTarget()\TargetGadget = TargetGadget ; Register a handle to the target gadget
IDropTarget()\InfoWinHdl = InfoGadget ; Register a handle to the info gadget
IDropTarget()\AcceptedFormats = "/"+AcceptedFormats$+"/" ; Register the list of formats accepted by our targets
; Example : if our target accepts CF_TEXT (value=1) and CF_BITMAP (value=2)
; The AcceptedFormats$ input parameter must be a string containing "1/2"
;
If #PB_Compiler_Unicode
If FindString(IDropTarget()\AcceptedFormats,"/1/",0) And FindString(IDropTarget()\AcceptedFormats,"/13/",0) = 0
; if the gadget accepts CF_TEXT and the program is running in Unicode mode
IDropTarget()\AcceptedFormats +"13/" ; we'll also accept CF_UNICODETEXT"
EndIf
EndIf
RegisterDragDrop_(GadgetID(TargetGadget),IDropTarget()) ; declare our gadget as a potential drop target
ProcedureReturn IDropTarget()
EndProcedure
;
;
;***************************************************************************
;
; GENERAL FUNCTIONS FOR DRAG AND DROP
;
; By Zapman
;
;***************************************************************************
;
Procedure OleSetClipboardWithDebug(pDataObject)
; By Zapman
result = OleSetClipboard_(pDataObject)
If result = #CLIPBRD_E_CANT_OPEN
Debug "The OpenClipboard function used within OleSetClipboard failed."
ElseIf result = #CLIPBRD_E_CANT_EMPTY
Debug "The EmptyClipboard function used within OleSetClipboard failed."
ElseIf result = #CLIPBRD_E_CANT_CLOSE
Debug "The CloseClipboard function used within OleSetClipboard failed."
ElseIf result = #CLIPBRD_E_CANT_SET
Debug "The SetClipboardData function used within OleSetClipboard failed."
ElseIf result = #E_NOTIMPL
Debug "Member function contains no implementation."
ElseIf result = -2147221008
Debug "OleInitialize has not been called"
ElseIf result
Debug "Error with OleSetClipboard : "+Str(result)
SetClipboardText("Error with OleSetClipboard : "+Str(result))
EndIf
ProcedureReturn result
EndProcedure
;
Procedure DoDragDropWithDebug(pDataObject, pDropSource ,DROPEFFECT,pdwEffect)
; By Zapman
result = DoDragDrop_(pDataObject, pDropSource ,DROPEFFECT,pdwEffect)
If result = #DRAGDROP_S_DROP
Debug "The OLE drag-and-drop operation was successful."
ElseIf result = #DRAGDROP_S_CANCEL
Debug "The OLE drag-and-drop operation was canceled."
ElseIf result = -2147221008
Debug "OleInitialize has not been called"
ElseIf result = #E_INVALIDARG
Debug "Error with DoDragDrop : Invalid argument"
ElseIf result = #DV_E_FORMATETC
Debug "Invalid FORMATETC structure"
ElseIf result = -1;#E_UNSPEC
Debug "Unexpected error occurred."
ElseIf result
Debug "Error with DoDragDrop : "+Str(result)
EndIf
ProcedureReturn result
EndProcedure
;***************************************************************************
;
; DATA SECTION
;
; By Zapman
;
;***************************************************************************
DataSection
VTable_IDataObject_Interface:
Data.l @dataobject_QueryInterface(), @dataobject_AddRef(), @dataobject_Release()
Data.l @dataobject_GetData(),@dataobject_GetDataHere(),@dataobject_QueryGetData()
Data.l @dataobject_GetCanonicalFormatEtc(),@dataobject_SetData(),@dataobject_EnumFormatEtc()
Data.l @dataobject_DAdvise(),@dataobject_DUnadvise(),@dataobject_EnumDAdvise()
VTable_IDropSource_Interface:
Data.l @DropSource_QueryInterface(), @DropSource_AddRef(), @DropSource_Release()
Data.l @DropSource_QueryContinueDrag(), @DropSource_GiveFeedback()
VTable_IDropTarget_Interface:
Data.l @DropTarget_QueryInterface(), @DropTarget_AddRef(), @DropTarget_Release()
Data.l @DropTarget_DragEnter(), @DropTarget_DragOver(),@DropTarget_DragLeave(), @DropTarget_Drop()
IID_IDataObject: ;{0000010e-0000-0000-C000-000000000046"}
Data.l $0000010E
Data.w $0000,$0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
IID_IDropSource: ;{00000121-0000-0000-C000-000000000046}
Data.l $00000121
Data.w $0000,$0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
IID_IDropTarget: ;{00000122-0000-0000-C000-000000000046}
Data.l $00000122
Data.w $0000,$0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
IID_IUnknown: ;"{00000000-0000-0000-C000-000000000046}"
Data.l $00000000
Data.w $0000,$0000
Data.b $C0,$00,$00,$00,$00,$00,$00,$46
EndDataSection
Code : Tout sélectionner
;
; Drag virtual files from List View to Explorer using OLE functions
;
; Translated for PureBasic by Zapman
;
; From "How to Implement Drag and Drop Between Your Program and Explorer" CATCH 22 : http://www.catch22.net/tuts/dragdrop/3
XIncludeFile "DataObject.pb"
appdir$=Space(255) : GetCurrentDirectory_(255,appdir$) ; get the current directory of our application
If OpenWindow(0, 0, 0, 410, 505, "Drag virtual files from List View to Explorer", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)=0:End:EndIf
If CreateGadgetList(WindowID(0))=0:End:EndIf
GText = TextGadget(#PB_Any,10,10,390,30,"Drag those file names to the finder desktop!!")
SetGadgetColor(GText, #PB_Gadget_BackColor, RGB(240,240,155))
If LoadFont(0, "Arial", 12,#PB_Font_Bold)
SetGadgetFont(GText, FontID(0))
EndIf
ELIGRef = ListIconGadget(#PB_Any, 10, 50, 390, 200, "Files", 360, #PB_ListIcon_AlwaysShowSelection|#PB_ListIcon_MultiSelect|#PB_ListIcon_FullRowSelect)
AddGadgetItem(ELIGRef, -1, "testfile.txt")
AddGadgetItem(ELIGRef, -1, "testfile2.txt") ; Those files don't exist ! They we'll be generated on the fly by our IDataObject Interface
BCopy = ButtonGadget(#PB_Any,10,270,150,20,"Copy selection to clipboard")
OText = OptionGadget(#PB_Any,200,270,100,20,"As text")
OFilesList = OptionGadget(#PB_Any,310,270,100,20,"As files list")
SetGadgetState(OFilesList,1)
DisableGadget(BCopy,1)
Frame3DGadget(#PB_Any, 10, 310, 390, 1, "",#PB_Frame3D_Flat)
TextGadget(#PB_Any,10,330,390,20,"Drag viewer")
SDragViewer = StringGadget(#PB_Any,10,350,390,90,"Drag something here to see what it is...")
TDragInfo = TextGadget(#PB_Any,10,445,390,55,"")
*pDropTarget.IDropTarget = CreateDropTarget(SDragViewer,TDragInfo,Str(#CF_TEXT)) ; Create a IDropTarget Interface for the SDragViewer gadget
; Our gadget will only accept #CF_TEXT
Repeat
EventID = WaitWindowEvent()
If EventID=#PB_Event_Gadget
If EventGadget()=OText Or EventGadget()=OFilesList
If EventGadget()=OFilesList
setgadgettext(GText,"Drag those file names to the finder desktop!!")
DisableGadget(BCopy,1)
Else
setgadgettext(GText,"Drag those file names to a text application!!")
DisableGadget(BCopy,0)
EndIf
EndIf
If (EventGadget()=ELIGRef And EventType() = #PB_EventType_DragStart) Or EventGadget()=BCopy
Files$ = ""
For i = 0 To CountGadgetItems(ELIGRef)-1
If GetGadgetItemState(ELIGRef, i) & #PB_ListIcon_Selected
Files$ + appdir$+"\"+GetGadgetItemText(ELIGRef, i,0) + Chr(10)
EndIf
Next i
If Files$ = ""
Files$ = "Empty selection !!!"
EndIf
*pDataObject.IDataobject = CreateDataObject() ; Create a IDataObject Interface
If GetGadgetState(OText)
If #PB_Compiler_Unicode ; If we compile in Unicode Mode, we'll register two different formats in our DataObject
;
SetFormatEtc(@etcU.FORMATETC,#CF_UNICODETEXT) ; register the format in a FORMATETC structure
hDataU = StringToHandle(Files$,#PB_Unicode); Copy the text string To a Global memory block.
SetStgMedium (@stgmedU.STGMEDIUM,hDataU) ; include the handle into a STGMEDIUM Structure
*pDataObject\setdata(@etcU,@stgmedU, 1) ; Set the DataObject with our data
EndIf
SetFormatEtc(@etc.FORMATETC,#CF_TEXT) ; register the format in a FORMATETC structure
hData = StringToHandle(Files$,#PB_Ascii); Copy the text string To a Global memory block.
SetStgMedium (@stgmed.STGMEDIUM,hData) ; include the handle into a STGMEDIUM Structure
*pDataObject\setdata(@etc,@stgmed, 1) ; Set the DataObject with our data
Else
hgDrop = FilesListToHandle(Files$) ; copy string To a Global memory block inside a DROPFILE Structure
SetStgMedium (@stgmed.STGMEDIUM,hgDrop); include the handle into a STGMEDIUM Structure
SetFormatEtc(@etc.FORMATETC,#CF_HDROP); register the format in a FORMATETC structure
*pDataObject\setdata(@etc,@stgmed, 1) ; Set the DataObject with our data
EndIf
If (EventGadget()=ELIGRef And EventType() = #PB_EventType_DragStart)
Debug "DragStart"
*pDropSource.IDropSource = CreateDropSource(*pDataObject) ; Create a IDropSource Interface
DoDragDropWithDebug(*pDataObject, *pDropSource ,#DROPEFFECT_COPY,@pdwEffect.l)
Else
OleSetClipboardWithDebug(*pDataObject)
OleFlushClipboard_();
Debug "The clipboard is now containing : ''"+GetClipboardText()+"''" ; to see if it works
EndIf
EndIf
EndIf
Until EventID=#PB_Event_CloseWindow
End
IMPORTANT : l'implémentation de IDataObject n'est que rarement nécessaire, on peut souvent se contenter d'implémenter uniquement IDropSource ou IDropTarget (selon les besoins qu'on a). Je complèterais ce post un peu plus tard en montrant comment on peut utiliser un IDataObject généré par Windows sans avoir à le recréer de toute pièce.
La seule procédure qui incrémente m_count, c'est dataobject_SetData et cette procédure n'est appelée qu'une seule fois au cours d'un drag/drop vers le bureau. m_count ne devrait donc jamais être supérieur à 1 pour cette manip.
