unit FilesDragDropU;
interface
uses
Windows,
ActiveX, ShlObj, SysUtils, COMObj;
type
TDropSource =
class(TInterfacedObject, IDropSource)
protected
fDirectory:
String;
fFileName:
String;
public
constructor Create(Directory:
String; FileName:
String);
// Funktionen für Drag&Drop
function GiveFeedback(dwEffect: Integer): HRESULT;
stdcall;
function QueryContinueDrag(fEscapePressed: LongBool;
grfKeyState: Integer): HRESULT;
stdcall;
procedure AfterConstruction;
override;
end;
implementation
function GetFileListDataObject(
const Directory:
string; FileName:
String): IDataObject;
{type
PArrayOfPItemIDList = ^TArrayOfPItemIDList;
TArrayOfPItemIDList = array[0..0] of PItemIDList;}
var
Malloc: IMalloc;
Root: IShellFolder;
FolderPidl: PItemIDList;
Folder: IShellFolder;
p: PItemIDList;
chEaten: ULONG;
dwAttributes: ULONG;
begin
Result :=
nil;
OleCheck(SHGetMalloc(Malloc));
OleCheck(SHGetDesktopFolder(Root));
OleCheck(Root.ParseDisplayName(0,
nil, PWideChar(WideString(Directory)), chEaten, FolderPidl, dwAttributes));
OleCheck(Root.BindToObject(FolderPidl,
nil, IShellFolder, Pointer(Folder)));
p := AllocMem(SizeOf(PItemIDList));
OleCheck(Folder.ParseDisplayName(0,
nil, PWideChar(WideString(FileName)), chEaten, p, dwAttributes));
OleCheck(Folder.GetUIObjectOf(0, 1, p, IDataObject,
nil, Pointer(Result)));
if p <>
nil then
Malloc.Free(p);
FreeMem(p);
// <-- AV hier
Malloc.Free(FolderPidl);
end;
{ TDropSource }
procedure TDropSource.AfterConstruction;
var
DataObject: IDataObject;
Effect: Integer;
begin
inherited;
DataObject := GetFileListDataObject(fDirectory, fFileName);
Effect := DROPEFFECT_NONE;
DoDragDrop(DataObject, Self, DROPEFFECT_COPY, Effect);
end;
constructor TDropSource.Create(Directory:
String; FileName:
String);
begin
fDirectory := Directory;
fFileName := FileName;
end;
function TDropSource.GiveFeedback(dwEffect: Integer): HRESULT;
begin
Result := DRAGDROP_S_USEDEFAULTCURSORS;
end;
function TDropSource.QueryContinueDrag(fEscapePressed: LongBool;
grfKeyState: Integer): HRESULT;
begin
// Operation abbrechen, wenn ESC gedrückt oder die rechte Maustaste gedrückt (Standard)
if fEscapePressed
or (grfKeyState
and MK_RBUTTON = MK_RBUTTON)
then
begin
Result := DRAGDROP_S_CANCEL;
end
else
// Operation abschließen, wenn linke Maustaste losgelassen (Standard)
if grfKeyState
and MK_LBUTTON = 0
then
begin
Result := DRAGDROP_S_DROP;
end
else
// Ansonsten Operation fortführen (Standard)
begin
Result := S_OK;
end;
end;
end.