unit Unit2;
{$WARN SYMBOL_PLATFORM OFF}
interface
uses
Windows,
ActiveX, Classes,ComObj,SysUtils,ShellAPI;
type
Ttest1 =
class(TComObject,IDropTarget)
public
function DragEnter(
const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
var dwEffect: Longint): HResult;
stdcall;
function DragOver(grfKeyState: Longint; pt: TPoint;
var dwEffect: Longint): HResult;
stdcall;
function DragLeave: HResult;
stdcall;
function Drop(
const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
var dwEffect: Longint): HResult;
stdcall;
end;
const
Class_test1: TGUID = '
{35F45D48-100C-4603-AA40-D10516B07704}';
implementation
uses ComServ, unit1 ;
function Ttest1.DragEnter(
const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
var dwEffect: Longint): HResult;
stdcall;
begin
end;
function Ttest1.DragOver(grfKeyState: Longint; pt: TPoint;
var dwEffect: Longint): HResult;
stdcall;
begin
end;
function Ttest1.DragLeave: HResult;
stdcall;
begin
end;
function Ttest1.Drop(
const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
var dwEffect: Longint): HResult;
stdcall;
var
aFmtEtc : TFORMATETC;
aStgMed : TSTGMEDIUM;
szBuffer :
array[0..MAX_PATH]
of Char;
i, iCount : Integer;
begin
Form1.ListBox1.Items.Clear;
if (dataObj =
nil)
then
raise Exception.Create('
IDataObject-Zeiger ist ungültig!');
with aFmtEtc
do
begin
cfFormat := CF_HDROP;
ptd :=
nil;
dwAspect := DVASPECT_CONTENT;
lindex := -1;
tymed := TYMED_HGLOBAL;
end;
OleCheck(dataObj.GetData(aFmtEtc, aStgMed));
try
FillChar(szBuffer, SizeOf(szBuffer), #0);
iCount := DragQueryFile(aStgMed.hGlobal, $FFFFFFFF, @szBuffer, MAX_PATH);
for i := 0
to iCount - 1
do
begin
DragQueryFile(aStgMed.hGlobal, i, @szBuffer, MAX_PATH);
Form1.ListBox1.Items.Add(szBuffer);
end;
finally
ReleaseStgMedium(aStgMed);
end;
Result := S_OK;
end;
initialization
TComObjectFactory.Create(ComServer, Ttest1, Class_test1,
'
test1', '
test1', ciMultiInstance, tmApartment);
end.