extract frames from png animations

[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...