delphi - 如何在剪贴板上同时创建图片和 HTML 格式？

Question

我需要在剪贴板上一起创建以下格式:

CF_BITMAP
CF_DIB
CF_DIB5
HTML格式

这是一个控制台程序，可以创建图片格式或 HTML 格式，但不能同时在剪贴板上:

program CopyImageFromFile;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  Winapi.Windows,
  Vcl.Clipbrd,
  Vcl.ExtCtrls,
  Vcl.Imaging.pngimage,
  System.SysUtils;

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;

procedure CopyHTMLAndImageToClipBoard(const str, APngFile: AnsiString; const htmlStr: AnsiString = '');
var
  gMem: HGLOBAL;
  lp: PChar;
  Strings: array[0..1] of AnsiString;
  Formats: array[0..1] of UINT;
  i: Integer;

  ThisImage: TImage;
  MyFormat: Word;
  Bitmap: TBitMap;
  AData: THandle;
  APalette: HPALETTE;
begin
  gMem := 0;
  //{$IFNDEF USEVCLCLIPBOARD}
  //Win32Check(OpenClipBoard(0));
  //{$ENDIF}
  Clipboard.Open;
  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;

    ThisImage := TImage.Create(nil);
    try
      ThisImage.Picture.LoadFromFile(APngFile);
      // Comment this out to copy only the HTML Format:
      Clipboard.Assign(ThisImage.Picture);
      {MyFormat := CF_PICTURE;
      ThisImage.Picture.SaveToClipBoardFormat(MyFormat, AData, APalette);
      ClipBoard.SetAsHandle(MyFormat, AData);}
    finally
      ThisImage.Free;
    end;
  finally
    //{$IFNDEF USEVCLCLIPBOARD}
    //Win32Check(CloseClipBoard);
    //{$ENDIF}
    Clipboard.Close;
  end;
end;

var
  HTML: string;

begin
  try
    // Usage: CopyImageFromFile.exe test.png
    // test.png is 32 bit with alpha channel
    if ParamCount = 1 then
    begin
      if FileExists(ParamStr(1)) then
      begin
        if LowerCase(ExtractFileExt(ParamStr(1))) = '.png' then
        begin
          HTML := '<img border="0" src="file:///' + ParamStr(1) + '">';
          CopyHTMLAndImageToClipBoard('test', ParamStr(1), HTML);
        end;
      end;
    end;
  except
    on E: Exception do
    begin
      Writeln(E.ClassName, ': ', E.Message);
      Readln;
    end;
  end;

end.  

那么我怎样才能在剪贴板上同时创建所有这些格式呢？

Answer 1

TClipboard第一次使用 TClipboard 时清空剪贴板调用 TClipboard.Assign() 后将数据放入剪贴板的方法( TClipboard.SetBuffer() 、 TClipboard.SetAsHandle() 、 Open() 等) . TClipboard希望您仅使用它的方法来访问剪贴板，因此您使用 SetClpboardData()直接存储字符串数据绕过了 TClipboard的内部逻辑，因此您调用 Assign()被视为第一个剪贴板写入和 TClipboard删除您使用 SetClipboardData() 存储的所有数据.

为避免这种情况，您有几种选择:

1. Assign()你的图像首先到剪贴板，然后用 SetClipboardData() 保存你的字符串项目之后。

2. 不要使用 Assign()根本。使用 TPicture.SaveToClipboardFormat()直接调用SetClipboardData() .

3. 不要使用 SetClipboardData()直接除非 USEVCLCLIPBOARD没有定义。使用 TClipboard.SetAsHandle()相反。

我建议#3。让TClipboard做所有的工作:

var
  CF_HTML: UINT = 0;

// TClipboard.SetBuffer() allows a format and an arbitrary buffer
// to be specified and handles the global memory allocation.
// However, it is protected, so using an accessor class to reach it.
//
// TClipboard.AsText and TClipboard.SetTextBuf() always use
// CF_(UNICODE)TEXT, and TClipboard.SetAsHandle() requires manual
// allocation...
//
type
  TClipboardAccess = class(TClipboard)
  end;

