delphi - 如何从剪贴板保存 PngImage

Question

如何将 pngimage 保存到从 Adob​​eFirewoks（剪贴板）或 Photoshop 复制的文件中而不会丢失透明度。

我正在使用delphi2009。

先感谢您。

@TLama 我尝试了这段代码，但没有透明度。我也不知道我做得对不对。

  png := TPngimage.Create;
  try
    png.LoadFromClipboardFormat(CF_BITMAP,
      Clipboard.GetAsHandle(CF_BITMAP), CF_BITMAP);
    image1.Picture.Assign(png);
  finally
    png.Free;
  end;

Answer 1

Photoshop 的剪贴板格式很糟糕。包含存储在剪贴板中的 alpha 通道的唯一非常有效的数据是......猜猜？...指向Alpha通道内存的指针到“Photoshop粘贴到位”块中......太可怕了。如果您复制某些内容然后重新启动 Photoshop，则 alpha 将...丢失 :)

但是，您可以轻松了解剪贴板是否包含 Photoshop 图像。

询问剪贴板它有哪些块。

如果剪贴板有两个块，分别名为“Photoshop Paste In Place”和 “Object Descriptor”，您可以 99.9% 确定Photoshop正在系统上运行并且剪贴板包含对 Photoshop 数据的引用。（当 Photoshop 退出时，对象描述符块会从剪贴板中删除，因此 alpha 将永远丢失）

那么，你有两个选择：

选择 1（不推荐）：打开 Photoshop 的进程内存并从指针中读取原始 32 位图像数据……这总体上是愚蠢的，而且不安全，或者

选择 2（推荐）：使用 COM从 Photoshop 中提取图像数据。当然，COM 方法是最好的方法。让您的程序生成并运行以下VBS脚本：

On Error Resume Next
Set Ps = CreateObject("Photoshop.Application")
Set Shell = CreateObject("WScript.Shell")
Set FileSystem = CreateObject("Scripting.FileSystemObject") 

Dim PNGFileName
PNGFileName = Shell.CurrentDirectory & "\psClipboard.png"

If FileSystem.FileExists(PNGFileName) Then 
    FileSystem.DeleteFile PNGFileName
End If

Set Doc = Ps.Documents.Add(1,1,72,"psClipboard",,3)

Doc.Paste()
Doc.RevealAll()

If Err.Number = 0 Then 
    set PNGSaveOptions = CreateObject("Photoshop.PNGSaveOptions")
    doc.saveAs PNGFileName, PNGSaveOptions
End If

doc.Close()

在脚本的 CurrentDirectory 中，将生成一个名为“ psClipboard.png ”的文件。使用 libPng 或其他方式在程序中读取此文件，并将其视为来自剪贴板。该脚本将删除psClipboard.png，然后向 Photoshop 索要它。如果粘贴返回错误，脚本将停止并且不会生成文件，在这种情况下，剪贴板不包含有效的 Photoshop 参考数据。

Answer 2

根据我的同事使用以下测试代码确认的具有 Adob​​e Photoshop CS 6 13.0 x32 的经验结果，指出无法从 Adob​​e Photoshop 复制的剪贴板中保存图像而不会丢失透明度，因为它不复制 alpha 通道数据。

Adobe Photoshop（至少在上述版本中）使用 24 位像素格式进行剪贴板图像数据传输。而且，因为它是 24 位位图，所以不能有 Alpha 通道。不知道有谁要验证 Adob​​e Fireworks，但可以肯定的是，他们使用自己注册的剪贴板格式在其产品之间传输图像，包括 alpha 通道。

Adobe Photoshop 剪贴板使用的CF_BITMAPorCF_DIB格式据说支持 alpha 通道，正如一些人所说（我没有尝试过），但这仅适用于 32 位像素格式，不适用于 24 位像素格式。唯一肯定支持透明度的剪贴板格式是，CF_DIBV5但与其他格式一样，图像必须以 32 位像素格式存储以保留 alpha 通道：

