extract frames from png animations

[Cosmin]

Hi.

Sorry in advance for using english language.

Delphi version: XE8 update 1
OS: Windows 8.1 x64

I'm trying to build a code for extracting png frames from apng (png animation) files (preferably in a memory stream).
I found some examples on internet, but none in Delphi/Pascal language. Plus they weren't very well commented.

What I tried so far:

Delphi-Quellcode:

const
   PNG_SIG: array[0..7] of byte = ($89, $50, $4E, $47, $0D, $0A, $1A, $0A);
var
   i, j, n, nFrames, nrz, PrevPos: Integer;
   crc: Cardinal;
   png: TPngImage;
   //  pngFrames: array of TPngImage;
   msHeader, msFooter, msOutput: TMemoryStream;
   strTemp: string;
begin
   png := Tpngimage.Create;
   msOutput := TMemoryStream.Create;
   png.LoadFromFile('test.png');
   msHeader := TMemoryStream.Create;
   msHeader.SetSize(Cardinal(Length(PNG_SIG)));
   msHeader.Position := 0;
   msHeader.WriteBuffer(PNG_SIG[0], Length(PNG_SIG));
   msHeader.Position := msHeader.Size;
   png.Header.SaveToStream(msHeader);
   msFooter := TMemoryStream.Create;
   i := png.Chunks.Count - 1;
   while i >= 0 do
   begin
      if png.Chunks.Item[i].Name = 'IEND' then
         Break;
      Dec(i);
   end;
   if i > 0 then
      png.Chunks.Item[i].SaveToStream(msFooter);
   nFrames := 0;
   for i := 0 to png.Chunks.Count - 1 do
      if png.Chunks.Item[i].Name = 'fcTL' then
         Inc(nFrames);
   n := 0;
   for i := 0 to png.Chunks.Count - 1 do
   begin
      // ShowMessage(string(png.Chunks.Item[i].Name) + #13 + IntToStr(png.Chunks.Item[i].Index) + #13 + IntToStr(png.Chunks.Item[i].DataSize));
      if png.Chunks.Item[i].Name = 'IDAT' then
      begin
         msOutput.Position := msOutput.Size;
         png.Chunks.Item[i].SaveToStream(msOutput);
      end
      else if png.Chunks.Item[i].Name = 'fdAT' then
      begin
         msOutput.Position := msOutput.Size;
         PrevPos := msOutput.Position;
         png.Chunks.Item[i].SaveToStream(msOutput);
         msOutput.Position := PrevPos + 4;
         msOutput.WriteBuffer(AnsiString('ID')[1], 2);
      end
      else if png.Chunks.Item[i].Name = 'fcTL' then
      begin
         if n > 0 then
         begin
            msOutput.Position := msOutput.Size;
            msFooter.Position := 0;
            msOutput.CopyFrom(msFooter, msFooter.Size);
            nrz := Length(IntToStr(nFrames)) - Length(IntToStr(n));
            strTemp := '';
            for j := 1 to nrZ do
               strTemp := strTemp + '0';
            msOutput.SaveToFile('Frames\Frame' + strTemp + IntToStr(n) + '.png');
         end;
         Inc(n);
         msOutput.Clear;
         msHeader.Position := 0;
         msOutput.LoadFromStream(msHeader);
      end;
   end;
   if n > 0 then
   begin
      msOutput.Position := msOutput.Size;
      msFooter.Position := 0;
      msOutput.CopyFrom(msFooter, msFooter.Size);
      nrz := Length(IntToStr(nFrames)) - Length(IntToStr(n));
      strTemp := '';
      for j := 1 to nrZ do
         strTemp := strTemp + '0';
      msOutput.SaveToFile('Frame' + strTemp + IntToStr(n) + '.png');
   end;
end;

I get only the first frame (well, only 281 KB from 309 KB, but you can view it), the others are only 60..70KB (from 300K+).
I'm guessing some fdAT pieces are shared between them and the first frame (IDAT), but I can't find the information on how to assemble them.

The code has to work with any png animation, not just this one.

Could you please help me?
It's very important for me.

Thank you.

[FarAndBeyond]

Hi and welcome...

Unfortunately I can't help you in this matter, but what about VampyreImaging LIB? The Library can handle APNG, so maybe there are ready procedures...

Or did you take a look at this https://sourceforge.net/projects/apn...bpng/examples/?
There are some code examples... or you have to check C/C++ or Java examples ... something like that.

