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

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

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.

那么，如何在剪贴板上一起创建所有这些格式？

最佳答案

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

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


首先将图像Assign()保存到剪贴板，然后使用SetClipboardData()保存字符串项。
完全不要使用Assign()。直接使用TPicture.SaveToClipboardFormat()，然后调用SetClipboardData()。
除非未定义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');

关于delphi - 如何在剪贴板上一起创建图片和HTML格式？，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/22617990/