logo标签列表

如何从剪贴板保存PngImage

delphipngtransparencyclipboard
6
我如何在不丢失透明度的情况下保存从Adobe Fireworks（剪贴板）或Photoshop复制的PNG图像到文件中？
我正在使用Delphi2009。
谢谢您提前帮忙。
@TLama 我尝试了这段代码，但是没有透明度。 我也不知道是否做得正确。
  png := TPngimage.Create;
  try
    png.LoadFromClipboardFormat(CF_BITMAP,
      Clipboard.GetAsHandle(CF_BITMAP), CF_BITMAP);
    image1.Picture.Assign(png);
  finally
    png.Free;
  end;
你能运行这段代码并告诉我，当你在剪贴板中有一个透明图像时，消息显示的是什么？你能使用从你提到的两个应用程序中复制的图像来执行吗？ - TLama
@TLama，它返回了几个cfFormat，但我不知道如何使用png.LoadFromClipboardFormat()来应用它。它总是给我一个Unsupported format（不支持的格式）的错误提示。 - XBasic3000
这是因为PNG图像的LoadFromClipboardFormat内部创建了一个位图，并尝试从剪贴板加载该位图。当您指定除CF_BITMAP以外的格式时，就会引发异常。 - TLama
@TLama，我尝试了你告诉我的cfFormat值。 - XBasic3000
不，我是想运行这段代码，我不记得我是否建议使用CF_BITMAP。无论如何，这都行不通。从Photoshop复制时，无法粘贴精确的透明图像，因为32位位图（具有Alpha通道的格式）中每个像素由每个像素的4个字节组成。而Photoshop只复制红色、绿色和蓝色通道的3个值到剪贴板中。它不包括Alpha通道的值。 - TLama
3个回答
6
Photoshop的剪贴板格式非常糟糕。唯一有效的包含带有Alpha通道的数据的剪贴板仅是一个指向“Photoshop Paste In Place”块中Alpha通道内存的指针... 糟糕极了。如果复制某些内容，然后重新启动Photoshop，Alpha通道将会丢失 :(
但是，您可以轻松判断剪贴板是否包含Photoshop图像。
询问剪贴板它拥有哪些块。
如果剪贴板有两个名为“Photoshop Paste In Place”和“Object Descriptor”的块，则您可以99.9％确定Photoshop正在运行，并且剪贴板包含对Photoshop数据的引用。（当Photoshop退出时，“Object Descriptor”块将从剪贴板中删除，因此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()

在脚本的当前目录下，将生成一个名为“psClipboard.png”的文件。使用libPng或其他工具在您的程序中读取此文件，并将其视为来自剪贴板。该脚本将删除psClipboard.png，然后请求Photoshop获取它。如果粘贴操作返回错误，则脚本将停止执行并且不会生成文件，这意味着剪贴板中没有包含有效的Photoshop参考数据。
请问一下，哪个块包含透明图像？是“Photoshop粘贴到原位”吗？很遗憾，我不理解基本代码（对我的糟糕英语感到抱歉）。 - Alex Aparin
很遗憾，当前没有任何一个通道包含阿尔法信息。只有指向正在运行的Photoshop进程中包含完整透明度图像的某个句柄。您可以通过使用上述VBS获取图像，但前提是剪贴板中有“Photoshop粘贴到原位”和“对象描述符”块。 - Петър Петров
5

根据我同事使用Adobe Photoshop CS 6 13.0 x32进行的经验结果，使用以下测试代码表明，仅仅因为它不会复制alpha通道数据，所以无法保存从Adobe Photoshop复制的剪贴板图像而不丢失透明度。

Adobe Photoshop（至少在上述版本中）使用24位像素格式进行剪贴板图像数据传输。由于它是24位位图，因此不能有alpha通道。不知道是否有人使用Adobe Fireworks进行验证，但肯定他们正使用自己注册的剪贴板格式在他们的产品之间传输包括alpha通道在内的图像。

Adobe Photoshop剪贴板使用的CF_BITMAP或CF_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复制到剪贴板的透明图像的输出（点击放大）：

Click to enlarge

有用的阅读材料:

1
实际上，它确实导出了对完整的32位图像的引用。请参阅这两个块 - “Photoshop Paste In Place” - 包含指向图像数据的原始32位指针，“Object Descriptor”。如果这些块都存在，则剪贴板包含一个Photoshop图像并且Photoshop正在运行！请查看我的下面的答案，如何使用COM / VBS提取带有其Alpha通道的真实图像：P - Петър Петров
2
这个链接中解释的方案可能有效。
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格式在这个问题中得到了解答。
这似乎只是用于在 Graphics32 库位图之间使用自定义剪贴板格式进行复制和粘贴。 - TLama
@TLama - 确实。这是一个 LMGTFY 的回答。 - Leonardo Herrera
@Leonardo，:-) 但是，似乎唯一支持alpha通道的格式是CF_DIBV5，但我还不知道问题中提到的应用程序是否使用它来复制到剪贴板。他们可能使用具有alpha通道支持的自定义剪贴板格式，很难说。这就是为什么我要求运行测试代码以确定支持的格式。 - TLama
1
@XBasic3000，不行。我的朋友试图在Photoshop和GIMP之间复制和粘贴透明图像，结果图像失去了透明度。但无论如何，请你运行我在你的问题评论中的pastebin代码，并让我知道你得到了什么结果，好吗？ - TLama
Photoshop不会将alpha通道放入剪贴板，也不会放置32位DIB。访问alpha通道的唯一方法是通过取消引用指针进入“Photoshop粘贴到原位”或使用COM/VBScript。请查看我的答案！ - Петър Петров
显示剩余4条评论
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接