How to save PngImage from clipboard

Question

How can i save the pngimage to file copied form AdobeFirewoks(Clipboard) or Photoshop without losing the transparency.

i am using delphi2009.

thank you in advance.

@TLama I tried this code but there is no transparency. I don't know also if i do it right.

  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's clipboard format is horrible. The only pretty valid data that contains the alpha channel stored into the clipboard is... guess? ... a pointer to the alpha channel's memory into the "Photoshop Paste In Place" chunk.... HORRIBLE. If you copy something then restart photoshop, the alpha is... lost :)

However, you can easily understand if the clipboard contains Photoshop image.

Ask the Clipboard what chunks it have.

If the clipboard have two chunks, named "Photoshop Paste In Place" AND "Object Descriptor", you can be 99.9% sure that Photoshop IS RUNNING on the system AND Clipboard contains reference to Photoshop data. (When Photoshop quits, the Object Descriptor chunk gets removed from the Clipboard, so the alpha is lost forever)

So then, you have two choices:

Choice 1 (not recommended): Open Photoshop's Process Memory and read the raw 32-bit image data from the pointer... which is overall idiotic to do and unsecure, or

Choice 2 (recommended): Use COM to extract the image data from Photoshop. Of course, the COM method is the best way. Make your program generate and run the following VBS script:

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()

In the script's CurrentDirectory, a file names "psClipboard.png" will be generated. Read this file in your program using libPng or whatever, and treat is as if it was come from the Clipboard. This script will DELETE the psClipboard.png, then will ask Photoshop for it. In case a Paste returns Error, the script will cease and the file will not be generated, in which case, Clipboard didn't contained valid Photoshop reference data.

Answer 2

The solution explained in this link may work.

unit EG_ClipboardBitmap32;
{
  Author William Egge. [e-mail]
  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.

The function PasteBitmap32FromClipboard is apparently what you need. Saving a bitmap as PNG is answered in this question.

Answer 3

Based on empirical results confirmed by my colleague having Adobe Photoshop CS 6 13.0 x32 using the following test code points out that it's not possible to save the image from clipboard copied by the Adobe Photoshop without losing transparency simply because it doesn't copy the alpha channel data.

Adobe Photoshop (at least in the version mentioned above) uses 24-bit pixel format for clipboard image data transfer. And, since it is the 24-bit bitmap there can't be an alpha channel. Don't know anyone who has the Adobe Fireworks to verify, but for sure they're using own registered clipboard format to transfer images including the alpha channel between their products.

The CF_BITMAP or CF_DIB formats used by Adobe Photoshop clipboard supposedly supports alpha channel, as some people says (I haven't tried) but that would be true only for 32-bit pixel format, not for the 24-bit pixel format. The only clipboard format, that surely supports transparency, is the CF_DIBV5 but as the others, the image have to be stored in 32-bit pixel format to preserve the alpha channel:

The following code shows the information about the currently copied clipboard content:

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;

Output of the above code for transparent image copied into a clipboard by Adobe Photoshop CS 6 13.0 (click to enlarge):

Something useful to read:

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