首页 > 代码库 > 一个能接受外部拖拽的控件(文字或文件)

一个能接受外部拖拽的控件(文字或文件)

2024-07-18 17:32:43   223人阅读

恩....也是这2天写的一个小东西的需求, 可以拖拽外部文本文件, 或者选择的一段文本到Memo里显示

查了一下资料, 主要从2个方面实现:

　　1.拖拽文件实现WM_DROPFILES就可以了

　　2.拖拽文本需要实现IDropTarget接口

 

针对这个功能, 重新封装了一个Memo出来:

  TDropMemo = class(TMemo, IUnknown, IDropTarget)  private    FDropAccept: Boolean;    FDTDropAccept: HResult;    FFE: TFormatEtc;    FRefCount: Integer;  protected    procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;    procedure SetDropAccept(const Value: Boolean);    {IUnknown}    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;    function _AddRef: Integer; stdcall;    function _Release: Integer; stdcall;    {IDropTarget}    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 DropAccept: Boolean read FDropAccept write SetDropAccept;    constructor Create(AOwner: TComponent); override;    destructor Destroy; override;  end;//--------------------------------------------------{ TDragMemo }constructor TDropMemo.Create(AOwner: TComponent);begin  inherited Create(AOwner);  FRefCount := 0;end;destructor TDropMemo.Destroy;begin  inherited;end;function TDropMemo.DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint;  var dwEffect: Integer): HResult;begin  Result := E_FAIL;  FDTDropAccept := E_FAIL;  if not FDropAccept then    Exit;  if not Assigned(dataObj) then    Exit;  with FFE do  begin{$IFDEF UNICODE}    cfFormat := CF_UNICODETEXT;{$ELSE}    cfFormat := CF_TEXT;{$ENDIF}    ptd := nil;    dwAspect := DVASPECT_CONTENT;    lindex := -1;    tymed := TYMED_HGLOBAL;  end;  FDTDropAccept := dataObj.QueryGetData(FFE);  Result := FDTDropAccept;  if not FAILED(Result) then    dwEffect := DROPEFFECT_COPY  else    dwEffect := DROPEFFECT_NONE;end;function TDropMemo.DragLeave: HResult;begin  Result := S_OK;end;function TDropMemo.DragOver(grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;begin  Result := S_OK;end;function TDropMemo.Drop(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint;  var dwEffect: Integer): HResult;var  nMedium: stgMedium;  nHData: HGLOBAL;begin  Result := E_FAIL;  if FAILED(FDTDropAccept) then    Exit;  Result := dataObj.GetData(FFE, nMedium);  nHData := HGLOBAL(GlobalLock(nMedium.hGlobal));  try    SendMessage(Handle, WM_SETTEXT, 0, nHData);  finally    GlobalUnlock(nHData);    GlobalFree(nHData);  end;end;function TDropMemo.QueryInterface(const IID: TGUID; out Obj): HResult;begin  if GetInterface(IID, Obj) then    Result := S_OK  else    Result := E_NOINTERFACE;end;procedure TDropMemo.SetDropAccept(const Value: Boolean);begin  FDropAccept := Value;  DragAcceptFiles(Handle, FDropAccept);  if FDropAccept then    RegisterDragDrop(Handle, Self)  else    RevokeDragDrop(Handle);end;procedure TDropMemo.WMDropFiles(var Msg: TWMDropFiles);var  nBuffer: array[0..255] of Char;  nCount: Integer;  nFile: string;begin  with Msg do  begin    nCount := DragQueryFile(Drop, $FFFFFFFF, nBuffer, 1);    if nCount = 0 then      Exit;    DragQueryFile(Drop, 0, nBuffer, SizeOf(nBuffer));    nFile := nBuffer;    DragFinish(Drop);  end;  Lines.LoadFromFile(nFile);end;function TDropMemo._AddRef: Integer;begin  Result := InterLockedDecrement(FRefCount);  if Result = 0 then    Destroy;end;function TDropMemo._Release: Integer;begin  Result := InterLockedIncrement(FRefCount);end;

 

使用的时候, 通过DropAccept属性控制是否开启过拽支持

 

这个只是支持拖拽到Memo内, 如果想实现拖拽Memo内容到外部, 还需要再实现IDropSource接口, 因为没需求就懒得做了, 哪位有空闲可以一起实现了

 

另外, 从网上找了一个别人封装的拖拽控件, 基本可以支持所有文本编辑控件:

  TDropText = class(TObject, IUnknown, IDropTarget)  private    FHandle: THandle;    FCanDrop: HResult;    FFE: TFormatEtc;    FRefCount: Integer;  protected    {IUnknown}    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;    function _AddRef: Integer; stdcall;    function _Release: Integer; stdcall;    {IDropTarget}    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    constructor Create(AHandle: THandle);    destructor Destroy; override;  end;//----------------------------------------function TDropText._AddRef: Integer;begin  Result := InterLockedDecrement(FRefCount);  if Result = 0 then    Destroy;end;function TDropText._Release: Integer;begin  Result := InterLockedIncrement(FRefCount);end;constructor TDropText.Create(AHandle: THandle);begin  FRefCount := 0;  FHandle := AHandle;  RegisterDragDrop(FHandle, Self);end;destructor TDropText.Destroy;begin  RevokeDragDrop(FHandle);  inherited;end;function TDropText.DragEnter(const dataObj: IDataObject;  grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;begin  Result := E_FAIL;  FCanDrop := E_FAIL;  if not Assigned(dataObj) then    Exit;  with FFE do  begin{$IFDEF UNICODE}    cfFormat := CF_UNICODETEXT;{$ELSE}    cfFormat := CF_TEXT;{$ENDIF}    ptd := nil;    dwAspect := DVASPECT_CONTENT;    lindex := -1;    tymed := TYMED_HGLOBAL;  end;  FCanDrop := dataObj.QueryGetData(FFE);  Result := FCanDrop;  if not FAILED(Result) then    dwEffect := DROPEFFECT_COPY  else    dwEffect := DROPEFFECT_NONE;end;function TDropText.DragLeave: HResult;begin  Result := S_OK;end;function TDropText.DragOver(grfKeyState: Integer; pt: TPoint;  var dwEffect: Integer): HResult;begin  Result := S_OK;end;function TDropText.Drop(const dataObj: IDataObject; grfKeyState: Integer;  pt: TPoint; var dwEffect: Integer): HResult;var  nMedium: stgMedium;  nHData: HGLOBAL;begin  Result := E_FAIL;  if FAILED(FCanDrop) then    Exit;  Result := dataObj.GetData(FFE, nMedium);  nHData := HGLOBAL(GlobalLock(nMedium.hGlobal));  try    SendMessage(FHandle, WM_SETTEXT, 0, nHData);  finally    GlobalUnlock(nHData);    GlobalFree(nHData);  end;end;function TDropText.QueryInterface(const IID: TGUID; out Obj): HResult;begin  if GetInterface(IID, Obj) then    Result := S_OK  else    Result := E_NOINTERFACE;end;

调用方式:

   FDragText:= TDropText.Create(Memo1.Handle);

这样就可以让任何拥有文字编辑功能的控件支持文字拖拽的效果了


联系
我们