如何将一些格式化的文本放入剪贴板?

下面是一个如何以HTML格式复制到剪贴板的示例: http://www.swissdelphicenter.ch/torry/showcode.php?id=1391

我稍微修改了代码,以便它在Delphi2009中工作。

//  If you've ever tried sticking html into the clipboard using the usual CF_TEXT
//  format then you might have been disappointed to discover that wysiwyg html
//  editors paste your offering as if it were just text,
//  rather than recognising it as html. For that you need the CF_HTML format.
//  CF_HTML is entirely text format and uses the transformation format UTF-8.
//  It includes a description, a context, and within the context, the fragment.
//
//  As you may know one can place multiple items of data onto the clipboard for
//  a single clipboard entry, which means that the same data can be pasted in a
//  variety of different formats in order to cope with target
//  applications of varying sophistocation.
//
//  The following example shows how to stick CF_TEXT (and CF_HTML)
//  into the clipboard.

function FormatHTMLClipboardHeader(HTMLText: 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 + HTMLText + CrLf;
  Result := StringReplace(Result, '°°°°°°', Format('%.6d', [Length(Result)]), []);
end;

//The second parameter is optional and is put into the clipboard as CF_HTML.
//Function can be used standalone or in conjunction with the VCL clipboard so long as
//you use the USEVCLCLIPBOARD conditional define
//($define USEVCLCLIPBOARD}
//(and clipboard.open, clipboard.close).
//Code from http://www.lorriman.com
procedure CopyHTMLToClipBoard(const str: AnsiString; const htmlStr: AnsiString = '');
var
  gMem: HGLOBAL;
  lp: PChar;
  Strings: array[0..1] of AnsiString;
  Formats: array[0..1] of UINT;
  i: Integer;
begin
  gMem := 0;
  {$IFNDEF USEVCLCLIPBOARD}
  Win32Check(OpenClipBoard(0));
  {$ENDIF}
  try
    //most descriptive first as per api docs
    Strings[0] := FormatHTMLClipboardHeader(htmlStr);
    Strings[1] := str;
    Formats[0] := RegisterClipboardFormat('HTML Format');
    Formats[1] := CF_TEXT;
    {$IFNDEF USEVCLCLIPBOARD}
    Win32Check(EmptyClipBoard);
    {$ENDIF}
    for i := 0 to High(Strings) do
    begin
      if Strings[i] = '' then Continue;
      //an extra "1" for the null terminator
      gMem := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE, Length(Strings[i]) + 1);
      {Succeeded, now read the stream contents into the memory the pointer points at}
      try
        Win32Check(gmem <> 0);
        lp := GlobalLock(gMem);
        Win32Check(lp <> nil);
        CopyMemory(lp, 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
    {$IFNDEF USEVCLCLIPBOARD}
    Win32Check(CloseClipBoard);
    {$ENDIF}
  end;
end;

// Example:

procedure TForm1.Button1Click(Sender: TObject);
begin
  CopyHTMLToClipBoard('Hello world', 'Hello <b>world</b>');
end;

如果将其粘贴到MS Word中,您将看到:

你好 世界

在 DSiWin32 我们有:

var
  GCF_HTML: UINT;

{:Checks if HTML format is stored on the clipboard.
  @since   2008-04-29
  @author  gabr
}
function DSiIsHtmlFormatOnClipboard: boolean;
begin
  Result := IsClipboardFormatAvailable(GCF_HTML);
end; { DSiIsHtmlFormatOnClipboard }

{:Retrieves HTML format from the clipboard. If there is no HTML format on the clipboard,
  function returns empty string.
  @since   2008-04-29
  @author  MP002, gabr
}
function DSiGetHtmlFormatFromClipboard: string;
var
  hClipData       : THandle;
  idxEndFragment  : integer;
  idxStartFragment: integer;
  pClipData       : PChar;
begin
  Result := '';
  if DSiIsHtmlFormatOnClipboard then begin
    Win32Check(OpenClipboard(0));
    try
      hClipData := GetClipboardData(GCF_HTML);
      if hClipData <> 0 then begin
        pClipData := GlobalLock(hClipData);
        Win32Check(assigned(pClipData));
        try
          idxStartFragment := Pos('<!--StartFragment-->', pClipData); // len = 20
          idxEndFragment := Pos('<!--EndFragment-->', pClipData);
          if (idxStartFragment >= 0) and (idxEndFragment >= idxStartFragment) then
            Result := Copy(pClipData, idxStartFragment + 20, idxEndFragment - idxStartFragment - 20);
        finally GlobalUnlock(hClipData); end;
      end;
    finally Win32Check(CloseClipboard); end;
  end;
end; { DSiGetHtmlFormatFromClipboard }

{:Copies HTML (and, optionally, text) format to the clipboard.
  @since   2008-04-29
  @author  MP002, gabr
}
procedure DSiCopyHtmlFormatToClipboard(const sHtml, sText: string);

  function MakeFragment(const sHtml: string): string;
  const
    CVersion       = 'Version:1.0'#13#10;
    CStartHTML     = 'StartHTML:';
    CEndHTML       = 'EndHTML:';
    CStartFragment = 'StartFragment:';
    CEndFragment   = 'EndFragment:';
    CHTMLIntro     = '<sHtml><head><title>HTML clipboard</title></head><body><!--StartFragment-->';
    CHTMLExtro     = '<!--EndFragment--></body></sHtml>';
    CNumberLengthAndCR = 10;
    CDescriptionLength = // Let the compiler determine the description length.
      Length(CVersion) + Length(CStartHTML) + Length(CEndHTML) +
      Length(CStartFragment) + Length(CEndFragment) + 4*CNumberLengthAndCR;
  var
    description     : string;
    idxEndFragment  : integer;
    idxEndHtml      : integer;
    idxStartFragment: integer;
    idxStartHtml    : integer;
  begin
    // The sHtml clipboard format is defined by using byte positions in the entire block
    // where sHtml text and fragments start and end. These positions are written in a
    // description. Unfortunately the positions depend on the length of the description
    // but the description may change with varying positions. To solve this dilemma the
    // offsets are converted into fixed length strings which makes it possible to know
    // the description length in advance.
    idxStartHtml := CDescriptionLength;              // position 0 after the description
    idxStartFragment := idxStartHtml + Length(CHTMLIntro);
    idxEndFragment := idxStartFragment + Length(sHtml);
    idxEndHtml := idxEndFragment + Length(CHTMLExtro);
    description := CVersion +
      SysUtils.Format('%s%.8d', [CStartHTML, idxStartHtml]) + #13#10 +
      SysUtils.Format('%s%.8d', [CEndHTML, idxEndHtml]) + #13#10 +
      SysUtils.Format('%s%.8d', [CStartFragment, idxStartFragment]) + #13#10 +
      SysUtils.Format('%s%.8d', [CEndFragment, idxEndFragment]) + #13#10;
    Result := description + CHTMLIntro + sHtml + CHTMLExtro;
  end; { MakeFragment }

var
  clipFormats: array[0..1] of UINT;
  clipStrings: array[0..1] of string;
  hClipData  : HGLOBAL;
  iFormats   : integer;
  pClipData  : PChar;

begin { DSiCopyHtmlFormatToClipboard }
  Win32Check(OpenClipBoard(0));
  try
    //most descriptive first as per api docs
    clipStrings[0] := MakeFragment(sHtml);
    if sText = '' then
      clipStrings[1] := sHtml
    else
      clipStrings[1] := sText;
    clipFormats[0] := GCF_HTML;
    clipFormats[1] := CF_TEXT;
    Win32Check(EmptyClipBoard);
    for iFormats := 0 to High(clipStrings) do begin
      if clipStrings[iFormats] = '' then
        continue;
      hClipData := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE, Length(clipStrings[iFormats]) + 1);
      Win32Check(hClipData <> 0);
      try
        pClipData := GlobalLock(hClipData);
        Win32Check(assigned(pClipData));
        try
          Move(PChar(clipStrings[iFormats])^, pClipData^, Length(clipStrings[iFormats]) + 1);
        finally GlobalUnlock(hClipData); end;
        Win32Check(SetClipboardData(clipFormats[iFormats], hClipData) <> 0);
        hClipData := 0;
      finally
        if hClipData <> 0 then
          GlobalFree(hClipData);
      end;
    end;
  finally Win32Check(CloseClipboard); end;