EDIT:
Here is a dissassembler for APNG (SRC)
https://sourceforge.net/projects/apngdis/files/2.8/
Looks like C-Code (VS2013)...

[Cosmin]

Zitat von FarAndBeyond:

Hi and welcome...

Thank you

Zitat von FarAndBeyond:

Unfortunately I can't help you in this matter, but what about VampyreImaging LIB? The Library can handle APNG, so maybe there are ready procedures...

Didn't mentioned it because it's very old, very complex and I couldn't install it in Delphi XE8.
I tried it this morning to manually "trace" how apngs are loaded (in the pas files). After a few hours, tired and hungry, I gave up

Zitat von FarAndBeyond:

Or did you take a look at this https://sourceforge.net/projects/apn...bpng/examples/?
There are some code examples... or you have to check C/C++ or Java examples ... something like that.

Exactly about them I was talking about.
It's not so easy translating from one language to another, especially when they are using functions and/or components specific to that language but not in Delphi.

Zitat von FarAndBeyond:

EDIT:
Here is a dissassembler for APNG (SRC)
https://sourceforge.net/projects/apngdis/files/2.8/
Looks like C-Code (VS2013)...

I know it.
Same thing about the code as above. I tried once to convert some code from C+ to Delphi, I still have nightmares about it.
Plus it's only the 32 bit version, limited to 1.2 GB Ram.

[Luckie]

By the way the png Object is never freed.

I would fragment the whole procedure into separate procedures. That will make it easier to locate problems and bugs. Your long procedure is way too confusing. And if you use a class you can even avoid passing arguments around.

[FarAndBeyond]

@Cosmin:
I know you mentioned, that you already looked at Vampyre LIB, but maybe you can do it again with Lazarus. I know there are project files only for old Versions D2007, D2009, D7, but maybe the Lazarus files are helpful.

On the other hand:
There is a boolean option called "ImagingPNGLoadAnimated" and if this is zero then the loader will not animate the frames but instead of animating he loads the raw frames.
So that means, that the magic must be within the LoadImageFromPNGFrame procedure ...as I think...
Did you look at this:

Delphi-Quellcode:

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;

And of course there is a procedure for saving PNG images too (ImagingNetworkGraphics.pas), but I guess you already know them...
Give Lazarus a try...

[Cosmin]

Zitat von Luckie:

By the way the png Object is never freed.

Correct. And the 3 streams too.
The code is just in "getting results" stage, so the nonreleasing used memory did not seem so important since in this moment I use the code only for tests in Delphi.
But thank you.

Zitat von Luckie:

I would fragment the whole procedure into separate procedures. That will make it easier to locate problems and bugs. Your long procedure is way too confusing. And if you use a class you can even avoid passing arguments around.

You could be right, although this code seems simple to me + breaking the code into small procedures affects the overall speed.


@FarAndBeyond

Thank you I'll have a look.
I've worked with Lazarus a few times, even made a dictionary component. So it's not so new to me.

[Luckie]

Well. Better slow working code than fast not working code. But does speed really matter in the end?

Bu as you wrote yourself: "getting results stage". So, i still would break in small pieces. Because it helps finding bugs, isolating prolems and it will be more readable.

[Cosmin]

Just to see what I'm trying to do.

Here is a test application: https://drive.google.com/open?id=0By...WZFYVlFQ1BzVlU

And here are some test files:

https://drive.google.com/open?id=0By...VZKcXdmb00zSmc
https://drive.google.com/open?id=0By...U9COFFmTUtjS1k
https://drive.google.com/open?id=0By...VRUa2tGZEYybGs

Use the button "Load Ajpeg" and then click on Preview.

[Cosmin]

@FarAndBeyond

That function seems to do ONLY png decompression of a frame received through its parameters.
But what I didn't find is how that frame is assembled from fdAT and IDAT chunks.

I also tried that library in Lazarus but couldn't make it work.

@Luckie

The reason my code isn't working is not because is buggy, is because is not finished. And is not finished because I can't find more detailed informations about the apng internal structure and/or find simple examples in Delphi/Pascal code to show how is done.
I knew my code will not work from the minute I started working on it. But I was hoping one of you will help me finish it.

A paradox: you don't seem to understand my code, which is so simple and short compared with that library function.
But I am suppose to understand a 3..4 times bigger and more complex function from a dozens times bigger and more complex library?

You guys are great helpers but unfortunately you know nothing about png animations.

Thank you and goodbye.