[Lazarus] Extract the color data and alpha from a PNG image
José Mejuto
joshyfun at gmail.com
Thu Feb 7 19:25:44 CET 2013
El 05/02/2013 23:49, silvioprog escribió:
> You have puted a PNG image into a PDF? That's what I'm trying to do, and
> it needs of the uncompressed data too (or compressed as gzip).
Hello,
The attached code do more or less the same as the fpdf.php one. It can
be written in a very different way but I tried to be more modular to
acomodate in a future the indexed palettes and transparencies over
palettes, and also allow an easy data to real RGB (after filtering)
conversion.
--
-------------- next part --------------
unit upng4pdftest;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, zstream;
type
RPNGChunkInfo=packed record
ChunkSize: DWORD;
ChunkID: array [0..3] of char;
ChunkData: PBYTE;
ChunkCRC: DWORD;
end;
RPNGIHDR=packed record
Width: DWORD;
Height: DWORD;
BitDepth: BYTE;
ColorType: BYTE;
CompressionMethod: BYTE;
FilterMethod: BYTE;
InterlaceMode: BYTE;
end;
PPMGIHDR=^RPNGIHDR;
RPNGPLTE=record
PaletteEntries: BYTE;
PaletteRGB: array [0..((256*3)-1)] of BYTE;
end;
RPNGtoPDFData=record
IHDR: RPNGIHDR;
PLTE: RPNGPLTE;
IDATCompressed: PBYTE;
IDATCompressedSize: DWORD;
IDATUnCompressed: PBYTE;
IDATUncompressedSize: DWORD;
AlphaRGBColor: DWORD;
AlphaPalette: array [0..255] of BYTE;
IDATRGB: PBYTE;
IDATRGBSize: DWORD;
IDATHasTransparency: Boolean;
IDATTransparency: PBYTE;
IDATTransparencySize: DWORD;
PDFColorSpace: string;
ErrorString: string;
end;
function GetPNGInformation(const aFileName: string): RPNGtoPDFData;
function GetPNGInformation(const aStream: TStream): RPNGtoPDFData;
procedure PNGTest();
implementation
function ReadChunk(const aStream: TStream; out aChunk: RPNGChunkInfo): integer;
begin
Result:=aStream.Read(aChunk.ChunkSize,4);
if Result<>4 then exit(0);
aChunk.ChunkSize:=BEtoN(aChunk.ChunkSize);
Result:=Result+aStream.Read(aChunk.ChunkID,4);
if Result<>8 then exit(0);
GetMem(aChunk.ChunkData,aChunk.ChunkSize);
Result:=Result+aStream.Read(aChunk.ChunkData^,aChunk.ChunkSize);
if DWORD(Result)<>8+aChunk.ChunkSize then exit(0);
Result:=Result+aStream.Read(aChunk.ChunkCRC,4);
if DWORD(Result)<>8+4+aChunk.ChunkSize then exit(0);
end;
function ExpandIDAT(const aIDAT: PBYTE; const aSize: DWORD; out aIDATExpanded: PBYTE; out aExpandedSize: DWORD): Boolean;
var
ExpandStream: Tdecompressionstream;
InputStream: TMemoryStream;
OutputStream: TMemoryStream;
begin
aIDATExpanded:=nil;
aExpandedSize:=0;
InputStream:=TMemoryStream.Create;
InputStream.Write(aIDAT^,aSize);
InputStream.Position:=0;
OutputStream:=TMemoryStream.Create;
try
ExpandStream:=nil;
ExpandStream:=Tdecompressionstream.create(InputStream);
try
OutputStream.CopyFrom(ExpandStream,0);
GetMem(aIDATExpanded,OutputStream.Size);
OutputStream.Position:=0;
OutputStream.Read(aIDATExpanded^,OutputStream.Size);
aExpandedSize:=OutputStream.Size;
result:=true;
except
Result:=false;
if Assigned(aIDATExpanded) then begin
FreeMem(aIDATExpanded);
aIDATExpanded:=nil;
end;
aExpandedSize:=0;
end;
finally
InputStream.Free;
OutputStream.Free;
ExpandStream.Free;
end;
end;
function GetPNGInformation(const aFileName: string): RPNGtoPDFData;
var
FileStream: TFileStream;
begin
Result.ErrorString:=''; //No initialization warning
FillByte(Result,sizeof(Result),0);
FileStream:=TFileStream.Create(aFileName,fmOpenRead or fmShareDenyWrite);
try
Result:=GetPNGInformation(FileStream);
finally
FileStream.Free;
end;
end;
function GetPNGInformation(const aStream: TStream): RPNGtoPDFData;
const
MatchSignature: array [0..7] of BYTE=(137,BYTE('P'),BYTE('N'),BYTE('G'),13,10,26,20);
var
Signature: array [0..7] of Byte;
Chunk: RPNGChunkInfo;
x,y: DWORD;
FilterMode: BYTE;
TargetRGB: DWORD;
TargetAlpha: DWORD;
Source: DWORD;
begin
FillByte(Result,sizeof(Result),0);
Signature[0]:=0; //Avoid initialization warning
FillByte(Signature,sizeof(Signature),0);
aStream.Read(Signature,sizeof(Signature));
if CompareMem(@Signature[0], at MatchSignature[0],sizeof(Signature)) then begin
Result.ErrorString:='Not PNG signature found.';
exit;
end;
if ReadChunk(aStream,Chunk)=0 then begin
Result.ErrorString:='Error reading PNG.';
exit;
end;
if Chunk.ChunkID<>'IHDR' then begin
Result.ErrorString:='IHDR not found, incorrect PNG file.';
exit;
end;
Result.IHDR:=PPMGIHDR(Chunk.ChunkData)^;
FreeMem(Chunk.ChunkData);
with Result do begin
IHDR.Width:=BEtoN(IHDR.Width);
IHDR.Height:=BEtoN(IHDR.Height);
if IHDR.BitDepth>8 then begin
ErrorString:='Bit depth > 8 not supported.';
exit;
end;
Case IHDR.ColorType of
0,4: PDFColorSpace:='DeviceGray';
2,6: PDFColorSpace:='DeviceRGB';
3: PDFColorSpace:='Indexed';
else begin
ErrorString:='Color format not supported.';
exit;
end;
end;
if IHDR.CompressionMethod<>0 then begin
ErrorString:='Compression method not supported.';
exit;
end;
if IHDR.FilterMethod<>0 then begin
ErrorString:='Filter method not supported.';
exit;
end;
if IHDR.InterlaceMode<>0 then begin
ErrorString:='Interlacing not supported.';
exit;
end;
end;
//Scan next chunks
repeat
if ReadChunk(aStream,Chunk)=0 then begin
Result.ErrorString:='Error reading PNG.';
exit;
end;
if Chunk.ChunkID='PLTE' then begin
//Palette
Result.PLTE.PaletteEntries:=Chunk.ChunkSize div 3;
move(Chunk.ChunkData^,Result.PLTE.PaletteRGB,Chunk.ChunkSize);
end else if Chunk.ChunkID='tRNS' then begin
Result.IDATHasTransparency:=true;
case Result.IHDR.ColorType of
0:
begin
//Only one gray value
Result.AlphaRGBColor:=Chunk.ChunkData^;
end;
2:
begin
//Only one color RBG value as transparent
Result.AlphaRGBColor:=Chunk.ChunkData^ shl 16 or (Chunk.ChunkData+1)^ shl 8 or (Chunk.ChunkData+2)^;
end;
3:
begin
move(Chunk.ChunkData^,Result.AlphaPalette,Chunk.ChunkSize);
end;
else
begin
Result.ErrorString:='Unknown color type and transparency combination.';
exit;
end;
end;
end else if Chunk.ChunkID='IDAT' then begin
Result.IDATCompressed:=Chunk.ChunkData;
Chunk.ChunkData:=nil; // Memory block moved to Result.IDATCompressed and niled to avoid freemem.
Result.IDATCompressedSize:=Chunk.ChunkSize;
if not ExpandIDAT(Result.IDATCompressed,Result.IDATCompressedSize,Result.IDATUnCompressed,Result.IDATUncompressedSize) then begin
Result.ErrorString:='Something went wrong expanding IDAT.';
exit;
end;
end else begin
if BYTE(Chunk.ChunkID[0])>128 then begin
Result.ErrorString:='Critical PNG packet found, but I do not know how to handle "'+Chunk.ChunkID+'"';
exit;
end;
end;
if Chunk.ChunkData<>nil then begin
FreeMem(Chunk.ChunkData);
end;
until Chunk.ChunkID='IEND';
//Process uncompressed data to extract the alpha and RGB24 channels in different layers.
if Result.IDATHasTransparency then begin
//TODO:
//Resolve paletted and other transparencies.
end else begin
case Result.IHDR.ColorType of
4: //Gray scale with alpha (not tested)
begin
{$DEFINE INCLUDE_FILTERMODE=1}
//Each line is: FilterMode(1),Gray(1),Alpha(1),...,Gray(1),Alpha(1)
Result.IDATRGBSize:=Result.IHDR.Width*Result.IHDR.Height;
Result.IDATTransparencySize:=Result.IHDR.Width*Result.IHDR.Height;
{$IFDEF INCLUDE_FILTERMODE}
inc(Result.IDATRGBSize,Result.IHDR.Height*1);
inc(Result.IDATTransparencySize,Result.IHDR.Height*1);
{$ENDIF}
Getmem(Result.IDATTransparency,Result.IDATTransparencySize);
Getmem(Result.IDATRGB,Result.IDATRGBSize);
with Result do begin
TargetAlpha:=0;
TargetRGB:=0;
Source:=0;
y:=0;
while y<IHDR.Height do begin
FilterMode:=(IDATUnCompressed+Source)^;
{$IFDEF INCLUDE_FILTERMODE}
(IDATRGB+TargetRGB)^:=(IDATUnCompressed+Source)^;
inc(TargetRGB);
(IDATTransparency+TargetAlpha)^:=(IDATUnCompressed+Source)^;
inc(TargetAlpha);
{$ENDIF}
inc(Source);
x:=0;
while X<IHDR.Width do begin
(IDATRGB+TargetRGB)^:=(IDATUnCompressed+Source)^;
inc(TargetRGB);
inc(Source);
(IDATTransparency+TargetAlpha)^:=(IDATUnCompressed+Source)^;
inc(TargetAlpha);
inc(Source);
inc(x);
end;
inc(y);
end;
end;
end;
6: //Truecolor with alpha
begin
{$DEFINE INCLUDE_FILTERMODE=1}
//Each line is: FilterMode(1),RGB(3),Alpha(1),...,RGB(3),Alpha(1)
Result.IDATRGBSize:=Result.IHDR.Width*Result.IHDR.Height*3;
Result.IDATTransparencySize:=Result.IHDR.Width*Result.IHDR.Height;
{$IFDEF INCLUDE_FILTERMODE}
inc(Result.IDATRGBSize,Result.IHDR.Height*1);
inc(Result.IDATTransparencySize,Result.IHDR.Height*1);
{$ENDIF}
Getmem(Result.IDATTransparency,Result.IDATTransparencySize);
Getmem(Result.IDATRGB,Result.IDATRGBSize);
with Result do begin
TargetAlpha:=0;
TargetRGB:=0;
Source:=0;
y:=0;
while y<IHDR.Height do begin
FilterMode:=(IDATUnCompressed+Source)^;
{$IFDEF INCLUDE_FILTERMODE}
(IDATRGB+TargetRGB)^:=(IDATUnCompressed+Source)^;
inc(TargetRGB);
(IDATTransparency+TargetAlpha)^:=(IDATUnCompressed+Source)^;
inc(TargetAlpha);
{$ENDIF}
inc(Source);
x:=0;
while X<IHDR.Width do begin
(IDATRGB+TargetRGB)^:=(IDATUnCompressed+Source)^;
inc(TargetRGB);
inc(Source);
(IDATRGB+TargetRGB)^:=(IDATUnCompressed+Source)^;
inc(TargetRGB);
inc(Source);
(IDATRGB+TargetRGB)^:=(IDATUnCompressed+Source)^;
inc(TargetRGB);
inc(Source);
(IDATTransparency+TargetAlpha)^:=(IDATUnCompressed+Source)^;
inc(TargetAlpha);
inc(Source);
inc(x);
end;
inc(y);
end;
end;
end;
end;
end;
end;
procedure PNGTest();
var
Info: RPNGtoPDFData;
F: TFileStream;
begin
Info:=GetPNGInformation('image.png');
if Info.ErrorString='' then begin
if Info.IDATRGBSize>0 then begin
F:=TFileStream.Create('COLOR.DATA',fmCreate);
F.Write(Info.IDATRGB^,info.IDATRGBSize);
F.Free;
end;
if Info.IDATTransparencySize>0 then begin
F:=TFileStream.Create('ALPHA.DATA',fmCreate);
F.Write(Info.IDATTransparency^,info.IDATTransparencySize);
F.Free;
end;
end;
FreeMem(info.IDATRGB);
FreeMem(info.IDATTransparency);
FreeMem(info.IDATUnCompressed);
FreeMem(info.IDATCompressed);
end;
end.
More information about the Lazarus
mailing list