end; { DSiCopyHtmlFormatToClipboard }

initialization
  GCF_HTML := RegisterClipboardFormat('HTML Format');

编辑: @Edelcom:在Delphi 7中,DSIwin32应定义

  _STARTUPINFOW = record
    cb: DWORD;
    lpReserved: PWideChar;
    lpDesktop: PWideChar;
    lpTitle: PWideChar;
    dwX: DWORD;
    dwY: DWORD;
    dwXSize: DWORD;
    dwYSize: DWORD;
    dwXCountChars: DWORD;
    dwYCountChars: DWORD;
    dwFillAttribute: DWORD;
    dwFlags: DWORD;
    wShowWindow: Word;
    cbReserved2: Word;
    lpReserved2: PByte;
    hStdInput: THandle;
    hStdOutput: THandle;
    hStdError: THandle;
  end;
  TStartupInfoW = _STARTUPINFOW;
  PStartupInfoW = ^TStartupInfoW;

我会把这个放进去并发布新版本。

wouter的回答很好,但不处理unicode字符。我修改了示例代码以使用Unicode(HTML和文本数据)。还修复了内存泄漏。

function FormatHTMLClipboardHeader(HTMLText: UTF8String): UTF8String;
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 + HTMLText + CrLf;
  Result := UTF8String( StringReplace( string(Result), '°°°°°°', Format('%.6d', [Length(Result)]), []) );
