首页 > 代码库 > 一个能接受外部拖拽的控件(文字或文件)
一个能接受外部拖拽的控件(文字或文件)
恩....也是这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);
这样就可以让任何拥有文字编辑功能的控件支持文字拖拽的效果了
声明:以上内容来自用户投稿及互联网公开渠道收集整理发布,本网站不拥有所有权,未作人工编辑处理,也不承担相关法律责任,若内容有误或涉及侵权可进行投诉: 投诉/举报 工作人员会在5个工作日内联系你,一经查实,本站将立刻删除涉嫌侵权内容。