这是 DFW 上最早有关 Drag&Drop 的完整描述，也是我第一次看到 李颖 这个名字。今天
是 2003 年的 5 月，DFW 新建了一个 Keylife 的功能，几天前，我看到论坛上有关这个
Drag&Drop 的问题还有很多人在问,有趣的是,回答几乎都是：“用 Drag&Drop 控件包”！
于是想在自己的 Keylife 中写一篇这样的主题。写前，总想先看看 DFW 上有关这个主题
的提问和回答的质量，于是我就查到了这里(也有幸看到了李颖和他的帖子)。看完后，基
本已经打消了写这个主题的念头，DFW 什么都有，有控件包用，也不是什么坏事，想深入
了解的，查就是了，更何况最早的帖子是在 1999 年。
做为补充，我在这里写一点直接使用这个 IDropTarget 的代码，原理李颖已经说完了。
1.直接在类声明中声明(其实是继承) IDropTarget 接口，不需要使用代理。
type
TForm1 = class(TForm,IDropTarget) // Delphi 中，类不支持多重继承,但接口可以
private
// 实现 IDropTarget 接口需要实现的全部方法
// 标准的做法:使用别名，以免和 Delphi 自己的控件同名方法重名。
// 显然，不怕编译警告，可以忽略下面四个别名声明。
function IDropTarget.DragEnter=ADragEnter;
function IDropTarget.DragOver=ADragOver;
function IDropTarget.DragLeave=ADragLeave;
function IDropTarget.Drop=ADrop;
function ADragEnter(const dataObj:IDataObject; grfKeyState: Longint;
pt: TPoint; var dwEffect: Longint): HResult; stdcall;
function ADragOver(grfKeyState: Longint; pt: TPoint;
var dwEffect: Longint): HResult; stdcall;
function ADragLeave: HResult; stdcall;
function ADrop(const dataObj: IDataObject; grfKeyState: Longint;
pt: TPoint; var dwEffect: Longint): HResult; stdcall;
end;
2.在创建过程中绑定拖拉。
procedure TForm1.FormCreate(Sender: TObject);
begin
OleInitialize(nil); // 在调用前初始化 Ole 库
if RegisterDragDrop(Handle,Self) <> S_OK then // 注册成功了?
ShowMessage('拖放注册失败');
end;
3.在析构中解除绑定。
procedure TForm1.FormDestroy(Sender: TObject);
begin
RevokeDragDrop(Handle); // 终止拖拉授权
OleUninitialize;
end;
4.在 IDropTarget 接口的 Drop 方法中执行处理。
function TForm1.ADrop(const dataObj: IDataObject; grfKeyState: Integer;
pt: TPoint; var dwEffect: Integer): HResult;
var
EnumFormat:IEnumFormatEtc;
FormatEtc: TFormatEtc;
begin
DataObj.EnumFormatEtc(DATADIR_GET,EnumFormat); // 取得 IEnumFORMATETC 接口
while (EnumFormat.Next(1,FormatEtc, nil) <> S_FALSE) do // 枚举开始
begin
case FormatEtc.cfFormat of
CF_TEXT:GetText(DataObj,FormatEtc); // GetText(...) 是一个自己的处理函数
end;
end;
Result := S_OK;
end;
5.在 IDropTarget 接口的 DragOver 方法中定义光标样式。
function TForm1.ADragOver(grfKeyState: Integer; pt: TPoint;
var dwEffect: Integer): HResult;
begin
dwEffect := DROPEFFECT_COPY;
Result := S_OK;
end;
6.剩下的 2 个接口方法，可以直接返回 S_OK 。
7.一个处理函数的样式 —— GetText(...) 。
procedure TForm1.GetText(DataObj: IDataObject; FormatEtc: TFormatEtc);
var
p: pointer;
StgMed:TStgMedium;
begin
if (DataObj.QueryGetData(FormatEtc) = NOERROR) then
begin
DataObj.GetData(FormatEtc,StgMed); // 获取 stgMEDIUM 结构
p := GlobalLock(StgMed.hGlobal); // 获取内存首地址指针
ListBox1.Items.Add(string(p)); // 文本装入一个 ListBox 控件
GlobalFree(StgMed.hGlobal);
ReleaseStgMedium(StgMed);
end;
end;
以上这些希望能够作为补充。为希望真正了解“拖拉”实质而查找到这里的富翁提供一点帮助。
