如何在 Firemonkey 中将 HTML 格式的文本 As HTML 复制到剪贴板

How to copy HTML Formatted text As HTML to ClipBoard in Firemonkey

使用 Delphi FireMonkey,我需要将 HTML 格式的字符串复制到 Delphi 中的剪贴板,以便粘贴它的其他应用程序将其视为 HTML。

我已经尝试通过隐藏的备忘录组件复制简单文本并且它有效但被复制为简单文本。我需要 HTML 格式的副本。将其作为文本,在任何富文本程序中粘贴时,它会显示所有 HTML 标签而不是格式化文本。

我目前将文本复制到剪贴板的方法是:

procedure TForm1.Button1Click(Sender: TObject);
var
  SourceText: string;
begin
  SourceText := 'This is a <b>bold</b> html line';
  //I can use TMemo to copy it to clipboard like:
  Memo1.lines.Text := SourceText;
  Memo1.SelectAll;
  memo1.CopyToClipboard;
end;

但问题是,如果我将复制到剪贴板上的文本粘贴到 Microsoft word 中,它将被粘贴为:

注意: 我已经阅读了其他关于如何在 windows 中完成的讨论,但我需要一个跨平台应用程序的 Firemonkey 解决方案。感谢任何帮助。

使用FireMonkey以跨平台方式将数据复制到剪贴板是通过调用平台服务获得的接口IFMXExtendedClipboardService完成的:

var
    Svc      : IFMXExtendedClipboardService;
begin
    if not TPlatformServices.Current.SupportsPlatformService(IFMXExtendedClipboardService, Svc) then 
        Exit;  // Not clipboard supported
    // Code using the interface

此接口有copy/gettext/imagesto/from剪贴板的方法:SetTextGetTextSetImageGetImage .

对于其他类型的数据,用户必须注册数据格式,然后write/read数据to/from剪贴板:RegisterCustomFormatIsCustomFormatRegisteredUnregisterCustomFormat , HasCustomFormat, GetCustomFormat, SetCustomFormat.

在您的问题中,您说要将 HTML 格式的数据复制到剪贴板。这可以转换为注册 HTML 格式,使用您的数据创建流并调用 SetCustomFormat 传递格式和流。

可以使用任何格式并使用上述接口方法传输to/from剪贴板。下面的代码获取流 stream 并使用 ClipFormat:

将其内容复制到剪贴板
if TPlatformServices.Current.SupportsPlatformService(
                IFMXExtendedClipboardService, Svc) then begin
    if not Svc.IsCustomFormatRegistered(ClipFormat) then
        Svc.RegisterCustomFormat(ClipFormat);
    Svc.SetCustomFormat(ClipFormat, Stream);
end;

格式只能注册一次,因此调用 IsCustomFormatRegistered 以防止多次调用 RegisterCustomFormat

格式的名称是一个简单的字符串,可以是任何内容。复制和粘贴应用程序必须同意格式名称和数据格式(数据在流中的写入方式)。

编写 HTML 格式的数据可能会因为样式问题而变得困难。由于样式的原因,仅获取完整 HTML 文档的简单副本可能无法正确呈现它。

如果您通过剪贴板在两个应用程序之间传输数据,您可以为所欲为。但是在您的应用程序和另一个应用程序(您在问题中提到了 Microsoft Word)之间传输数据要困难得多。

在 Microsoft 产品和 Windows 平台上的所有其他产品中,剪贴板中的 HTML 格式描述为 here

您在问题中给出的示例格式正确后如下所示:

Version:0.9
StartHTML:00000144
EndHTML:00000218
StartFragment:00000167
EndFragment:00000205
StartSelection:00000167
EndSelection:00000205
<!DOCTYPE><HTML><BODY><P>This is a <b>bold</b> html line</P></BODY></HTML>

实际字符串如上,每行末尾有一个CRLF。格式名称是“HTML格式”。

你看到句子 This is a <b>bold</b> html line 必须被 HTML 标签包围才能形成有效的完整 HTML 文档,并且前面有一个由数字组成的 header keyword:value 对。如果字符串,则这些值是偏移的。关键字是非常自我解释的。该字符串是 UTF8,如果您使用 HTML 实体来表示特殊字符,可以将其简化为 ANSI。

我写了一个函数来构建整个字符串:

function FormatHtmlForClipboard(const HtmlSrc : UTF8String) : UTF8String;
const
    Header = 'Version:0.9'             + #13#10 +
             'StartHTML:00000000'      + #13#10 +
             'EndHTML:00000000'        + #13#10 +
             'StartFragment:00000000'  + #13#10 +
             'EndFragment:00000000'    + #13#10 +
             'StartSelection:00000000' + #13#10 +
             'EndSelection:00000000'   + #13#10;
var
    BodyStart : Integer;
    BodyEnd   : Integer;
    HdrLen    : Integer;
begin
    Result := Header;
    BodyStart := Pos('<BODY>', String(HtmlSrc));
    if BodyStart <= 0 then
        raise Exception.Create('<BODY> tag not found');
    Inc(BodyStart, 6);
    BodyEnd := Pos('</BODY>', String(HtmlSrc));
    if BodyEnd <= 0 then
        raise Exception.Create('</BODY> tag not found');

    HdrLen := Length(Header) - 1;
    WriteNumberIntoString(HdrLen,                   'StartHTML:',      Result);
    WriteNumberIntoString(HdrLen + Length(HtmlSrc), 'EndHTML:',        Result);
    WriteNumberIntoString(HdrLen + BodyStart,       'StartFragment:',  Result);
    WriteNumberIntoString(HdrLen + BodyEnd,         'EndFragment:',    Result);
    WriteNumberIntoString(HdrLen + BodyStart,       'StartSelection:', Result);
    WriteNumberIntoString(HdrLen + BodyEnd,         'EndSelection:',   Result);
    Result := Result + HtmlSrc;
end;

procedure WriteNumberIntoString(
    N        : Integer;
    const At : UTF8String;
    var S    : UTF8String);
var
    I : Integer;
    V : UTF8String;
begin
    I := Pos(At, S);
    if I <= 0 then
        Exit;
    I := I + Length(At);
    V := UTF8String(Format('%08.8d', [N]));
    Move(V[1], S[I], Length(V));
end;

综上所述,将 HTML 格式的数据复制到剪贴板的函数如下所示:

procedure CopyHtmlToClipboard(const HtmlSrc : UTF8String);
var
    Svc      : IFMXExtendedClipboardService;
    Stream   : TStringStream;
    HtmlData : UTF8String;
const
    ClipFormat = 'HTML format';   // This is what Windows expect
                                  // Maybe other platform want something else
begin
    HtmlData := FormatHtmlForClipboard(HtmlSrc);
    Stream   := TStringStream.Create(HtmlData);
    if TPlatformServices.Current.SupportsPlatformService(
                    IFMXExtendedClipboardService, Svc) then begin
        if not Svc.IsCustomFormatRegistered(ClipFormat) then
            Svc.RegisterCustomFormat(ClipFormat);
        Svc.SetCustomFormat(ClipFormat, Stream);
    end;
end;

你应该像这样使用函数:

procedure TForm1.Button1Click(Sender: TObject);
begin
    CopyHtmlToClipboard(
        '<!DOCTYPE><HTML><BODY><P>' +
        'This is a <b>bold</b> html line' +    //<== Your actual HTML text
        '</P></BODY></HTML>');
end;