procedure CopyHTMLAndImageToClipBoard(const str, APngFile: AnsiString; const htmlStr: AnsiString = '');
var
  TmpHtmlStr: AnsiString;
  ThisImage: TPicture;
begin
  Clipboard.Open;
  try
    //most descriptive first as per api docs

    TmpHtmlStr := FormatHTMLClipboardHeader(htmlStr);
    TClipboardAccess(Clipboard).SetBuffer(CF_HTML, PAnsiChar(TmpHtmlStr)^, Length(TmpHtmlStr) + 1);
    TClipboardAccess(Clipboard).SetBuffer(CF_TEXT, PAnsiChar(Str)^, Length(Str) + 1);

    ThisImage := TPicture.Create;
    try
      ThisImage.LoadFromFile(APngFile);
      Clipboard.Assign(ThisImage);
    finally
      ThisImage.Free;
    end;
  finally
    Clipboard.Close;
  end;
end;

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

如果真的需要支持{$IFNDEF USEVCLCLIPBOARD}那么你不能使用 TClipboard完全没有，例如:

var
  CF_HTML: UINT = 0;

{$IFDEF USEVCLCLIPBOARD}
// TClipboard.SetBuffer() allows a format and an arbitrary buffer
// to be specified and handles the global memory allocation.
// However, it is protected, so using an accessor class to reach it.
//
// TClipboard.AsText and TClipboard.SetTextBuf() always use
// CF_(UNICODE)TEXT, and TClipboard.SetAsHandle() requires manual
// allocation...
//
type
  TClipboardAccess = class(TClipboard)
  end;
{$ENDIF}

procedure CopyHTMLAndImageToClipBoard(const str, APngFile: AnsiString; const htmlStr: AnsiString = '');
var
  ThisImage: TPicture;
  {$IFNDEF USEVCLCLIPBOARD}
  ImgData: THandle;
  ImgFormat: Word;
  ImgPalette: HPALETTE;
  {$ENDIF}

  procedure SetAsText(Format: UINT; const S: AnsiString);
  {$IFNDEF USEVCLCLIPBOARD}
  var
    gMem: HGLOBAL;
    lp: PAnsiChar;
  {$ENDIF}
  begin
    {$IFDEF USEVCLCLIPBOARD}
    TClipboardAccess(Clipboard).SetBuffer(Format, PAnsiChar(S)^, Length(S) + 1);
    {$ELSE}
    //an extra "1" for the null terminator
    gMem := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE, Length(S) + 1);
    Win32Check(gmem <> 0);
    try
      {Succeeded, now read the stream contents into the memory the pointer points at}
      lp := GlobalLock(gMem);
      Win32Check(lp <> nil);
      try
        CopyMemory(lp, PAnsiChar(S), Length(S) + 1);
      finally
        GlobalUnlock(gMem);
      end;
    except
      GlobalFree(gMem);
      raise;
    end;
    SetClipboardData(Format, gMem);
    {$ENDIF}
  end;

begin
  {$IFDEF USEVCLCLIPBOARD}
  Clipboard.Open;
  {$ELSE}
  Win32Check(OpenClipBoard(0));
  {$ENDIF}
  try
    //most descriptive first as per api docs
    SetAsText(CF_HTML, FormatHTMLClipboardHeader(htmlStr));
    SetAsText(CF_TEXT, Str);

    ThisImage := TPicture.Create;
    try
      ThisImage.LoadFromFile(APngFile);

      {$IFDEF USEVCLCLIPBOARD}
      Clipboard.Assign(ThisImage);
      {$ELSE}
      ImgPalette := 0;
      ThisImage.SaveToClipboardFormat(ImgFormat, ImgData, ImgPalette);
      SetClipboardData(ImgFormat, ImgData);
      if ImgPalette <> 0 then
        SetClipboardData(CF_PALETTE, ImgPalette);
      {$ENDIF}
    finally
      ThisImage.Free;
    end;
  finally
    {$IFDEF USEVCLCLIPBOARD}
    Clipboard.Close;
    {$ELSE}
    Win32Check(CloseClipBoard);
    {$ENDIF}
  end;
end;

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