主要还是使用了IDropTarget等接口; 例子如下: unit DragDrop;interfaceuses Windows, ActiveX, ComObj,Dialogs,Sysutils;type TDropEvent = procedure(Sender:TObject;Msg:Pchar)of object; TTMyDrop = class(TComObject, IDropTarget) private FOnDroped: TDropEvent; procedure SetOnDroped(const Value: TDropEvent); protected {Declare IDropTarget methods here} 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; public property OnDroped:TDropEvent read FOnDroped write SetOnDroped; end;const Class_TMyDrop: TGUID = '{846C94F8-7649-11D2-9836-0000E82EA1B1}';implementationuses ComServ,unit1;{ TTMyDrop }function TTMyDrop.DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; var enumFormatEtc: IEnumFormatEtc; f:TFORMATETC; count:Integer; Found:boolean; begin dataObj.EnumFormatEtc(DATADIR_GET,enumFormatEtc); Found:=false; while (enumFormatEtc.Next(1,f,@count)=S_OK)and (count>0) do begin if (f.cfFormat=CF_TEXT) then begin Found:=true; Break; end; end; if Found then Result:=S_OK else begin result:=E_INVALIDARG; dwEffect:=DROPEFFECT_NONE; end; end;function TTMyDrop.DragLeave: HResult; begin result := S_OK; end;function TTMyDrop.DragOver(grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; begin result := S_OK; end;function TTMyDrop.Drop(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult; var enumFormatEtc: IEnumFormatEtc; f:TFORMATETC; count:Integer; Found:boolean; medium: TStgMedium; begin dataObj.EnumFormatEtc(DATADIR_GET,enumFormatEtc); Found:=false; while (enumFormatEtc.Next(1,f,@count)=S_OK)and (count>0) do begin if (f.cfFormat=CF_TEXT) then begin Found:=true; Break; end; end; if not Found then begin result:=E_INVALIDARG; dwEffect:=DROPEFFECT_NONE; Exit; end; dataObj.GetData(f,medium); if medium.tymed =1 then begin if Assigned(fOnDroped) then begin fOnDroped(Self,PChar(GlobalLock(medium.hglobal))); GlobalUnLock(medium.hglobal); end; result := S_OK; end;end;procedure TTMyDrop.SetOnDroped(const Value: TDropEvent); begin FOnDroped := Value; end;initialization TComObjectFactory.Create(ComServer, TTMyDrop, Class_TMyDrop, 'TMyDrop', '', ciMultiInstance{, tmApartment}); end.在自己的程序中,在FormCreate的时候,加入: OleInitialize(NIL); dd := TTMyDrop.Create; dd.OnDroped:=DoDroped; res1 := CoLockObjectExternal(dd, true, false); res := RegisterDragDrop(Handle, IDropTarget(dd));其中,DoDroped在拖放发生时被调用: procedure TForm1.DoDroped(Sender: TObject; Msg: Pchar); begin ...//此处最好不要有太耗时的工作,因为被拖出的程序(比如说是浏览器) //要等待此事件结束 end;在FormDestroy时: RevokeDragDrop(Handle); OleUninitialize;
有这么麻烦吗?拖动一个Label到一个Edit上是很简单的啊:procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbLeft then (Sender as TLabel).BeginDrag(False); end;procedure TForm1.Edit1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin if Source is TLabel then Accept := True; end;procedure TForm1.Edit1DragDrop begin if (Sender is TEDit) and (Source is TLable) then //dddddddddddddd end;
例子如下:
unit DragDrop;interfaceuses
Windows, ActiveX, ComObj,Dialogs,Sysutils;type
TDropEvent = procedure(Sender:TObject;Msg:Pchar)of object;
TTMyDrop = class(TComObject, IDropTarget)
private
FOnDroped: TDropEvent;
procedure SetOnDroped(const Value: TDropEvent);
protected
{Declare IDropTarget methods here}
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;
public
property OnDroped:TDropEvent read FOnDroped write SetOnDroped;
end;const
Class_TMyDrop: TGUID = '{846C94F8-7649-11D2-9836-0000E82EA1B1}';implementationuses ComServ,unit1;{ TTMyDrop }function TTMyDrop.DragEnter(const dataObj: IDataObject;
grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;
var
enumFormatEtc: IEnumFormatEtc;
f:TFORMATETC;
count:Integer;
Found:boolean;
begin
dataObj.EnumFormatEtc(DATADIR_GET,enumFormatEtc);
Found:=false;
while (enumFormatEtc.Next(1,f,@count)=S_OK)and (count>0) do
begin
if (f.cfFormat=CF_TEXT) then
begin
Found:=true;
Break;
end;
end;
if Found then
Result:=S_OK
else
begin
result:=E_INVALIDARG;
dwEffect:=DROPEFFECT_NONE;
end;
end;function TTMyDrop.DragLeave: HResult;
begin
result := S_OK;
end;function TTMyDrop.DragOver(grfKeyState: Integer; pt: TPoint;
var dwEffect: Integer): HResult;
begin
result := S_OK;
end;function TTMyDrop.Drop(const dataObj: IDataObject; grfKeyState: Integer;
pt: TPoint; var dwEffect: Integer): HResult;
var
enumFormatEtc: IEnumFormatEtc;
f:TFORMATETC;
count:Integer;
Found:boolean;
medium: TStgMedium;
begin
dataObj.EnumFormatEtc(DATADIR_GET,enumFormatEtc);
Found:=false;
while (enumFormatEtc.Next(1,f,@count)=S_OK)and (count>0) do
begin
if (f.cfFormat=CF_TEXT) then
begin
Found:=true;
Break;
end;
end;
if not Found then
begin
result:=E_INVALIDARG;
dwEffect:=DROPEFFECT_NONE;
Exit;
end;
dataObj.GetData(f,medium);
if medium.tymed =1 then
begin
if Assigned(fOnDroped) then
begin
fOnDroped(Self,PChar(GlobalLock(medium.hglobal)));
GlobalUnLock(medium.hglobal);
end;
result := S_OK;
end;end;procedure TTMyDrop.SetOnDroped(const Value: TDropEvent);
begin
FOnDroped := Value;
end;initialization
TComObjectFactory.Create(ComServer, TTMyDrop, Class_TMyDrop,
'TMyDrop', '', ciMultiInstance{, tmApartment});
end.在自己的程序中,在FormCreate的时候,加入: OleInitialize(NIL);
dd := TTMyDrop.Create;
dd.OnDroped:=DoDroped;
res1 := CoLockObjectExternal(dd, true, false);
res := RegisterDragDrop(Handle, IDropTarget(dd));其中,DoDroped在拖放发生时被调用:
procedure TForm1.DoDroped(Sender: TObject; Msg: Pchar);
begin
...//此处最好不要有太耗时的工作,因为被拖出的程序(比如说是浏览器) //要等待此事件结束
end;在FormDestroy时:
RevokeDragDrop(Handle);
OleUninitialize;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
(Sender as TLabel).BeginDrag(False);
end;procedure TForm1.Edit1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
if Source is TLabel then
Accept := True;
end;procedure TForm1.Edit1DragDrop
begin
if (Sender is TEDit) and (Source is TLable) then
//dddddddddddddd
end;