本文整理自网络，侵删。
如果用CF_TEXT格式将HTML格式的文本复制到剪贴簿，那么在Word等软件中粘贴得到的将是大量的HTML标签，而不是带格式的文本。因此，你需要在剪贴簿中注册“HTML格式”，并用该格式复制HTML文本到剪贴簿中。此外，你还要注意复制到HTML格式剪贴簿的文本的格式。
以下代码帮助你准备恰当的格式：
function SetHTMLFormat(HTMLStr: string): string;
const
CrLf = #13#10;
begin
Result := ’Version:0.9’ + CrLf;
Result := Result + ’StartHTML:-1’ + CrLf;
Result := Result + ’EndHTML:-1’ + CrLf;
Result := Result + ’StartFragment:000081’ + CrLf;
Result := Result + ’EndFragment:******’ + CrLf;
Result := Result + HTMLStr + CrLf;
Result := StringReplace(Result, ’******’,
Format(’%.6d’, [Length(Result)]), []);
end;
以下代码实现在剪贴簿中同时放入无格式文本和HTML格式文本：
procedure CopyToClipBoard(const str: string; const hStr: string = ’’);
var
gMem: HGLOBAL;
pStr: PChar;
Strings: array[0..1] of string;
Formats: array[0..1] of UINT;
i: Integer;
begin
gMem := 0;
Win32Check(OpenClipBoard(0));
try
Strings[0] := SetHTMLFormat(hStr);
Strings[1] := str;
Formats[0] := RegisterClipboardFormat(’HTML Format’);
Formats[1] := CF_TEXT;
Win32Check(EmptyClipBoard);
for i := 0 to High(Strings) do
begin
if Strings[i] = ’’ then Continue;
gMem := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE,
Length(Strings[i]) + 1);
try
Win32Check(gMem <> 0);
pStr := GlobalLock(gMem);
Win32Check(pStr <> nil);
CopyMemory(pStr, PChar(Strings[i]),
Length(Strings[i]) + 1);
finally
GlobalUnlock(gMem);
end;
Win32Check(gMem <> 0);
SetClipboardData(Formats[i], gMem);
Win32Check(gMem <> 0);
gMem := 0;
end;
finally
Win32Check(CloseClipBoard);
end;
end;
function SetHTMLFormat(HTMLStr: string): string;
const
CrLf = #13#10;
begin
Result := ’Version:0.9’ + CrLf;
Result := Result + ’StartHTML:-1’ + CrLf;
Result := Result + ’EndHTML:-1’ + CrLf;
Result := Result + ’StartFragment:000081’ + CrLf;
Result := Result + ’EndFragment:******’ + CrLf;
Result := Result + HTMLStr + CrLf;
Result := StringReplace(Result, ’******’,
Format(’%.6d’, [Length(Result)]), []);
end;
以下代码实现在剪贴簿中同时放入无格式文本和HTML格式文本：
procedure CopyToClipBoard(const str: string; const hStr: string = ’’);
var
gMem: HGLOBAL;
pStr: PChar;
Strings: array[0..1] of string;
Formats: array[0..1] of UINT;
i: Integer;
begin
gMem := 0;
Win32Check(OpenClipBoard(0));
try
Strings[0] := SetHTMLFormat(hStr);
Strings[1] := str;
Formats[0] := RegisterClipboardFormat(’HTML Format’);
Formats[1] := CF_TEXT;
Win32Check(EmptyClipBoard);
for i := 0 to High(Strings) do
begin
if Strings[i] = ’’ then Continue;
gMem := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE,
Length(Strings[i]) + 1);
try
Win32Check(gMem <> 0);
pStr := GlobalLock(gMem);
Win32Check(pStr <> nil);
CopyMemory(pStr, PChar(Strings[i]),
Length(Strings[i]) + 1);
finally
GlobalUnlock(gMem);
end;
Win32Check(gMem <> 0);
SetClipboardData(Formats[i], gMem);
Win32Check(gMem <> 0);
gMem := 0;
end;
finally
Win32Check(CloseClipBoard);
end;
end;
相关阅读 >>
Delphi 使用indy解决tidssliohandlersocketopenssl could not load ssl library错误
Delphi 以低用户权限启动一个进程.比如vista或者win7中的ie
Delphi 解决idtcpclient和idtcpserver通信中文乱码问题
Delphi中输入框不能输入初数字意外的字符串的函数（isnumeric）
Delphi -- gdi+ Delphi如何让 tgpimage 直接从流中加载图片
Delphi 简单的英文数字字符串加密解密函数（不支持中文）
Delphi strtodatetime 这个函数在win7下出错
更多相关阅读请进入《Delphi》频道 >>
