procedure TNGFileLoader.LoadImageFromPNGFrame(FrameWidth, FrameHeight: LongInt;
const IHDR: TIHDR;
IDATStream: TMemoryStream;
var Image: TImageData);
type
TGetPixelFunc =
function(Line: PByteArray; X: LongInt): Byte;
var
LineBuffer:
array[Boolean]
of PByteArray;
ActLine: Boolean;
Data, TotalBuffer, ZeroLine, PrevLine: Pointer;
BitCount, TotalSize, TotalPos, BytesPerPixel, I, Pass,
SrcDataSize, BytesPerLine, InterlaceLineBytes, InterlaceWidth: LongInt;
procedure DecodeAdam7;
const
BitTable:
array[1..8]
of LongInt = ($1, $3, 0, $F, 0, 0, 0, $FF);
StartBit:
array[1..8]
of LongInt = (7, 6, 0, 4, 0, 0, 0, 0);
var
Src, Dst, Dst2: PByte;
CurBit, Col: LongInt;
begin
Src := @LineBuffer[ActLine][1];
Col := ColumnStart[Pass];
with Image
do
case BitCount
of
1, 2, 4:
begin
Dst := @PByteArray(Data)[I * BytesPerLine];
repeat
CurBit := StartBit[BitCount];
repeat
Dst2 := @PByteArray(Dst)[(BitCount * Col)
shr 3];
Dst2^ := Dst2^
or ((Src^
shr CurBit)
and BitTable[BitCount])
shl (StartBit[BitCount] - (Col * BitCount
mod 8));
Inc(Col, ColumnIncrement[Pass]);
Dec(CurBit, BitCount);
until CurBit < 0;
Inc(Src);
until Col >= Width;
end;
else
begin
Dst := @PByteArray(Data)[I * BytesPerLine + Col * BytesPerPixel];
repeat
CopyPixel(Src, Dst, BytesPerPixel);
Inc(Dst, BytesPerPixel);
Inc(Src, BytesPerPixel);
Inc(Dst, ColumnIncrement[Pass] * BytesPerPixel - BytesPerPixel);
Inc(Col, ColumnIncrement[Pass]);
until Col >= Width;
end;
end;
end;
procedure FilterScanline(Filter: Byte; BytesPerPixel: LongInt; Line, PrevLine, Target: PByteArray;
BytesPerLine: LongInt);
var
I: LongInt;
begin
case Filter
of
0:
begin
// No filter
Move(Line^, Target^, BytesPerLine);
end;
1:
begin
// Sub filter
Move(Line^, Target^, BytesPerPixel);
for I := BytesPerPixel
to BytesPerLine - 1
do
Target[I] := (Line[I] + Target[I - BytesPerPixel])
and $FF;
end;
2:
begin
// Up filter
for I := 0
to BytesPerLine - 1
do
Target[I] := (Line[I] + PrevLine[I])
and $FF;
end;
3:
begin
// Average filter
for I := 0
to BytesPerPixel - 1
do
Target[I] := (Line[I] + PrevLine[I]
shr 1)
and $FF;
for I := BytesPerPixel
to BytesPerLine - 1
do
Target[I] := (Line[I] + (Target[I - BytesPerPixel] + PrevLine[I])
shr 1)
and $FF;
end;
4:
begin
// Paeth filter
for I := 0
to BytesPerPixel - 1
do
Target[I] := (Line[I] + PaethPredictor(0, PrevLine[I], 0))
and $FF;
for I := BytesPerPixel
to BytesPerLine - 1
do
Target[I] := (Line[I] + PaethPredictor(Target[I - BytesPerPixel], PrevLine[I], PrevLine[I - BytesPerPixel]))
and $FF;
end;
end;
end;
procedure Convert124To8(DataIn: Pointer; DataOut: Pointer; Width, Height,
WidthBytes: LongInt; Indexed: Boolean);
var
X, Y, Mul: LongInt;
GetPixel: TGetPixelFunc;
begin
GetPixel := Get1BitPixel;
Mul := 255;
case IHDR.BitDepth
of
2:
begin
Mul := 85;
GetPixel := Get2BitPixel;
end;
4:
begin
Mul := 17;
GetPixel := Get4BitPixel;
end;
end;
if Indexed
then Mul := 1;
for Y := 0
to Height - 1
do
for X := 0
to Width - 1
do
PByteArray(DataOut)[Y * Width + X] :=
GetPixel(@PByteArray(DataIn)[Y * WidthBytes], X) * Mul;
end;
procedure TransformLOCOToRGB(Data: PByte; NumPixels, BytesPerPixel: LongInt);
var
I: LongInt;
begin
for I := 0
to NumPixels - 1
do
begin
if IHDR.BitDepth = 8
then
begin
PColor32Rec(Data).R := Byte(PColor32Rec(Data).R + PColor32Rec(Data).G);
PColor32Rec(Data).B := Byte(PColor32Rec(Data).B + PColor32Rec(Data).G);
end
else
begin
PColor64Rec(Data).R := Word(PColor64Rec(Data).R + PColor64Rec(Data).G);
PColor64Rec(Data).B := Word(PColor64Rec(Data).B + PColor64Rec(Data).G);
end;
Inc(Data, BytesPerPixel);
end;
end;
begin
Image.Width := FrameWidth;
Image.Height := FrameHeight;
Image.Format := ifUnknown;
case IHDR.ColorType
of
0:
begin
// Gray scale image
case IHDR.BitDepth
of
1, 2, 4, 8: Image.Format := ifGray8;
16: Image.Format := ifGray16;
end;
BitCount := IHDR.BitDepth;
end;
2:
begin
// RGB image
case IHDR.BitDepth
of
8: Image.Format := ifR8G8B8;
16: Image.Format := ifR16G16B16;
end;
BitCount := IHDR.BitDepth * 3;
end;
3:
begin
// Indexed image
case IHDR.BitDepth
of
1, 2, 4, 8: Image.Format := ifIndex8;
end;
BitCount := IHDR.BitDepth;
end;
4:
begin
// Grayscale + alpha image
case IHDR.BitDepth
of
8: Image.Format := ifA8Gray8;
16: Image.Format := ifA16Gray16;
end;
BitCount := IHDR.BitDepth * 2;
end;
6:
begin
// ARGB image
case IHDR.BitDepth
of
8: Image.Format := ifA8R8G8B8;
16: Image.Format := ifA16R16G16B16;
end;
BitCount := IHDR.BitDepth * 4;
end;
end;
// Start decoding
LineBuffer[True] :=
nil;
LineBuffer[False] :=
nil;
TotalBuffer :=
nil;
ZeroLine :=
nil;
BytesPerPixel := (BitCount + 7)
div 8;
ActLine := True;
with Image
do
try
BytesPerLine := (Width * BitCount + 7)
div 8;
SrcDataSize := Height * BytesPerLine;
GetMem(Data, SrcDataSize);
FillChar(Data^, SrcDataSize, 0);
GetMem(ZeroLine, BytesPerLine);
FillChar(ZeroLine^, BytesPerLine, 0);
if IHDR.Interlacing = 1
then
begin
// Decode interlaced images
TotalPos := 0;
DecompressBuf(IDATStream.Memory, IDATStream.Size, 0,
Pointer(TotalBuffer), TotalSize);
GetMem(LineBuffer[True], BytesPerLine + 1);
GetMem(LineBuffer[False], BytesPerLine + 1);
for Pass := 0
to 6
do
begin
// Prepare next interlace run
if Width <= ColumnStart[Pass]
then
Continue;
InterlaceWidth := (Width + ColumnIncrement[Pass] - 1 -
ColumnStart[Pass])
div ColumnIncrement[Pass];
InterlaceLineBytes := (InterlaceWidth * BitCount + 7)
shr 3;
I := RowStart[Pass];
FillChar(LineBuffer[True][0], BytesPerLine + 1, 0);
FillChar(LineBuffer[False][0], BytesPerLine + 1, 0);
while I < Height
do
begin
// Copy line from decompressed data to working buffer
Move(PByteArray(TotalBuffer)[TotalPos],
LineBuffer[ActLine][0], InterlaceLineBytes + 1);
Inc(TotalPos, InterlaceLineBytes + 1);
// Swap red and blue channels if necessary
if (IHDR.ColorType
in [2, 6])
then
SwapRGB(@LineBuffer[ActLine][1], InterlaceWidth, IHDR.BitDepth, BytesPerPixel);
// Reverse-filter current scanline
FilterScanline(LineBuffer[ActLine][0], BytesPerPixel,
@LineBuffer[ActLine][1], @LineBuffer[
not ActLine][1],
@LineBuffer[ActLine][1], InterlaceLineBytes);
// Decode Adam7 interlacing
DecodeAdam7;
ActLine :=
not ActLine;
// Continue with next row in interlaced order
Inc(I, RowIncrement[Pass]);
end;
end;
end
else
begin
// Decode non-interlaced images
PrevLine := ZeroLine;
DecompressBuf(IDATStream.Memory, IDATStream.Size, SrcDataSize + Height,
Pointer(TotalBuffer), TotalSize);
for I := 0
to Height - 1
do
begin
// Swap red and blue channels if necessary
if IHDR.ColorType
in [2, 6]
then
SwapRGB(@PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1], Width,
IHDR.BitDepth, BytesPerPixel);
// reverse-filter current scanline
FilterScanline(PByteArray(TotalBuffer)[I * (BytesPerLine + 1)],
BytesPerPixel, @PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1],
PrevLine, @PByteArray(Data)[I * BytesPerLine], BytesPerLine);
PrevLine := @PByteArray(Data)[I * BytesPerLine];
end;
end;
Size := Width * Height * BytesPerPixel;
if Size <> SrcDataSize
then
begin
// If source data size is different from size of image in assigned
// format we must convert it (it is in 1/2/4 bit count)
GetMem(Bits, Size);
case IHDR.ColorType
of
0: Convert124To8(Data, Bits, Width, Height, BytesPerLine, False);
3: Convert124To8(Data, Bits, Width, Height, BytesPerLine, True);
end;
FreeMem(Data);
end
else
begin
// If source data size is the same as size of
// image Bits in assigned format we simply copy pointer reference
Bits := Data;
end;
// LOCO transformation was used too (only for color types 2 and 6)
if (IHDR.Filter = 64)
and (IHDR.ColorType
in [2, 6])
then
TransformLOCOToRGB(Bits, Width * Height, BytesPerPixel);
// Images with 16 bit channels must be swapped because of PNG's big endianity
if IHDR.BitDepth = 16
then
SwapEndianWord(Bits, Width * Height * BytesPerPixel
div SizeOf(Word));
finally
FreeMem(LineBuffer[True]);
FreeMem(LineBuffer[False]);
FreeMem(TotalBuffer);
FreeMem(ZeroLine);
end;
end;