SoftHub关联区 - [delphi]老代码维护 -- 复制文件到剪贴板[zt]

您的位置：首页 >> SoftHub关联区 >> 主题: [delphi]老代码维护 -- 复制文件到剪贴板[zt] [回主站] [分站链接]

您的位置：首页 >> SoftHub关联区 >> 主题: [delphi]老代码维护 -- 复制文件到剪贴板[zt] [最新] [回主站]

[delphi]老代码维护 -- 复制文件到剪贴板[zt]

clq

浏览(353) - 2019-12-28 18:02:00 发表编辑

关键字:

[2019-12-29 18:33:32 最后更新]
[delphi]老代码维护 -- 复制文件到剪贴板[zt]

没太仔细测试。win10 下至少可用。

http://www.delphitop.com/html/wenjian/2900.html
--------------------------------------------------------
将文件复制或剪切到剪贴板，可以在资源管理器、桌面等地方粘贴。在网上找了下，找到一些代码，不过发现都有点bug，现在将修正后的分享出来。

procedure CutOrCopyFiles(FileList: AnsiString; bCopy: Boolean);
type
PDropFiles = ^TDropFiles;

TDropFiles = record
pfiles: DWORD;
pt: TPoint;
fNC: BOOL;
fwide: BOOL;
end;
const
DROPEFFECT_COPY = 1;
DROPEFFECT_MOVE = 2;
var
hGblFileList: hGlobal;
pFileListDate: Pbyte;
HandleDropEffect: UINT;
hGblDropEffect: hGlobal;
pdwDropEffect: PDWORD;
iLen: Integer;
begin
iLen := Length(FileList) + 2;
FileList := FileList + #0#0;
hGblFileList := GlobalAlloc(GMEM_ZEROINIT or GMEM_MOVEABLE or GMEM_SHARE,
SizeOf(TDropFiles) + iLen);
pFileListDate := GlobalLock(hGblFileList);
PDropFiles(pFileListDate)^.pfiles := SizeOf(TDropFiles);
PDropFiles(pFileListDate)^.pt.Y := 0;
PDropFiles(pFileListDate)^.pt.X := 0;
PDropFiles(pFileListDate)^.fNC := False;
PDropFiles(pFileListDate)^.fwide := False;
Inc(pFileListDate, SizeOf(TDropFiles)); // Ö¸ÕëoóòÆ
CopyMemory(pFileListDate, @FileList[1], iLen);
GlobalUnlock(hGblFileList);
HandleDropEffect := RegisterClipboardFormat('Preferred DropEffect ');
hGblDropEffect := GlobalAlloc(GMEM_ZEROINIT or GMEM_MOVEABLE or GMEM_SHARE,
SizeOf(DWORD));
pdwDropEffect := GlobalLock(hGblDropEffect);
if (bCopy) then pdwDropEffect^ := DROPEFFECT_COPY
else pdwDropEffect^ := DROPEFFECT_MOVE;
GlobalUnlock(hGblDropEffect);
if OpenClipboard(0) then begin
EmptyClipboard();
SetClipboardData(HandleDropEffect, hGblDropEffect);
SetClipboardData(CF_HDROP, hGblFileList);
CloseClipboard();
end;
end;

procedure CopyFileClipbrd(const FName: string);
begin
CutOrCopyFiles(AnsiString(FName), True);
end;

clq 2019-12-29 18:33:32 发表编辑

另，可参考 https://www.debugease.com/delphi/3447140.html 不过其中代码未测试。
--------------------------------------------------

如何实现windows剪贴板的复制和粘贴
1.将一个或多个文件复制到粘贴板中
2.将剪贴板中的文件粘贴到指定位置
解决方案 »

http://topic.csdn.net/t/20060325/10/4639088.html

procedure SetFilesToClipboard(FileList: string);
var
DropFiles: PDropFiles;
hGlobal: THandle;
iLen: Integer;
begin
iLen := Length(FileList);
hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT,
SizeOf(TDropFiles) + iLen);
if hGlobal <> 0 then
begin
DropFiles := GlobalLock(hGlobal);
DropFiles^.pFiles := SizeOf(TDropFiles);
Move(FileList[1], (PChar(DropFiles) + SizeOf(TDropFiles))^, iLen);
GlobalUnlock(hGlobal);
Clipboard.Open;
try
Clipboard.Clear;
Clipboard.SetAsHandle(CF_HDROP, hGlobal);
finally
Clipboard.Close;
end;
end;
end;

type
PDropFiles = ^TDropFiles;
TDropFiles = record
pFiles: DWORD; { offset of file list }
pt: TPoint; { drop point (client coords) }
fNC: BOOL; { is it on NonClient area }{ and pt is in screen coords }
fWide: BOOL; { WIDE character switch }
end;

const
DROPEFFECT_COPY = 1;
DROPEFFECT_MOVE = 2;

procedure CutOrCopyFiles(pFileList: Pchar; ListStrLen: integer; bCopy: Boolean);
var
hGblFileList: HGLOBAL; // 内存块句柄
pFileListDate: Pbyte; // 内存块地址

HandleDropEffect: UINT; // 注册类型句柄
hGblDropEffect: HGLOBAL; // 内存块句柄
pdwDropEffect: PDWORD; // 操作类型标识
begin
hGblFileList := GlobalAlloc(GMEM_ZEROINIT or GMEM_MOVEABLE or GMEM_SHARE, ListStrLen+Sizeof(TDropFiles));
pFileListDate := GlobalLock(hGblFileList);
PDropFiles(pFileListDate)^.pFiles:=Sizeof(TDropFiles);
PDropFiles(pFileListDate)^.pt.Y:=0;
PDropFiles(pFileListDate)^.pt.X:=0;
PDropFiles(pFileListDate)^.fNC:=False;
PDropFiles(pFileListDate)^.fWide:=False;
inc(pFileListDate,Sizeof(TDropFiles)); //指针后移
CopyMemory(pFileListDate,pFileList,ListStrLen);
GlobalUnlock(hGblFileList);

HandleDropEffect := RegisterClipboardFormat('Preferred DropEffect');
hGblDropEffect := GlobalAlloc(GMEM_ZEROINIT or GMEM_MOVEABLE or GMEM_SHARE, sizeof(DWORD));
pdwDropEffect := GlobalLock(hGblDropEffect);
if(bCopy) then
pdwDropEffect^ := DROPEFFECT_COPY
else
pdwDropEffect^ := DROPEFFECT_MOVE;
GlobalUnlock(hGblDropEffect);

if OpenClipboard(0) then
begin
EmptyClipboard();
SetClipboardData(HandleDropEffect,hGblDropEffect);
SetClipboardData( CF_HDROP, hGblFileList );
CloseClipboard();
end
else
showmessage('无法打开,可能被别的程序占用');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
CutOrCopyFiles('c:\test\1.txt'+#0+'c:\test\2.txt'+#0,28,false);
end;

如何在程序中像delphi，支持复制粘贴组件功能

Delphi 剪贴板和动态数据交换http://www.3800hk.com/Article/cxsj/delphi/bcjqdp/2005-08-06/Article_23167.html

总数：1　页次：1/1　首页尾页　　

所在合集/目录

delphi老代码维护更多

发表评论:

本帖子属于以下条目()

NEWBT官方QQ群1: 276678893
可求档连环画,漫画;询问文本处理大师等软件使用技巧;求档softhub软件下载及使用技巧.
但不可"开车",严禁国家敏感话题,不可求档涉及版权的文档软件.
验证问题说明申请入群原因即可.