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.
--
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],@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.
--
_______________________________________________
Lazarus mailing list
[email protected]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
