关于拖动复制粘贴的问题(100)

在windos中.如打开浏览器和excel,浏览器中选中的文本可以直接拖动复制到excel表格中.现在我做了一个程序,如何能够从本程序外的窗体中拖入文本粘到本程序的控件中. 如dbgrid单元格中.

利用剪贴板来操作。

unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;type TForm1 = class(TForm) Memo1: TMemo; procedure FormCreate(Sender: TObject); private { Private declarations } public procedure AppMessage(var Msg: TMsg; var Handled: Boolean); end;var Form1: TForm1;implementation{$R *.dfm}uses ShellAPI;{ TForm1 }procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);var DroppedFilename : string; FileIndex : integer; QtyDroppedFiles : integer; pDroppedFilename : array [0..MAX_PATH-1] of Char;begin if Msg.Message = WM_DROPFILES then //接受文件拖放 begin FileIndex := not 0;//not 0 不受integer字长的限制 $FFFFFFFF; QtyDroppedFiles := DragQueryFile(Msg.WParam, FileIndex, pDroppedFilename, MAX_PATH); if(QtyDroppedFiles=0)then exit; for FileIndex := 0 to (QtyDroppedFiles - 1) do if(DragQueryFile(Msg.WParam, FileIndex,pDroppedFilename, MAX_PATH)<=MAX_PATH)then begin DroppedFilename := StrPas(pDroppedFilename); if FileExists(DroppedFileName) then begin memo1.Lines.LoadFromFile(DroppedFileName); Break; end; end; Application.BringToFront; DragFinish(Msg.WParam); Handled := true; end;end;procedure TForm1.FormCreate(Sender: TObject);begin DragAcceptFiles(Handle,true); Application.OnMessage:=AppMessage;end;end.

好几天没来,谢谢.wangdonghai我先研究下

wangdonghai您好,根据您提供的这个方法可以将文件拖入,但不知如何才能将单独文本也拖入.就是比如打开一个网页,直接选中某些文字,也能直接拖入控件.

进程间通讯

参考http://www.fwvv.net/info/2006/02/04/20060204-44579.shtmlunit uDragUtils;interfaceuses Windows,ActiveX,Messages;type TMyDragText=class(TObject,IUnknown,IDropTarget) private FHandle:THandle; CanDrop:HResult; FE: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;implementation{ TMyDragText }function TMyDragText._AddRef: Integer;begin result:=InterLockedDecrement(FRefCount); if Result=0 then Destroy;end;function TMyDragText._Release: Integer;begin result:=InterLockedIncrement(FRefCount);end;constructor TMyDragText.Create(AHandle:THandle);begin FRefCount:=0; FHandle:=AHandle; RegisterDragDrop(FHandle,self);end;destructor TMyDragText.Destroy;begin RevokeDragDrop(FHandle); inherited;end;function TMyDragText.DragEnter(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;begin result:=E_FAIL; CanDrop:=E_FAIL; if Assigned(dataObj) then begin FE.cfFormat:=CF_TEXT; FE.ptd:=nil; FE.dwAspect:=DVASPECT_CONTENT; FE.lindex:=-1; FE.tymed:=TYMED_HGLOBAL; CanDrop:=dataObj.QueryGetData(FE); result:=CanDrop; if not FAILED(result) then dwEffect:=DROPEFFECT_COPY else dwEffect:=DROPEFFECT_NONE; end;end;function TMyDragText.DragLeave: HResult;begin result:=S_OK;end;function TMyDragText.DragOver(grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;begin result:=S_OK;end;function TMyDragText.Drop(const dataObj: IDataObject; grfKeyState: Integer; pt: TPoint; var dwEffect: Integer): HResult;var medium:stgMedium; hData:HGLOBAL;begin result:=E_FAIL; if not FAILED(CanDrop) then begin result:=dataObj.GetData(FE,medium); hData:=HGLOBAL(GlobalLock(medium.hGlobal)); SendMessage(FHandle,WM_SETTEXT,0,hData); GlobalUnlock(hData); GlobalFree(hData); end;end;function TMyDragText.QueryInterface(const IID: TGUID; out Obj): HResult;begin if GetInterface(IID,Obj) then result:=S_OK else result:=E_NOINTERFACE;end;end.unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,uDragUtils;type TForm1 = class(TForm) Memo1: TMemo; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private FDragText:TMyDragText; public { Public declarations } end;var Form1: TForm1;implementation{$R *.dfm}uses ActiveX;procedure TForm1.FormCreate(Sender: TObject);begin OleInitialize(nil); FDragText:=TMyDragText.Create(Memo1.Handle);end;procedure TForm1.FormDestroy(Sender: TObject);begin FDragText.Free; OleUninitialize;end;end.

代码已经调试通过,谢谢wangdonghai及原始文档作者.[]我回头再仔细研究下应该就行了.

接受答案了.