怎么实现把网页上的文字拖动到指定的文件里?!(象飓风浏览器的文本拖动功能!)
解决方案 »
- MonthCalendar控件中得“星期一”,如何显示为“一”???
- 怎样让DBGridEh的某一字段可以手动添加负数、正数和小数?(已困扰多日,知道的请指教,谢谢!急,急,急,在线等候!!!)
- 求助,如何用DELPHI做表格设计器!
- 怎么打印STRINGGRID中的内容??
- 这个commbox怎么实现
- 为何delphi5中database desktop工具中建数据库没有blob字段类型?
- 一个多月没有来这里,CSDN现在都变成什么样子了,都不认识了。(散分)
- 限制edit只能输入英文或数字
- 用哪个函数查找某个字段的值?
- 如何添加快捷方式到‘开始’按扭的边上?
- 如果加一个提示你任务完成的情况(共n天,已用m天,还剩l天)怎么样?
- ■■■要编写在英文的操作系统上使用的软件,使用什么字体最安全?■■■
我现在不会拖放网址,好像用扩展剪切板格式,知道的话发Mail给我,谢谢!
//-------------------------
unit Unit1;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ActiveX, StdCtrls, ComCtrls, ExtCtrls, ShellAPI;type
TForm1 = class(TForm, IDropTarget)
Image1: TImage;
Memo1: TMemo;
RichEdit1: TRichEdit;
ListBox1: TListBox;
Memo2: TMemo; //要允许窗口接受 drag drop,窗口要支持 IDropTarget 接口
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
procedure ListDragData(DragObj: IDataObject);
procedure HandleText(DragObj: IDataObject; etc: TFormatETC);
procedure HandleBMP(DragObj: IDataObject; etc: TFormatETC);
procedure HandleRTF(DragObj: IDataObject; etc: TFormatETC);
procedure HandleHTML(DragObj: IDataObject; etc: TFormatETC);
procedure HandleHDROP(DragObj: IDataObject; etc: TFormatETC); //File drop
procedure ClearOldInfo();
//procedure WMDropFiles(var Msg:TWMDropFiles);message WM_DROPFILES;
{ Private declarations }
public
////////////////
// IDropTarget
//////////////// //既然支持 IDropTarget 接口,那么必须实现其每个方法,这4个方法可以从 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 declarations }
end;var
Form1: TForm1;implementation uses ShlObj;{$R *.DFM}function TForm1.DragEnter(const dataObj: IDataObject; grfKeyState: Integer;
pt: TPoint; var dwEffect: Integer): HResult;
begin
dwEffect:= DROPEFFECT_COPY;
Result:= S_OK;
end;function TForm1.DragLeave: HResult;
begin
Result:= S_OK;
end;function TForm1.DragOver(grfKeyState: Integer; pt: TPoint;
var dwEffect: Integer): HResult;
begin
Result:= S_OK;
end;function TForm1.Drop(const dataObj: IDataObject; grfKeyState: Integer;
pt: TPoint; var dwEffect: Integer): HResult;
begin
ClearOldInfo();
ListDragData(DataObj);
Result:= S_OK;
end;procedure TForm1.FormCreate(Sender: TObject);
var
res : HRESULT;
begin
SetWindowPos(Handle, HWND_TOPMOST, 0, 0, WIDTH, HEIGHT, SW_SHOWNORMAL);
//DragAcceptFiles(Handle, true);
OleInitialize( nil ); //OLE drag drop 初始化 {Allow window to accept drop events}
res := RegisterDragDrop( Handle, Self ); //允许窗口接受 drag drop {Check if register was sucessfull}
if( Failed( res ) ) then //判断 drag drop 初始化是否成功
ShowMessage( 'RegisterDragDrop Failed' );
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
{Finished accepting drops}
RevokeDragDrop( Handle ); //窗口不允许 drag drop OleUninitialize; // 释放 OLE drag drop
end;procedure TForm1.HandleText(DragObj: IDataObject; etc: TFormatETC);
var
p : pointer;
stgm : TSTGMedium;
begin
//逻辑:先判断数drag drop 的据是否有效,如有效则将数据放在 TSTGMEDIUM 媒体上。
//然后锁定媒体、获得数据,最后解锁媒体、释放媒体。 //判断 drag drop 的数据是否有效
{Make certain the data rendering is available}
if(DragObj.QueryGetData(etc) = NOERROR) then
begin
//从剪切板获得用 FORMATETC 结构描述的数据并放入TSTGMEDIUM 结构(存储媒体)
DragObj.GetData(etc, stgm); //先锁定全局内存并获取指向数据的指针(P = 指向数据第一个字节地址)
p := GlobalLock(stgm.hGlobal); //获得数据并转化成文本
Memo1.Text := string(p); //解锁
GlobalFree(stgm.hGlobal); //释放内存
ReleaseStgMedium(stgm);
end;
end;
procedure TForm1.HandleBMP(DragObj: IDataObject; etc: TFormatETC);
var
stgm: TSTGMedium;
begin
if DragObj.QueryGetData(etc) <> NO_ERROR then
begin
DragObj.GetData(etc, stgm);
Image1.Picture.Bitmap.Handle:= stgm.hBitmap;
Image1.Refresh;
ReleaseSTGMedium(stgm);
end;
end;procedure TForm1.HandleHDROP(DragObj: IDataObject; etc: TFormatETC);
var
pdf : PDropFiles;
stgm : TSTGMEDIUM;
p: PWideChar;
sFileName: WideString;
N: integer;
begin
if DragObj.QueryGetData(etc) = NO_ERROR then
begin
sFileName:= '';
DragObj.GetData(etc, stgm);
pdf:= GlobalLock(stgm.hGlobal);
p:= Pointer(integer(Pointer(pdf)) + pdf.pFiles);
sFileName:= sFileName + P^;
repeat
Inc(P);
sFileName:= sFileName + P^;
until p^ = #0;
ListBox1.Items.Add(sFileName);
end;
end;
procedure TForm1.HandleHTML(DragObj: IDataObject; etc: TFormatETC);
var
stgm: TSTGMedium;
p: Pointer;
begin
if DragObj.QueryGetData(etc) <> NO_ERROR then
begin
DragObj.GetData(etc, stgm);
p:= GlobalLock(stgm.hGlobal);
RichEdit1.Text:= string(p);
GlobalFree(stgm.hGlobal);
ReleaseSTGMedium(stgm);
end;
end;procedure TForm1.HandleRTF(DragObj: IDataObject; etc: TFormatETC);
beginend;
//显示 drag drop 数据内容
procedure TForm1.ListDragData(DragObj: IDataObject);
var
efe: IEnumFormatETC;
fe: TFormatETC;
begin
//判断接口是否可用
if DragObj = nil then exit;
//获得 IEnumFormatETC 接口
DragObj.EnumFormatEtc(DATADIR_GET, efe);
//对剪切板的 IEnumFormatETC 接口进行遍历得到当前剪切板内所有数据格式
while efe.Next(1, fe, nil) <> S_FALSE do
begin
case fe.cfFormat of
CF_TEXT: HandleText(DragObj, fe);
CF_BITMAP: HandleBMP(DragObj, fe);
//CF_HTML: HandleHTML(DragObj, fe);
//CF_TIFF:
//不处理文件拖动,用其他方法处理。(WM_DropFiles)
CF_HDROP: HandleHDROP(DragObj, fe);
else Memo2.Lines.Add('other format!'); end;
end;
end;procedure TForm1.ClearOldInfo;
begin
Memo1.Lines.Clear;
RichEdit1.Lines.Clear;
ListBox1.Clear;
Image1.Picture.Bitmap:= nil;
Image1.Picture.Bitmap.FreeImage; Memo2.Lines.Clear;
end;end.
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;type
TForm1 = class(TForm)
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure WMDropFiles(var Message: TMessage); message WM_DropFiles;
end;var
Form1: TForm1;implementation{$R *.dfm}uses
ShellApi;procedure TForm1.WMDropFiles(var Message: TMessage);
var
Index, iFileCount: Integer;
sFileName: array[0..MAX_PATH] of Char;
begin
Index := -1;
iFileCount := DragQueryFile(Message.WParam, Index, nil, 0); for Index := 0 to iFileCount - 1 do
begin
DragQueryFile(Message.WParam, Index, sFileName, MAX_PATH);
ListBox1.Items.Add(sFileName);
end;
DragFinish(Message.WParam);
end;procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles(Handle, True);
end;end.