哪位大虾能详细解释一下这段代码;

taxi 2000-09-28 08:47:00
这是拖放Url的代码interface

uses
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}';

implementation

uses 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.

...全文
92 1 打赏 收藏 转发到动态 举报
写回复
用AI写文章
1 条回复
切换为时间正序
请发表友善的回复…
发表回复
cjf 2000-09-28
  • 打赏
  • 举报
回复
就是建立一个可以接受拖放对象的控件,具体就是跟Windows的组件对象大交道。

5,388

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