end;


//The second parameter is optional and is put into the clipboard as CF_HTML.
procedure CopyHTMLToClipBoard(const str: String; const htmlStr: String = '');
var
  gMem    : HGLOBAL;
  lp      : Pointer;
  HString : UTF8String;
begin
  {$WARN SYMBOL_PLATFORM OFF}
  Win32Check(OpenClipBoard(0));

  try
    Win32Check(EmptyClipBoard);

    if ( htmlStr <> '' ) then
    begin
      // convert to utf8 and add header, which windows html clipboard format requires
      HString := FormatHTMLClipboardHeader( UTF8String( htmlStr ) );

      //an extra "1" for the null terminator
      gMem := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE, Length(HString) + 1);
      {Succeeded, now read the stream contents into the memory the pointer points at}
      try
        Win32Check(gmem <> 0);
        lp := GlobalLock(gMem);
        Win32Check(lp <> nil);
        CopyMemory(lp, Pointer( HString ), Length( HString ) + 1);
        Win32Check(gmem <> 0);
        SetClipboardData( RegisterClipboardFormat( 'HTML Format' ), gMem);
        Win32Check(gmem <> 0);
      finally
        GlobalUnlock(gMem);
        GlobalFree(gMem);
      end;
    end;

    // Now just place plain unicode text, double buffer size as it's utf16
    gMem := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE, ( Length(str) + 1 ) * 2);
    {Succeeded, now read the stream contents into the memory the pointer points at}
    try
      Win32Check(gmem <> 0);
      lp := GlobalLock(gMem);
      Win32Check(lp <> nil);
      CopyMemory(lp, Pointer( str ), ( Length( str ) + 1 ) * 2);
      Win32Check(gmem <> 0);
      SetClipboardData( CF_UNICODETEXT, gMem);
      Win32Check(gmem <> 0);
    finally
      GlobalUnlock(gMem);
      GlobalFree(gMem);
    end;

  finally
    Win32Check(CloseClipBoard);
  end;
  {$WARN SYMBOL_PLATFORM ON}
end;