以下代码显示了有关当前复制的剪贴板内容的信息：

uses
  ActiveX;

function GetClipboardFormatString(Format: Word): string;
var
  S: string;
begin
  case Format of
    1: S := 'CF_TEXT';
    2: S := 'CF_BITMAP';
    3: S := 'CF_METAFILEPICT';
    4: S := 'CF_SYLK';
    5: S := 'CF_DIF';
    6: S := 'CF_TIFF';
    7: S := 'CF_OEMTEXT';
    8: S := 'CF_DIB';
    9: S := 'CF_PALETTE';
    10: S := 'CF_PENDATA';
    11: S := 'CF_RIFF';        
    12: S := 'CF_WAVE';
    13: S := 'CF_UNICODETEXT';
    14: S := 'CF_ENHMETAFILE';
    15: S := 'CF_HDROP';
    16: S := 'CF_LOCALE';
    17: S := 'CF_DIBV5';
    $0080: S := 'CF_OWNERDISPLAY';
    $0081: S := 'CF_DSPTEXT';
    $0082: S := 'CF_DSPBITMAP';
    $0083: S := 'CF_DSPMETAFILEPICT';
    $008E: S := 'CF_DSPENHMETAFILE';
    $0200: S := 'CF_PRIVATEFIRST';
    $02FF: S := 'CF_PRIVATELAST';    
    $0300: S := 'CF_GDIOBJFIRST';
    $03FF: S := 'CF_GDIOBJLAST';
  else
    begin      
      SetLength(S, 255);
      SetLength(S, GetClipboardFormatName(Format, PChar(S), 255));      
      if Length(S) = 0 then
        S := 'Unknown, unregistered clipboard format';
      Result := S + ' (' + IntToStr(Format) + ')';
      Exit;
    end;
  end; 
  Result := 'Standard clipboard format (' + S + ')';
end;

function GetClipboardFormats: string;
var
  S: string;
  FormatEtc: TFormatEtc;
  DataObject: IDataObject;
  EnumFormatEtc: IEnumFormatEtc;
begin
  Result := '';
  if Succeeded(OleGetClipboard(DataObject)) then
  begin
    if Succeeded(DataObject.EnumFormatEtc(DATADIR_GET, EnumFormatEtc)) then
    begin
      S := DupeString('-', 65) + sLineBreak +
        'Clipboard data formats: ' + sLineBreak +
        DupeString('-', 65) + sLineBreak;
      while EnumFormatEtc.Next(1, FormatEtc, nil) = S_OK do
        S := S + GetClipboardFormatString(FormatEtc.cfFormat) + sLineBreak;
      Result := S;
    end;
  end;
end;

function GetClipboardInfoDIB: string;
var
  S: string;
  ClipboardData: HGLOBAL;
  BitmapInfoHeader: PBitmapInfoHeader;
const
  BI_JPEG = 4;
  BI_PNG = 5;
begin
  Result := '';
  if OpenClipboard(0) then
  try
    ClipboardData := GetClipboardData(CF_DIB);
    if ClipboardData <> 0 then
    begin
      BitmapInfoHeader := GlobalLock(ClipboardData);
      if Assigned(BitmapInfoHeader) then
      try
        S := DupeString('-', 65) + sLineBreak +
          'Clipboard data of CF_DIB format: ' + sLineBreak +
          DupeString('-', 65) + sLineBreak +
          'Width: ' + IntToStr(BitmapInfoHeader.biWidth) + ' px' + sLineBreak +
          'Height: ' + IntToStr(BitmapInfoHeader.biHeight) + ' px' + sLineBreak +
          'Bit depth: ' + IntToStr(BitmapInfoHeader.biBitCount) + ' bpp' + sLineBreak +
          'Compression format: ';
        case BitmapInfoHeader.biCompression of
          BI_RGB:   S := S + 'Uncompressed format (BI_RGB)';
          BI_RLE8: S := S + 'RLE format for bitmaps with 8 bpp (BI_RLE8)';
          BI_RLE4: S := S + 'RLE format for bitmaps with 4 bpp (BI_RLE4)';
          BI_BITFIELDS: S := S + 'Not compressed with color masks (BI_BITFIELDS)';
          BI_JPEG: S := S + 'Compressed using JPEG file format (BI_JPEG)';
          BI_PNG:   S := S + 'Compressed using PNG file format (BI_PNG)';
        end;
        S := S + sLineBreak;
        Result := S;
      finally
        GlobalUnlock(ClipboardData);
      end;      
    end;
  finally
    CloseClipboard;
  end;
