How to save PngImage from clipboard - delphi

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

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

Answer 3

The solution explained in this link may work.
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.
The function PasteBitmap32FromClipboard is apparently what you need. Saving a bitmap as PNG is answered in this question.