How do I make my DropSouce file acceptable for all purposes that work with files?
I have created a control that represents a list of files and I want to be able to drag and drop files from my control to other applications that work with files. I have implemented the IDragSource interface (as shown below), but when I drag and drop files, the files are only accepted in Windows Explorer, other applications like Firefox, Yahoo Messenger, Photoshop ... do not accept my files. What have I done wrong? I have a feeling that the IDataObject is not configured correctly and I am afraid that I have to implement it myself ... and this is a very difficult task for me because I just started working with interfaces.
Here's the code to reproduce the problem:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ActiveX, ShlObj;
type
TMyControl = class(TMemo, IDropSource)
private
function QueryContinueDrag(fEscapePressed:BOOL; grfKeyState:Longint):HResult; stdcall;
function GiveFeedback(dwEffect:Longint):HResult; stdcall;
procedure DoDragAndDrop;
function GetFileListDataObject:IDataObject;
protected
procedure MouseMove(Shift:TShiftState; X,Y:Integer); override;
end;
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
public
MyMemo:TMyControl;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{TMyControl}
function TMyControl.QueryContinueDrag(fEscapePressed:BOOL; grfKeyState:Longint):HResult;
begin
if fEscapePressed then Result:=DRAGDROP_S_CANCEL
else if (grfKeyState and (MK_LBUTTON or MK_RBUTTON) = 0) then Result:=DRAGDROP_S_DROP
else Result:=S_OK;
end;
function TMyControl.GiveFeedback(dwEffect:Longint):HResult;
begin
Result:=DRAGDROP_S_USEDEFAULTCURSORS;
end;
procedure TMyControl.DoDragAndDrop;
var AllowedEffects,DropEffect:Longint;
DataObj:IDataObject;
begin
AllowedEffects:=DROPEFFECT_COPY;
DataObj:=GetFileListDataObject;
if DataObj <> nil then
DoDragDrop(DataObj, self, AllowedEffects, DropEffect);
end;
function TMyControl.GetFileListDataObject:IDataObject;
var Desktop:IShellFolder;
Attr,Eaten:ULONG;
Count,x:Integer;
Pidls:array of PItemIDList;
begin
Result:=nil;
Count:=Lines.Count;
if Count<1 then Exit;
if Failed(SHGetDesktopFolder(Desktop)) then Exit;
SetLength(Pidls,Count);
for x:=0 to Count-1 do Pidls[x]:=nil;
try
for x:=0 to Count-1 do
if Failed(Desktop.ParseDisplayName(0, nil, PWideChar(Lines[x]), Eaten, Pidls[x], Attr)) then Exit;
Desktop.GetUIObjectOf(0, Count, Pidls[0], IDataObject, nil, Result);
finally
for x:=0 to Count-1 do
if Pidls[x]<>nil then CoTaskMemFree(Pidls[x]);
end;
end;
procedure TMyControl.MouseMove(Shift:TShiftState; X,Y:Integer);
begin
if ssLeft in Shift then DoDragAndDrop;
inherited;
end;
//---------------------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
MyMemo:=TMyControl.Create(Form1);
MyMemo.Parent:=Form1;
MyMemo.Align:=alClient;
end;
end.
+3
source to share
1 answer
The problem is with the wrong Desktop.GetUIObjectOf call. When you call the elements of SomeFolder.GetUIObjectOf, MUST be children of SomeFolder. But in your case, this is not true. Try something like this:
type
PPItemIDList = ^PItemIDList;
function GetFileListDataObject(AParentWnd: HWND; const APath: string; AFileNames: TStrings): IDataObject;
var
Desktop: IShellFolder;
Eaten, Attr: ULONG;
i: Integer;
PathIDList: PItemIDList;
PathShellFolder: IShellFolder;
IDLists: PPItemIDList;
IDListsSize: Integer;
Pos: PPItemIDList;
begin
Result := nil;
if AFileNames.Count < 1 then Exit;
if Failed(SHGetDesktopFolder(Desktop)) then Exit;
try
Attr := 0;
if Failed(Desktop.ParseDisplayName(AParentWnd, nil, PWideChar(APath), Eaten, PathIDList, Attr)) then Exit;
try
if Failed(Desktop.BindToStorage(PathIDList, nil, IShellFolder, PathShellFolder)) then Exit;
try
IDListsSize := SizeOf(PItemIDList) * AFileNames.Count;
GetMem(IDLists, IDListsSize);
try
ZeroMemory(IDLists, IDListsSize);
Pos := IDLists;
for i := 0 to AFileNames.Count - 1 do
begin
Attr := 0;
if Failed(PathShellFolder.ParseDisplayName(0, nil, PWideChar(AFileNames[i]), Eaten, Pos^, Attr)) then Exit;
Inc(Pos);
end;
PathShellFolder.GetUIObjectOf(0, AFileNames.Count, IDLists^, IDataObject, nil, Result);
finally
Pos := IDLists;
for i := 0 to AFileNames.Count - 1 do
begin
if Assigned(Pos^) then
CoTaskMemFree(Pos^);
Inc(Pos);
end;
FreeMem(IDLists);
end;
finally
PathShellFolder := nil;
end;
finally
CoTaskMemFree(PathIDList);
end;
finally
Desktop := nil;
end;
end;
+3
source to share