end;

function GetClipboardInfoDIBV5: string;
var
  S: string;
  ClipboardData: HGLOBAL;
  BitmapInfoHeader: PBitmapV5Header;
const
  BI_JPEG = 4;
  BI_PNG = 5;
begin
  Result := '';
  if OpenClipboard(0) then
  try
    ClipboardData := GetClipboardData(CF_DIBV5);
    if ClipboardData <> 0 then
    begin
      BitmapInfoHeader := GlobalLock(ClipboardData);
      if Assigned(BitmapInfoHeader) then
      try
        S := DupeString('-', 65) + sLineBreak +
          'Clipboard data of CF_DIBV5 format: ' + sLineBreak +
          DupeString('-', 65) + sLineBreak +
          'Width: ' + IntToStr(BitmapInfoHeader.bV5Width) + ' px' + sLineBreak +
          'Height: ' + IntToStr(BitmapInfoHeader.bV5Height) + ' px' + sLineBreak +
          'Bit depth: ' + IntToStr(BitmapInfoHeader.bV5BitCount) + ' bpp' + sLineBreak +
          'Compression format: ';
        case BitmapInfoHeader.bV5Compression of
          BI_RGB:   S := S + 'Uncompressed format (BI_RGB)';
          BI_RLE8: S := S + 'RLE format for bitmaps with 8 bpp (BI_RLE8)';
          BI_RLE4: S := S + 'RLE format for bitmaps with 4 bpp (BI_RLE4)';
          BI_BITFIELDS: S := S + 'Not compressed with color masks (BI_BITFIELDS)';
          BI_JPEG: S := S + 'Compressed using JPEG file format (BI_JPEG)';
          BI_PNG:   S := S + 'Compressed using PNG file format (BI_PNG)';
        end;
        S := S + sLineBreak;
        Result := S;
      finally
        GlobalUnlock(ClipboardData);
      end;      
    end;
  finally
    CloseClipboard;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  S: string;
begin
  S := GetClipboardFormats;
  if IsClipboardFormatAvailable(CF_DIB) then
    S := S + sLineBreak + GetClipboardInfoDIB;
  if IsClipboardFormatAvailable(CF_DIBV5) then
    S := S + sLineBreak + GetClipboardInfoDIBV5;
  ShowMessage(S);
end;

Adobe Photoshop CS 6 13.0 复制到剪贴板的上述透明图像代码的输出（点击放大）：

一些有用的阅读：

• How to copy an image to clipboard keeping its transparency
• How to copy & paste images using CF_DIBV5 format preserving transparency

Answer 3

此链接中解释的解决方案可能有效。

unit EG_ClipboardBitmap32;
{
  Author William Egge. egge@eggcentric.com
  January 17, 2002
  Compiles with ver 1.2 patch #1 of Graphics32

  This unit will copy and paste Bitmap32 pixels to the clipboard and retain the
  alpha channel.

  The clipboard data will still work with regular paint programs because this
  unit adds a new format only for the alpha channel and is kept seperate from
  the regular bitmap storage.
}

interface

uses
  ClipBrd, Windows, SysUtils, GR32;

procedure CopyBitmap32ToClipboard(const Source: TBitmap32);
procedure PasteBitmap32FromClipboard(const Dest: TBitmap32);
function CanPasteBitmap32: Boolean;

implementation

const
  RegisterName = 'G32 Bitmap32 Alpha Channel';
  GlobalUnlockBugErrorCode = ERROR_INVALID_PARAMETER;

var
  FAlphaFormatHandle: Word = 0;

procedure RaiseSysError;
var
  ErrCode: LongWord;
begin
  ErrCode := GetLastError();
  if ErrCode <> NO_ERROR then
    raise Exception.Create(SysErrorMessage(ErrCode));
end;

function GetAlphaFormatHandle: Word;
begin
  if FAlphaFormatHandle = 0 then
  begin
    FAlphaFormatHandle := RegisterClipboardFormat(RegisterName);
    if FAlphaFormatHandle = 0 then
      RaiseSysError;
  end;
  Result := FAlphaFormatHandle;
end;

function CanPasteBitmap32: Boolean;
begin
  Result := Clipboard.HasFormat(CF_BITMAP);
end;

procedure CopyBitmap32ToClipboard(const Source: TBitmap32);
var
  H: HGLOBAL;
  Bytes: LongWord;
  P, Alpha: PByte;
  I: Integer;
begin
  Clipboard.Assign(Source);
  if not OpenClipboard(0) then
    RaiseSysError
  else
    try
      Bytes := 4 + (Source.Width * Source.Height);
      H := GlobalAlloc(GMEM_MOVEABLE and GMEM_DDESHARE, Bytes);
      if H = 0 then
        RaiseSysError;
      P := GlobalLock(H);
      if P = nil then
        RaiseSysError
      else
        try
          PLongWord(P)^ := Bytes - 4;
          Inc(P, 4);
          // Copy Alpha into Array
          Alpha := Pointer(Source.Bits);
          Inc(Alpha, 3); // Align with Alpha
          for I := 1 to (Source.Width * Source.Height) do
          begin
            P^ := Alpha^;
            Inc(Alpha, 4);
            Inc(P);
          end;
        finally
          if (not GlobalUnlock(H)) then
            if (GetLastError() <> GlobalUnlockBugErrorCode) then
              RaiseSysError;
        end;
      SetClipboardData(GetAlphaFormatHandle, H);
    finally
      if not CloseClipboard then
        RaiseSysError;
    end;
end;

procedure PasteBitmap32FromClipboard(const Dest: TBitmap32);
var
  H: HGLOBAL;
  ClipAlpha, Alpha: PByte;
  I, Count, PixelCount: LongWord;
begin
  if Clipboard.HasFormat(CF_BITMAP) then
  begin
    Dest.BeginUpdate;
    try
      Dest.Assign(Clipboard);
      if not OpenClipboard(0) then
        RaiseSysError
      else
        try
          H := GetClipboardData(GetAlphaFormatHandle);
          if H <> 0 then
          begin
            ClipAlpha := GlobalLock(H);
            if ClipAlpha = nil then
              RaiseSysError
            else
              try
                Alpha := Pointer(Dest.Bits);
                Inc(Alpha, 3); // Align with Alpha
                Count := PLongWord(ClipAlpha)^;
                Inc(ClipAlpha, 4);
                PixelCount := Dest.Width * Dest.Height;
                Assert(Count = PixelCount,
                  'Alpha Count does not match Bitmap pixel Count,
                  PasteBitmap32FromClipboard(const Dest: TBitmap32);');

                // Should not happen, but if it does then this is a safety catch.
                if Count > PixelCount then
                  Count := PixelCount;

                for I := 1 to Count do
                begin
                  Alpha^ := ClipAlpha^;
                  Inc(Alpha, 4);
                  Inc(ClipAlpha);
                end;
              finally
                if (not GlobalUnlock(H)) then
                  if (GetLastError() <> GlobalUnlockBugErrorCode) then
                    RaiseSysError;
              end;
          end;
        finally
          if not CloseClipboard then
            RaiseSysError;
        end;
    finally
      Dest.EndUpdate;
      Dest.Changed;
    end;
  end;
end;

end.

该功能PasteBitmap32FromClipboard显然是您所需要的。在这个问题中回答了将位图保存为 PNG 。