{ +-------------------------------------------------------------+ }
{ |                                                             | }
{ |   GM-Software                                               | }
{ |   ===========                                               | }
{ |                                                             | }
{ |   Project: All Projects                                     | }
{ |                                                             | }
{ |   Description: PNG Image                                    | }
{ |   Original version written by Gustavo Daud.                 | }
{ |                                                             | }
{ |   Copyright (C) - 2009 - Gerrit Moeller.                    | }
{ |                                                             | }
{ |   Source code distributed under MIT license.                | }
{ |                                                             | }
{ |   See: https://www.gm-software.de                           | }
{ |                                                             | }
{ +-------------------------------------------------------------+ }

{$INCLUDE GMCompilerSettings.inc}

unit GMPngImage;

interface

{$TYPEDADDRESS OFF}

{.$DEFINE UseDelphi}              // Disable fat vcl units(perfect for small apps)
{$DEFINE ErrorOnUnknownCritical}  // Error when finds an unknown critical chunk
{$DEFINE CheckCRC}                // Enables CRC checking
{.$DEFINE RegisterGraphic}        // Registers TPNGObject to use with TPicture
{$DEFINE PartialTransparentDraw}  // Draws partial transparent images
{$DEFINE Store16bits}             // Stores the extra 8 bits from 16bits/sample
{$RANGECHECKS OFF} {$J+}

{$HPPEMIT '#pragma link "pngimage.obj"'} //Resolve linkage for C++

uses {$IFDEF JEDIAPI}{$ELSE}Windows,{$ENDIF}
     GMActiveX, GMIntf, GMZStrm, SysUtils {$IFDEF UseDelphi}, Classes, Graphics, SysUtils{$ENDIF};

const

  cResTypePngImg = 'PNGIMAGE';

  //LibraryVersion = '1.564';

  {ZLIB constants}
  ZLIBErrors: array[-6..2] of string = ('incompatible version (-6)',
    'buffer error (-5)', 'insufficient memory (-4)', 'data error (-3)',
    'stream error (-2)', 'file error (-1)', '(0)', 'stream end (1)',
    'need dictionary (2)');

  // Filters for mode 0
  FILTER_NONE    = 0;
  FILTER_SUB     = 1;
  FILTER_UP      = 2;
  FILTER_AVERAGE = 3;
  FILTER_PAETH   = 4;

  // PNG color modes
  COLOR_GRAYSCALE      = 0;
  COLOR_RGB            = 2;
  COLOR_PALETTE        = 3;
  COLOR_GRAYSCALEALPHA = 4;
  COLOR_RGBALPHA       = 6;


type

  {$IFNDEF UseDelphi}
    TColor = ColorRef;
    TCanvas = THandle;
    TBitmap = HBitmap;
    TPersistent = TObject;
  {$ENDIF}

  {Error types}
  EPNGOutMemory = class(Exception);
  EPngError = class(Exception);
  EPngUnexpectedEnd = class(Exception);
  EPngInvalidCRC = class(Exception);
  EPngInvalidIHDR = class(Exception);
  EPNGMissingMultipleIDAT = class(Exception);
  EPNGZLIBError = class(Exception);
  EPNGInvalidPalette = class(Exception);
  EPNGInvalidFileHeader = class(Exception);
  EPNGIHDRNotFirst = class(Exception);
  EPNGNotExists = class(Exception);
  EPNGSizeExceeds = class(Exception);
  EPNGMissingPalette = class(Exception);
  EPNGUnknownCriticalChunk = class(Exception);
  EPNGUnknownCompression = class(Exception);
  EPNGUnknownInterlace = class(Exception);
  EPNGNoImageData = class(Exception);
  EPNGCouldNotLoadResource = class(Exception);
  EPNGCannotChangeTransparent = class(Exception);
  EPNGHeaderNotPresent = class(Exception);
  EPNGInvalidNewSize = class(Exception);
  EPNGInvalidSpec = class(Exception);


type

  TRGBLine = array[word] of TRGBTriple;
  pRGBLine = ^TRGBLine;

  // Same as TBitmapInfo but with allocated space for palette entries
  TMAXBITMAPINFO = packed record
    bmiHeader: TBitmapInfoHeader;
    bmiColors: packed array[0..255] of TRGBQuad;
  end;

  TPNGTransparencyMode = (ptmNone, ptmBit, ptmPartial);
  pCardinal = ^Cardinal;
  pRGBPixel = ^TRGBPixel;
  TRGBPixel = packed record
    B, G, R: Byte;
  end;

  TByteArray = array[Word] of Byte;
  pByteArray = ^TByteArray;

  TGMPngImage = class;
  pPointerArray = ^TPointerArray;
  TPointerArray = array[Word] of Pointer;


  TChunk = class;
  TChunkClass = class of TChunk;

  TChunkList = class(TObject)
  private
    FOwner: TGMPngImage;
    FEntries: array of TChunk;

    function GetItem(const AIndex: LongInt): TChunk;
    procedure SetItem(const AIndex: LongInt; const AValue: TChunk);
    function GetCount: LongInt;
    procedure SetCount(const AValue: LongInt);

  public
    constructor Create(const AOwner: TGMPngImage);
    function FindChunk(const ChunkClass: TChunkClass): TChunk;

    procedure RemoveChunk(const Chunk: TChunk); overload;
    procedure Insert(const AChunk: TChunk; const APosition: LongInt);
    procedure Add(const AChunk: TChunk);
    function AddByClass(const ChunkClass: TChunkClass): TChunk;
    function ItemFromClass(ChunkClass: TChunkClass): TChunk;
    property Item [const Idx: LongInt]: TChunk read GetItem write SetItem;
    property Owner: TGMPngImage read FOwner;
    property Count: LongInt read GetCount write SetCount;
  end;


  TChunkIHDR = class;
  TChunkpHYs = class;
  TInterlaceMethod = (imNone, imAdam7);
  TCompressionLevel = 0..9;
  TPNGFilter = (pfNone, pfSub, pfUp, pfAverage, pfPaeth);
  TPNGFilters = set of TPNGFilter;

  IGMPngImage = interface(IUnknown)
    ['{751BBD8E-EB62-4349-B936-AB69527EA497}']
    function Obj: TGMPngImage;
  end;

  TGMPngImage = class(TGMRefCountedObj, IGMPngImage){$IFDEF UseDelphi}(TGraphic){$ENDIF}
  protected
    FInverseGamma: array[Byte] of Byte;

    {$IFDEF UseDelphi}FCanvas: TCanvas;{$ENDIF}
    FFilters: TPNGFilters;
    FCompressionLevel: TCompressionLevel;
    FMaxIdatSize: LongWord;
    FInterlaceMethod: TInterlaceMethod;
    FChunkList: TChunkList;
    procedure ClearChunks;
    function HeaderPresent: Boolean;
    procedure GetPixelInfo(var LineSize, Offset: Cardinal);
    procedure SetMaxIdatSize(const Value: LongWord);
    function GetAlphaScanline(const LineIndex: Integer): pByteArray;
    function GetScanline(const LineIndex: Integer): Pointer;
    {$IFDEF Store16bits}
    function GetExtraScanline(const LineIndex: Integer): Pointer;
    {$ENDIF}
    function GetPixelInformation: TChunkpHYs;
    function GetTransparencyMode: TPNGTransparencyMode;
    function GetTransparentColor: TColor;
    procedure SetTransparentColor(const Value: TColor);
    //function GetLibraryVersion: String;
    procedure InitializeGamma;
  protected
    FBeingCreated: Boolean;
    //function GetSupportsPartialTransparency: Boolean; override;
    function GetPalette: HPALETTE; {$IFDEF UseDelphi}override;{$ENDIF}
    procedure SetPalette(Value: HPALETTE); {$IFDEF UseDelphi}override;{$ENDIF}
    procedure DoSetPalette(Value: HPALETTE; const UpdateColors: Boolean);
    function GetWidth: Integer; {$IFDEF UseDelphi}override;{$ENDIF}
    function GetHeight: Integer; {$IFDEF UseDelphi}override; {$ENDIF}
    procedure SetWidth(Value: Integer);  {$IFDEF UseDelphi}override; {$ENDIF}
    procedure SetHeight(Value: Integer);  {$IFDEF UseDelphi}override;{$ENDIF}
    procedure AssignPNG(Source: TGMPngImage);
    function GetEmpty: Boolean; {$IFDEF UseDelphi}override; {$ENDIF}
    function GetHeader: TChunkIHDR;
    procedure DrawPartialTrans(DC: HDC; Rect: TRect);
    {$IFDEF UseDelphi}
    function GetTransparent: Boolean; override;
    {$ENDIF}
    function GetPixels(const X, Y: Integer): TColor; virtual;
    procedure SetPixels(const X, Y: Integer; const Value: TColor); virtual;

  public
    GammaTable: array[Byte] of Byte;

    constructor Create(const ARefLifeTime: Boolean = True); override;
    constructor CreateBlank(ColorType, Bitdepth: Cardinal; cx, cy: Integer; const ARefLifeTime: Boolean = True);
    destructor Destroy; override;

    function Obj: TGMPngImage;
    procedure Resize(const CX, CY: Integer);
    procedure CreateAlpha;
    procedure RemoveTransparency;
    property TransparentColor: TColor read GetTransparentColor write SetTransparentColor;
    procedure AddtEXt(const Keyword, Text: AnsiString);
    procedure AddzTXt(const Keyword, Text: AnsiString);

    function Size: TPoint;
    {$IFDEF UseDelphi}
    procedure SaveToClipboardGMFormat(var AFormat: Word; var AData: THandle; var APalette: HPalette); override;
    procedure LoadFromClipboardGMFormat(AFormat: Word; AData: THandle; APalette: HPalette); override;
    {$ENDIF}
    procedure RaiseError(ExceptionClass: ExceptClass; Text: String);
    property Scanline[const Index: Integer]: Pointer read GetScanline;
    {$IFDEF Store16bits}
    property ExtraScanline[const Index: Integer]: Pointer read GetExtraScanline;
    {$ENDIF}
    {Used to return pixel information}
    function HasPixelInformation: Boolean;
    property PixelInformation: TChunkpHYs read GetPixelInformation;
    property AlphaScanline[const Index: Integer]: pByteArray read GetAlphaScanline;
    procedure DrawUsingPixelInformation(Canvas: TCanvas; Point: TPoint);

    {$IFDEF UseDelphi}property Canvas: TCanvas read FCanvas;{$ENDIF}
    property Header: TChunkIHDR read GetHeader;
    property TransparencyMode: TPNGTransparencyMode read GetTransparencyMode;
    procedure Assign(Source: TPersistent);{$IFDEF UseDelphi}override;{$ENDIF}
    procedure AssignTo(Dest: TPersistent);{$IFDEF UseDelphi}override;{$ENDIF}
    procedure AssignHandle(Handle: HBitmap; Transparent: Boolean; TransparentColor: ColorRef);
    procedure Draw(ACanvas: TCanvas; const Rect: TRect); {$IFDEF UseDelphi}override;{$ENDIF}
    property Width: Integer read GetWidth;
    property Height: Integer read GetHeight;
    property InterlaceMethod: TInterlaceMethod read FInterlaceMethod write FInterlaceMethod;
    property Filters: TPNGFilters read FFilters write FFilters;
    property MaxIdatSize: LongWord read FMaxIdatSize write SetMaxIdatSize;
    property Empty: Boolean read GetEmpty;
    property CompressionLevel: TCompressionLevel read FCompressionLevel write FCompressionLevel;
    property Chunks: TChunkList read FChunkList;
    // {$IFNDEF UseDelphi}procedure LoadFromFile(const Filename: String);{.$ENDIF}
    // {$IFNDEF UseDelphi}procedure SaveToFile(const Filename: String);{.$ENDIF}
    procedure LoadFromStream(Stream: IStream); {$IFDEF UseDelphi}override;{$ENDIF}
    procedure SaveToStream(Stream: IStream); {$IFDEF UseDelphi}override;{$ENDIF}
    //procedure LoadFromResourceName(Instance: HInst; const Name: String);
    //procedure LoadFromResourceID(Instance: HInst; ResID: Integer);
    {Access to the png pixels}
    property Pixels[const X, Y: Integer]: TColor read GetPixels write SetPixels;
    {$IFNDEF UseDelphi}property Palette: HPalette read GetPalette write SetPalette;{$ENDIF}
    //property Version: String read GetLibraryVersion;
  end;

  
  TChunkName = array[0..3] of AnsiChar;

  TChunk = class
  private
    FData: Pointer;
    FDataSize: Cardinal;
    FOwner: TGMPngImage;
    FName: TChunkName;

    function GetHeader: TChunkIHDR;
    function GetIndex: Integer;

  public
    property Index: Integer read GetIndex;
    property Header: TChunkIHDR read GetHeader;
    procedure ResizeData(const NewSize: Cardinal);
    property Data: Pointer read FData;
    property DataSize: Cardinal read FDataSize;
    procedure Assign(Source: TChunk); virtual;
    property Owner: TGMPngImage read FOwner;
    constructor Create(Owner: TGMPngImage); virtual;
    destructor Destroy; override;

    function LoadFromStream(Stream: IStream; const ChunkName: TChunkName; Size: Integer): Boolean; virtual;
    function SaveData(Stream: IStream): Boolean;
    function SaveToStream(Stream: IStream): Boolean; virtual;
  end;

  TChunkIEND = class(TChunk);

  pIHDRData = ^TIHDRData;
  TIHDRData = packed record
    Width, Height: Cardinal;
    BitDepth,
    ColorType,
    CompressionMethod,
    FilterMethod,
    InterlaceMethod: Byte;
  end;

  TChunkIHDR = class(TChunk)
  private
    FImageHandle: HBitmap;
    FImageDC: HDC;
    FImagePalette: HPalette;
    FHasPalette: Boolean;
    FBitmapInfo: TMaxBitmapInfo;
    {$IFDEF Store16bits}FExtraImageData: Pointer;{$ENDIF}
    FImageData: pointer;
    FImageAlpha: Pointer;
    FIHDRData: TIHDRData;

  protected
    BytesPerRow: Integer;
    function CreateGrayscalePalette(Bitdepth: Integer): HPalette;
    procedure PaletteToDIB(Palette: HPalette);
    procedure PrepareImageData;
    procedure FreeImageData;
  public
    {Access to FImageHandle}
    property ImageHandleValue: HBitmap read FImageHandle;
    {Properties}
    property Width: Cardinal read FIHDRData.Width write FIHDRData.Width;
    property Height: Cardinal read FIHDRData.Height write FIHDRData.Height;
    property BitDepth: Byte read FIHDRData.BitDepth write FIHDRData.BitDepth;
    property ColorType: Byte read FIHDRData.ColorType write FIHDRData.ColorType;
    property CompressionMethod: Byte read FIHDRData.CompressionMethod write FIHDRData.CompressionMethod;
    property FilterMethod: Byte read FIHDRData.FilterMethod write FIHDRData.FilterMethod;
    property InterlaceMethod: Byte read FIHDRData.InterlaceMethod write FIHDRData.InterlaceMethod;
    function LoadFromStream(Stream: IStream; const ChunkName: TChunkName; Size: Integer): Boolean; override;
    function SaveToStream(Stream: IStream): Boolean; override;
    constructor Create(Owner: TGMPngImage); override;
    destructor Destroy; override;
    procedure Assign(Source: TChunk); override;
    property ImageDC_: HDC read FImageDC;
  end;

  pUnitType = ^TUnitType;
  TUnitType = (utUnknown, utMeter);
  TChunkpHYs = class(TChunk)
  private
    FPPUnitX, FPPUnitY: Cardinal;
    FUnit: TUnitType;
  public
    property PPUnitX: Cardinal read FPPUnitX write FPPUnitX;
    property PPUnitY: Cardinal read FPPUnitY write FPPUnitY;
    property UnitType: TUnitType read FUnit write FUnit;
    function LoadFromStream(Stream: IStream; const ChunkName: TChunkName; Size: Integer): Boolean; override;
    function SaveToStream(Stream: IStream): Boolean; override;
    procedure Assign(Source: TChunk); override;
  end;

  TChunkgAMA = class(TChunk)
  private
    function GetValue: Cardinal;
    procedure SetValue(const Value: Cardinal);
  public
    property Gamma: Cardinal read GetValue write SetValue;
    function LoadFromStream(Stream: IStream; const ChunkName: TChunkName; Size: Integer): Boolean; override;
    constructor Create(Owner: TGMPngImage); override;
    procedure Assign(Source: TChunk); override;
  end;

  TZStreamRec2 = packed record
    ZLIB: TZStreamRec;
    // Additional info
    Data: Pointer;
    fStream   : IStream;
  end;

  TChunkPLTE = class(TChunk)
  protected
    FCount: Integer;
  private
    function GetPaletteItem(Index: Byte): TRGBQuad;
  public
    property Item[Index: Byte]: TRGBQuad read GetPaletteItem;
    property Count: Integer read FCount;
    function LoadFromStream(Stream: IStream; const ChunkName: TChunkName; Size: Integer): Boolean; override;
    function SaveToStream(Stream: IStream): Boolean; override;
    procedure Assign(Source: TChunk); override;
  end;

  TChunktRNS = class(TChunk)
  private
    FBitTransparency: Boolean;
    function GetTransparentColor: ColorRef;
    procedure SetTransparentColor(const Value: ColorRef);
  public
    PaletteValues: array[Byte] of Byte;
    property BitTransparency: Boolean read FBitTransparency;
    property TransparentColor: ColorRef read GetTransparentColor write SetTransparentColor;
    function LoadFromStream(Stream: IStream; const ChunkName: TChunkName; Size: Integer): Boolean; override;
    function SaveToStream(Stream: IStream): Boolean; override;
    procedure Assign(Source: TChunk); override;
  end;

  TChunkIDAT = class(TChunk)
  private
    Header: TChunkIHDR;
    ImageWidth, ImageHeight: Integer;
    Row_Bytes, Offset : Cardinal;
    Encode_Buffer: array[0..5] of pByteArray;
    Row_Buffer: array[Boolean] of pByteArray;
    RowUsed: Boolean;
    EndPos: Integer;

    procedure FilterRow;
    function FilterToEncode: Byte;
    function IDATZlibRead(var ZLIBStream: TZStreamRec2; Buffer: Pointer; Count: LongWord; var EndPos: Integer; var crcfile: Cardinal): Integer;
    procedure IDATZlibWrite(var ZLIBStream: TZStreamRec2; Buffer: Pointer; const Length: Cardinal);
    procedure FinishIDATZlib(var ZLIBStream: TZStreamRec2);
    procedure PreparePalette;

  protected
    procedure DecodeInterlacedAdam7(Stream: IStream; var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: Cardinal);
    procedure DecodeNonInterlaced(Stream: IStream; var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: Cardinal);
    procedure EncodeNonInterlaced(Stream: IStream; var ZLIBStream: TZStreamRec2);
    procedure EncodeInterlacedAdam7(Stream: IStream; var ZLIBStream: TZStreamRec2);

    // Memory copy methods to decode
    procedure CopyNonInterlacedRGB8(Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
    procedure CopyNonInterlacedRGB16(Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
    procedure CopyNonInterlacedPalette148(Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
    procedure CopyNonInterlacedPalette2(Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
    procedure CopyNonInterlacedGray2(Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
    procedure CopyNonInterlacedGrayscale16(Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
    procedure CopyNonInterlacedRGBAlpha8(Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
    procedure CopyNonInterlacedRGBAlpha16(Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
    procedure CopyNonInterlacedGrayscaleAlpha8(Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
    procedure CopyNonInterlacedGrayscaleAlpha16(Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
    procedure CopyInterlacedRGB8(const Pass: Byte; Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
    procedure CopyInterlacedRGB16(const Pass: Byte; Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
    procedure CopyInterlacedPalette148(const Pass: Byte; Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
    procedure CopyInterlacedPalette2(const Pass: Byte; Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
    procedure CopyInterlacedGray2(const Pass: Byte; Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
    procedure CopyInterlacedGrayscale16(const Pass: Byte; Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
    procedure CopyInterlacedRGBAlpha8(const Pass: Byte; Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
    procedure CopyInterlacedRGBAlpha16(const Pass: Byte; Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
    procedure CopyInterlacedGrayscaleAlpha8(const Pass: Byte; Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
    procedure CopyInterlacedGrayscaleAlpha16(const Pass: Byte; Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);

    // Memory copy methods to encode
    procedure EncodeNonInterlacedRGB8(Src, Dest, Trans: pByte);
    procedure EncodeNonInterlacedRGB16(Src, Dest, Trans: pByte);
    procedure EncodeNonInterlacedGrayscale16(Src, Dest, Trans: pByte);
    procedure EncodeNonInterlacedPalette148(Src, Dest, Trans: pByte);
    procedure EncodeNonInterlacedRGBAlpha8(Src, Dest, Trans: pByte);
    procedure EncodeNonInterlacedRGBAlpha16(Src, Dest, Trans: pByte);
    procedure EncodeNonInterlacedGrayscaleAlpha8(Src, Dest, Trans: pByte);
    procedure EncodeNonInterlacedGrayscaleAlpha16(Src, Dest, Trans: pByte);
    procedure EncodeInterlacedRGB8(const Pass: Byte; Src, Dest, Trans: pByte);
    procedure EncodeInterlacedRGB16(const Pass: Byte; Src, Dest, Trans: pByte);
    procedure EncodeInterlacedPalette148(const Pass: Byte; Src, Dest, Trans: pByte);
    procedure EncodeInterlacedGrayscale16(const Pass: Byte; Src, Dest, Trans: pByte);
    procedure EncodeInterlacedRGBAlpha8(const Pass: Byte; Src, Dest, Trans: pByte);
    procedure EncodeInterlacedRGBAlpha16(const Pass: Byte; Src, Dest, Trans: pByte);
    procedure EncodeInterlacedGrayscaleAlpha8(const Pass: Byte; Src, Dest, Trans: pByte);
    procedure EncodeInterlacedGrayscaleAlpha16(const Pass: Byte; Src, Dest, Trans: pByte);
    
  public
    function LoadFromStream(Stream: IStream; const ChunkName: TChunkName; Size: Integer): Boolean; override;
    function SaveToStream(Stream: IStream): Boolean; override;
  end;

  // Image last modification chunk
  TChunktIME = class(TChunk)
  private
    FYear: Word;
    FMonth, FDay, FHour, FMinute, FSecond: Byte;
  public
    property Year: Word read FYear write FYear;
    property Month: Byte read FMonth write FMonth;
    property Day: Byte read FDay write FDay;
    property Hour: Byte read FHour write FHour;
    property Minute: Byte read FMinute write FMinute;
    property Second: Byte read FSecond write FSecond;
    function LoadFromStream(Stream: IStream; const ChunkName: TChunkName; Size: Integer): Boolean; override;
    function SaveToStream(Stream: IStream): Boolean; override;
    procedure Assign(Source: TChunk); override;
  end;

  // Textual data
  TChunktEXt = class(TChunk)
  private
    FKeyword, FText: AnsiString;
  public
    property Keyword: AnsiString read FKeyword write FKeyword;
    property Text: AnsiString read FText write FText;
    function LoadFromStream(Stream: IStream; const ChunkName: TChunkName; Size: Integer): Boolean; override;
    function SaveToStream(Stream: IStream): Boolean; override;
    procedure Assign(Source: TChunk); override;
  end;

  {zTXT chunk}
  TChunkzTXt = class(TChunktEXt)
    {Loads the chunk from a stream}
    function LoadFromStream(Stream: IStream; const ChunkName: TChunkName;
      Size: Integer): Boolean; override;
    {Saves the chunk to a stream}
    function SaveToStream(Stream: IStream): Boolean; override;
  end;

{Here we test if it's c++ builder or delphi version 3 or less}
{$IFDEF VER110}{$DEFINE DelphiBuilder3Less}{$ENDIF}
{$IFDEF VER100}{$DEFINE DelphiBuilder3Less}{$ENDIF}
{$IFDEF VER93}{$DEFINE DelphiBuilder3Less}{$ENDIF}
{$IFDEF VER90}{$DEFINE DelphiBuilder3Less}{$ENDIF}
{$IFDEF VER80}{$DEFINE DelphiBuilder3Less}{$ENDIF}


function update_crc(crc: {$IFNDEF DelphiBuilder3Less}Cardinal{$ELSE}Integer {$ENDIF}; buf: pByteArray; len: Integer): Cardinal;
function ByteSwap(const a: integer): integer;
function GMLoadPngImgFromRes(const AResourceName: PChar;
                             AResourceType: PChar = nil;
                             AModuleHandle: THandle = INVALID_HANDLE_VALUE): IGMPngImage;


implementation

uses GMCommon;

resourcestring

  EPngInvalidCRCText = 'This PNG image is not valid because it contains invalid pieces of data (crc error)';
  EPNGInvalidIHDRText = 'The PNG image could not be loaded because one of its main piece of data (ihdr) might be corrupted';
  EPNGMissingMultipleIDATText = 'This PNG image is invalid because it has missing image parts';
  EPNGZLIBErrorText = 'Could not decompress the image because it contains invalid compressed data.'#13#10 + ' Description: ';
  EPNGInvalidPaletteText = 'The PNG image contains an invalid palette';
  EPNGInvalidFileHeaderText = 'The file being readed is not a valid PNG image because it contains an invalid header. This file may be corruped, try obtaining it again';
  EPNGIHDRNotFirstText = 'This PNG image is not supported or it might be invalid.'#13#10 + '(IHDR chunk is not the first)';
  EPNGNotExistsText = 'The png file could not be loaded because it does not exists';
  EPNGSizeExceedsText = 'This PNG image is not supported because either it''s width or height exceeds the maximum size, which is 65535 pixels length';
  EPNGUnknownPalEntryText = 'There is no such palette entry';
  EPNGMissingPaletteText = 'This PNG could not be loaded because it uses a color table which is missing';
  EPNGUnknownCriticalChunkText = 'This PNG image contains an unknown critical part which could not be decoded';
  EPNGUnknownCompressionText = 'This PNG image is encoded with an unknown compression scheme which could not be decoded';
  EPNGUnknownInterlaceText = 'This PNG image uses an unknown interlace scheme which could not be decoded';
  EPNGCannotAssignChunkText = 'The chunks must be compatible to be assigned';
  EPNGUnexpectedEndText = 'This PNG image is invalid because the decoder found an unexpected end of the file';
  EPNGNoImageDataText = 'This PNG image contains no data';
  EPNGCannotChangeSizeText = 'The PNG image can not be resize by changing width and height properties. Try assigning the image from a bitmap';
  EPNGCannotAddChunkText = 'The program tried to add a existent critical chunk to the current image which is not allowed';
  EPNGCannotAddInvalidImageText = 'It''s not allowed to add a new chunk because the current image is invalid';
  EPNGCouldNotLoadResourceText = 'The png image could not be loaded from the resource ID';
  EPNGOutMemoryText = 'Some operation could not be performed because the system is out of resources. Close some windows and try again';
  EPNGCannotChangeTransparentText = 'Setting bit transparency color is not allowed for png images containing alpha value for each pixel (COLOR_RGBALPHA and COLOR_GRAYSCALEALPHA)';
  EPNGHeaderNotPresentText = 'This operation is not valid because the current image contains no valid header';
  EInvalidNewSizeText = 'The new size provided for image resizing is invalid';
  EInvalidSpecText = 'The PNG image could not be created because invalid image type parameters have being provided';


var

  crc_table: array[0..255] of Cardinal;
  crc_table_computed: Boolean;


function GMLoadPngImgFromRes(const AResourceName: PChar; AResourceType: PChar; AModuleHandle: THandle): IGMPngImage;
var ResStrm: IStream;
begin
  if AResourceName <> nil then
   begin
    if AResourceType = nil then AResourceType := cResTypePngImg;
    if AModuleHandle = INVALID_HANDLE_VALUE then AModuleHandle := HInstance;
    ResStrm := TGMResourceIStream.Create(AResourceName, AResourceType, AModuleHandle, True);
    Result := TGMPngImage.Create(True);
    Result.Obj.LoadFromStream(ResStrm);
   end;
end;


{Draw transparent image using transparent color}
procedure DrawTransparentBitmap(dc: HDC; srcBits: Pointer; var srcHeader: TBitmapInfoHeader;
  srcBitmapInfo: pBitmapInfo; Rect: TRect; cTransparentColor: COLORREF);
var
  cColor:   COLORREF;
  bmpBkgndMask, bmpImageMask, bmAndMem: HBITMAP;
  bmpOldBkgnd, bmpOldImage, bmpMemOld: HBITMAP;
  hdcMem, dcBkgndMask, dcImageMask, dcDraw: HDC;
  ptSize, orgSize: TPOINT;
  OldBitmap, bmpDraw: HBITMAP;
begin
  dcDraw := CreateCompatibleDC(dc);
  {Select the bitmap}
  bmpDraw := CreateDIBitmap(dc, srcHeader, CBM_INIT, srcBits, srcBitmapInfo^, DIB_RGB_COLORS);
  OldBitmap := SelectObject(dcDraw, bmpDraw);

  {Get sizes}
  OrgSize.x := abs(srcHeader.biWidth);
  OrgSize.y := abs(srcHeader.biHeight);
  ptSize.x := Rect.Right - Rect.Left;        // Get width of bitmap
  ptSize.y := Rect.Bottom - Rect.Top;        // Get height of bitmap

  {Create some DCs to hold temporary data}
  dcBkgndMask  := CreateCompatibleDC(dc);
  dcImageMask := CreateCompatibleDC(dc);
  hdcMem   := CreateCompatibleDC(dc);

  // Create a bitmap for each DC. DCs are required for a number of
  // GDI functions.

  // Monochrome DCs
  bmpBkgndMask  := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil);
  bmpImageMask := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil);

  bmAndMem   := CreateCompatibleBitmap(dc, ptSize.x, ptSize.y);

  // Each DC must select a bitmap object to store pixel data.
  bmpOldBkgnd  := SelectObject(dcBkgndMask, bmpBkgndMask);
  bmpOldImage := SelectObject(dcImageMask, bmpImageMask);
  bmpMemOld   := SelectObject(hdcMem, bmAndMem);

  // Set the background color of the source DC to the color
  // contained in the parts of the bitmap that should be transparent
  cColor := SetBkColor(dcDraw, cTransparentColor);

  // Create the object mask for the bitmap by performing a BitBlt
  // from the source bitmap to a monochrome bitmap.  
  StretchBlt(dcImageMask, 0, 0, ptSize.x, ptSize.y, dcDraw, 0, 0, orgSize.x, orgSize.y, SRCCOPY);

  // Set the background color of the source DC back to the original color.
  SetBkColor(dcDraw, cColor);

  // Create the inverse of the object mask.
  BitBlt(dcBkgndMask, 0, 0, ptSize.x, ptSize.y, dcImageMask, 0, 0, NOTSRCCOPY);

  // Copy the background of the main DC to the destination.
  BitBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, dc, Rect.Left, Rect.Top, SRCCOPY);

  // Mask out the places where the bitmap will be placed.
  BitBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, dcImageMask, 0, 0, SRCAND);

  // Mask out the transparent colored pixels on the bitmap.
  // BitBlt(dcDraw, 0, 0, ptSize.x, ptSize.y, dcBkgndMask, 0, 0, SRCAND);
  StretchBlt(dcDraw, 0, 0, OrgSize.x, OrgSize.y, dcBkgndMask, 0, 0, PtSize.x, PtSize.y, SRCAND);

  // XOR the bitmap with the background on the destination DC.
  StretchBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, dcDraw, 0, 0, OrgSize.x, OrgSize.y, SRCPAINT);

  // Copy the destination to the screen.
  BitBlt(dc, Rect.Left, Rect.Top, ptSize.x, ptSize.y, hdcMem, 0, 0, SRCCOPY);

  // Delete the memory bitmaps.
  DeleteObject(SelectObject(dcBkgndMask, bmpOldBkgnd));
  DeleteObject(SelectObject(dcImageMask, bmpOldImage));
  DeleteObject(SelectObject(hdcMem, bmpMemOld));
  DeleteObject(SelectObject(dcDraw, OldBitmap));

  // Delete the memory DCs.
  DeleteDC(hdcMem);
  DeleteDC(dcBkgndMask);
  DeleteDC(dcImageMask);
  DeleteDC(dcDraw);
end;


procedure make_crc_table;
var c: Cardinal; n, k: Integer;
begin
  for n := 0 to 255 do
   begin
    c := Cardinal(n);
    for k := 0 to 7 do if Boolean(c and 1) then c := $edb88320 xor (c shr 1) else c := c shr 1;
    crc_table[n] := c;
   end;

  crc_table_computed := true;
end;

{Update a running CRC with the bytes buf[0..len-1]--the CRC
 should be initialized to all 1's, and the transmitted value
 is the 1's complement of the final running CRC (see the
 crc() routine below)).}
function update_crc(crc: {$IFNDEF DelphiBuilder3Less}Cardinal{$ELSE}Integer {$ENDIF}; buf: pByteArray; len: Integer): Cardinal;
var c: Cardinal; n: Integer;
begin
  c := crc;
  if not crc_table_computed then make_crc_table;
  for n := 0 to len - 1 do c := crc_table[(c XOR buf^[n]) and $FF] XOR (c shr 8);
  Result := c;
end;

{$IFNDEF UseDelphi}
  function FileExists(Filename: String): Boolean;
  var FindFile: THandle; FindData: TWin32FindData;
  begin
    FindFile := FindFirstFile(PChar(Filename), FindData);
    Result := FindFile <> INVALID_HANDLE_VALUE;
    if Result then Windows.FindClose(FindFile);
  end;
{$ENDIF}


{Calculates the paeth predictor}
function PaethPredictor(a, b, c: Byte): Byte;
var pa, pb, pc: Integer;
begin
  { a = left, b = above, c = upper left }
  pa := abs(b - c);      { distances to a, b, c }
  pb := abs(a - c);
  pc := abs(a + b - c * 2);

  { return nearest of a, b, c, breaking ties in order a, b, c }
  if (pa <= pb) and (pa <= pc) then
    Result := a
  else
   if pb <= pc then Result := b else Result := c;
end;

{Invert bytes using assembly}
function ByteSwap(const a: integer): integer;
asm
  bswap eax
end;
function ByteSwap16(inp:word): word;
asm
  bswap eax
  shr   eax, 16
end;

{Calculates number of bytes for the number of pixels using the}
{color mode in the paramenter}
function BytesForPixels(const Pixels: Integer; const ColorType,
  BitDepth: Byte): Integer;
begin
  case ColorType of
    {Palette and grayscale contains a single value, for palette}
    {an value of size 2^bitdepth pointing to the palette index}
    {and grayscale the value from 0 to 2^bitdepth with color intesity}
    COLOR_GRAYSCALE, COLOR_PALETTE: Result := (Pixels * BitDepth + 7) div 8;
    {RGB contains 3 values R, G, B with size 2^bitdepth each}
    COLOR_RGB: Result := (Pixels * BitDepth * 3) div 8;
    {Contains one value followed by alpha value booth size 2^bitdepth}
    COLOR_GRAYSCALEALPHA: Result := (Pixels * BitDepth * 2) div 8;
    {Contains four values size 2^bitdepth, Red, Green, Blue and alpha}
    COLOR_RGBALPHA: Result := (Pixels * BitDepth * 4) div 8;
    else
      Result := 0;
  end; {case ColorType}
end;


function CreateChunkByClass(AOwner: TGMPngImage; AName: TChunkName): TChunk;
var ChunkCreateClass: TChunkClass;
  const cnIEND = Ord('I') + Ord('E') shl 8 + Ord('N') shl 16 + Ord('D') shl 24;
  const cnIHDR = Ord('I') + Ord('H') shl 8 + Ord('D') shl 16 + Ord('R') shl 24;
  const cnIDAT = Ord('I') + Ord('D') shl 8 + Ord('A') shl 16 + Ord('T') shl 24;
  const cnPLTE = Ord('P') + Ord('L') shl 8 + Ord('T') shl 16 + Ord('E') shl 24;
  const cngAMA = Ord('g') + Ord('A') shl 8 + Ord('M') shl 16 + Ord('A') shl 24;
  const cntRNS = Ord('t') + Ord('R') shl 8 + Ord('N') shl 16 + Ord('S') shl 24;

  const cnpHYs = Ord('p') + Ord('H') shl 8 + Ord('Y') shl 16 + Ord('s') shl 24;
  const cntIME = Ord('t') + Ord('I') shl 8 + Ord('M') shl 16 + Ord('E') shl 24;
  const cntEXt = Ord('t') + Ord('E') shl 8 + Ord('X') shl 16 + Ord('t') shl 24;
  const cnzTXt = Ord('z') + Ord('T') shl 8 + Ord('X') shl 16 + Ord('t') shl 24;
begin
  case LongWord(AName) of
   // Important chunks
   cnIEND: ChunkCreateClass := TChunkIEND;
   cnIHDR: ChunkCreateClass := TChunkIHDR;
   cnIDAT: ChunkCreateClass := TChunkIDAT;
   cnPLTE: ChunkCreateClass := TChunkPLTE;
   cngAMA: ChunkCreateClass := TChunkgAMA;
   cntRNS: ChunkCreateClass := TChunktRNS;

   // Less important chunks
   cnpHYs: ChunkCreateClass := TChunkpHYs;
   cntIME: ChunkCreateClass := TChunktIME;
   cntEXt: ChunkCreateClass := TChunktEXt;
   cnzTXt: ChunkCreateClass := TChunkzTXt;
   else ChunkCreateClass := TChunk; // <- default creation
  end;

  Result := ChunkCreateClass.Create(AOwner);
  Result.FName := AName;
end;


{ZLIB support}

const
  ZLIBAllocate = High(Word);

{Initializes ZLIB for decompression}
function ZLIBInitInflate(Stream: IStream): TZStreamRec2;
begin
  Fillchar(Result, SIZEOF(TZStreamRec2), #0);

  with Result do
   begin
    GetMem(Data, ZLIBAllocate);
    fStream := Stream;
   end;

  InflateInit_(Result.zlib, zlib_version, SIZEOF(TZStreamRec));
end;

{Initializes ZLIB for compression}
function ZLIBInitDeflate(Stream: IStream; Level: TCompressionlevel; Size: Cardinal): TZStreamRec2;
begin
  Fillchar(Result, SIZEOF(TZStreamRec2), #0);

  with Result, ZLIB do
  begin
    GetMem(Data, Size);
    fStream := Stream;
    next_out := Data;
    avail_out := Size;
  end;

  deflateInit_(Result.zlib, Level, zlib_version, sizeof(TZStreamRec));
end;

{Terminates ZLIB for compression}
procedure ZLIBTerminateDeflate(var ZLIBStream: TZStreamRec2);
begin
  {Terminates decompression}
  DeflateEnd(ZLIBStream.zlib);
  {Free internal record}
  FreeMem(ZLIBStream.Data, ZLIBAllocate);
end;

{Terminates ZLIB for decompression}
procedure ZLIBTerminateInflate(var ZLIBStream: TZStreamRec2);
begin
  {Terminates decompression}
  InflateEnd(ZLIBStream.zlib);
  {Free internal record}
  FreeMem(ZLIBStream.Data, ZLIBAllocate);
end;

{Decompresses ZLIB into a memory address}
function DecompressZLIB(const Input: Pointer; InputSize: Integer;
  var Output: Pointer; var OutputSize: LongWord;
  var ErrorOutput: String): Boolean;
var
  StreamRec : TZStreamRec;
  Buffer    : array[Byte] of Byte;
  InflateRet: Integer;
begin
  with StreamRec do
  begin
    {Initializes}
    Result := True;
    OutputSize := 0;

    {Prepares the data to decompress}
    FillChar(StreamRec, SizeOf(TZStreamRec), #0);
    InflateInit_(StreamRec, zlib_version, SIZEOF(TZStreamRec));
    next_in := Input;
    avail_in := InputSize;

    {Decodes data}
    repeat
      {In case it needs an output buffer}
      if (avail_out = 0) then
      begin
        next_out := @Buffer;
        avail_out := SizeOf(Buffer);
      end {if (avail_out = 0)};

      {Decompress and put in output}
      InflateRet := inflate(StreamRec, 0);
      if (InflateRet = Z_STREAM_END) or (InflateRet = 0) then
      begin
        {Reallocates output buffer}
        inc(OutputSize, total_out);
        if Output = nil then
          GetMem(Output, OutputSize) else ReallocMem(Output, OutputSize);
        {Copies the new data}
        CopyMemory(Ptr(PtrUInt(Output) + OutputSize - total_out),
          @Buffer, total_out);
      end {if (InflateRet = Z_STREAM_END) or (InflateRet = 0)}
      {Now tests for errors}
      else if InflateRet < 0 then
      begin
        Result := False;
        ErrorOutput := string(AnsiString(StreamRec.msg));
        InflateEnd(StreamRec);
        Exit;
      end {if InflateRet < 0}
    until InflateRet = Z_STREAM_END;

    {Terminates decompression}
    InflateEnd(StreamRec);
  end {with StreamRec}

end;

{Compresses ZLIB into a memory address}
function CompressZLIB(Input: Pointer; InputSize, CompressionLevel: Integer;
  var Output: Pointer; var OutputSize: LongWord;
  var ErrorOutput: String): Boolean;
var
  StreamRec : TZStreamRec;
  Buffer    : array[Byte] of Byte;
  DeflateRet: Integer;
begin
  with StreamRec do
  begin
    Result := True; {By default returns TRUE as everything might have gone ok}
    OutputSize := 0; {Initialize}
    {Prepares the data to compress}
    FillChar(StreamRec, SizeOf(TZStreamRec), #0);
    DeflateInit_(StreamRec, CompressionLevel,zlib_version, SIZEOF(TZStreamRec));

    next_in := Input;
    avail_in := InputSize;

    while avail_in > 0 do
    begin
      {When it needs new buffer to stores the compressed data}
      if avail_out = 0 then
      begin
        {Restore buffer}
        next_out := @Buffer;
        avail_out := SizeOf(Buffer);
      end {if avail_out = 0};

      {Compresses}
      DeflateRet := deflate(StreamRec, Z_FINISH);

      if (DeflateRet = Z_STREAM_END) or (DeflateRet = 0) then
      begin
        {Updates the output memory}
        inc(OutputSize, total_out);
        if Output = nil then
          GetMem(Output, OutputSize) else ReallocMem(Output, OutputSize);

        {Copies the new data}
        CopyMemory(Ptr(PtrUInt(Output) + OutputSize - total_out),
          @Buffer, total_out);
      end {if (InflateRet = Z_STREAM_END) or (InflateRet = 0)}
      {Now tests for errors}
      else if DeflateRet < 0 then
      begin
        Result := False;
        ErrorOutput := string(AnsiString(StreamRec.msg));
        DeflateEnd(StreamRec);
        Exit;
      end {if InflateRet < 0}

    end {while avail_in > 0};

    {Finishes compressing}
    DeflateEnd(StreamRec);
  end {with StreamRec}

end;

{TChunkList implementation}

constructor TChunkList.Create(const AOwner: TGMPngImage);
begin
  inherited Create;
  FOwner := AOwner;
end;

{Finds the first chunk of this class}
function TChunkList.FindChunk(const ChunkClass: TChunkClass): TChunk;
var i: Integer;
begin
  Result := nil;
  for i := 0 to Count - 1 do if Item[i] is ChunkClass then begin Result := Item[i]; Break; end;
end;

function TChunkList.GetCount: LongInt;
begin
  Result := Length(FEntries);
end;

procedure TChunkList.Insert(const AChunk: TChunk; const APosition: LongInt);
begin
  SetLength(FEntries, Length(FEntries)+1);
  if APosition <= High(FEntries) then System.Move(FEntries[APosition], FEntries[APosition+1], (Length(FEntries) - APosition -1) * SizeOf(TChunk));
  FEntries[APosition] := AChunk;
end;

procedure TChunkList.Add(const AChunk: TChunk);
begin
  SetLength(FEntries, Length(FEntries)+1);
  FEntries[High(FEntries)] := AChunk;
end;

function TChunkList.GetItem(const AIndex: LongInt): TChunk;
begin
  if (AIndex >= Low(FEntries)) and (AIndex <= High(FEntries)) then Result := FEntries[AIndex] else Result := nil;
end;

procedure TChunkList.SetItem(const AIndex: LongInt; const AValue: TChunk);
begin
  if (AIndex >= Low(FEntries)) and (AIndex <= High(FEntries)) then FEntries[AIndex] := AValue;
end;

procedure TChunkList.SetCount(const AValue: LongInt);
begin
  SetLength(FEntries, Length(FEntries) + 1);
end;

procedure TChunkList.RemoveChunk(const Chunk: TChunk);
var i: LongInt;
begin
  if Length(FEntries) = 0 then Exit;
  for i := Low(FEntries) to High(FEntries) do if Chunk = FEntries[i] then Break;
  if Chunk <> FEntries[i] then Exit;
  if i < High(FEntries) then System.Move(FEntries[i+1], FEntries[i], (Length(FEntries) - i-1) * SizeOf(TChunk));
  SetLength(FEntries, Length(FEntries)-1);
  Chunk.Free;
end;

function TChunkList.AddByClass(const ChunkClass: TChunkClass): TChunk;
var IHDR: TChunkIHDR; IEND: TChunkIEND; IDAT: TChunkIDAT; PLTE: TChunkPLTE;
begin
  Result := nil; {Default Result}
  {Adding these is not allowed}
  if ((ChunkClass = TChunkIHDR) or (ChunkClass = TChunkIDAT) or
    (ChunkClass = TChunkPLTE) or (ChunkClass = TChunkIEND)) and not
    (Owner.FBeingCreated) then
    FOwner.RaiseError(EPngError, EPNGCannotAddChunkText)
  {Two of these is not allowed}
  else if ((ChunkClass = TChunkgAMA) and (ItemFromClass(TChunkgAMA) <> nil)) or
     ((ChunkClass = TChunktRNS) and (ItemFromClass(TChunktRNS) <> nil)) or
     ((ChunkClass = TChunkpHYs) and (ItemFromClass(TChunkpHYs) <> nil)) then
    FOwner.RaiseError(EPngError, EPNGCannotAddChunkText)
  {There must have an IEND and IHDR chunk}
  else if ((ItemFromClass(TChunkIEND) = nil) or
    (ItemFromClass(TChunkIHDR) = nil)) and not Owner.FBeingCreated then
    FOwner.RaiseError(EPngError, EPNGCannotAddInvalidImageText)
  else
  begin
    {Get common chunks}
    IHDR := ItemFromClass(TChunkIHDR) as TChunkIHDR;
    IEND := ItemFromClass(TChunkIEND) as TChunkIEND;
    {Create new chunk}
    Result := ChunkClass.Create(Owner);
    {Add to the list}
    if (ChunkClass = TChunkgAMA) or (ChunkClass = TChunkpHYs) or
      (ChunkClass = TChunkPLTE) then
      Insert(Result, IHDR.Index + 1)
    {Header and end}
    else if (ChunkClass = TChunkIEND) then
      Insert(Result, Count)
    else if (ChunkClass = TChunkIHDR) then
      Insert(Result, 0)
    {Transparency chunk (fix by Ian Boyd)}
    else if (ChunkClass = TChunktRNS) then
    begin
      {Transparecy chunk must be after PLTE; before IDAT}
      IDAT := ItemFromClass(TChunkIDAT) as TChunkIDAT;
      PLTE := ItemFromClass(TChunkPLTE) as TChunkPLTE;

      if Assigned(PLTE) then
        Insert(Result, PLTE.Index + 1)
      else if Assigned(IDAT) then
        Insert(Result, IDAT.Index)
      else
        Insert(Result, IHDR.Index + 1)
    end
    else {All other chunks}
      Insert(Result, IEND.Index);
  end {if}
end;

function TChunkList.ItemFromClass(ChunkClass: TChunkClass): TChunk;
// Returns first item from the list using the class from parameter
var i: Integer;
begin
  Result := nil; {Initial Result}
  FOR i := 0 TO Count - 1 DO
    {Test if this item has the same class}
    if Item[i] is ChunkClass then
    begin
      {Returns this item and Exit}
      Result := Item[i];
      break;
    end {if}
end;


{TChunk implementation}

{Resizes the data}
procedure TChunk.ResizeData(const NewSize: Cardinal);
begin
  FDataSize := NewSize;
  ReallocMem(FData, NewSize + 1);
end;

{Returns index from list}
function TChunk.GetIndex: Integer;
var i: Integer;
begin
  Result := -1; {Avoiding warnings}
  {Searches in the list}
  FOR i := 0 TO Owner.Chunks.Count - 1 DO
    if Owner.Chunks.Item[i] = Self then
    begin
      {Found match}
      Result := i;
      Exit;
    end {for i}
end;

{Returns pointer to the TChunkIHDR}
function TChunk.GetHeader: TChunkIHDR;
begin
  Result := Owner.Chunks.Item[0] as TChunkIHDR;
end;

{Assigns from another TChunk}
procedure TChunk.Assign(Source: TChunk);
begin
  {Copy properties}
  FName := Source.FName;
  {Set data size and realloc}
  ResizeData(Source.FDataSize);

  {Copy data (if there's any)}
  if FDataSize > 0 then CopyMemory(FData, Source.FData, FDataSize);
end;

constructor TChunk.Create(Owner: TGMPngImage);
var ChunkName: AnsiString;
begin
  inherited Create;

  {If it's a registered class, set the chunk name based on the class}
  {name. For instance, if the class name is TChunkgAMA, the GAMA part}
  {will become the chunk name}
  ChunkName := AnsiString(Copy(ClassName, Length('TChunk') + 1, Length(ClassName)));
  if Length(ChunkName) = 4 then CopyMemory(@FName[0], @ChunkName[1], 4);

  {Initialize data holder}
  GetMem(FData, 1);
  FDataSize := 0;
  {Record owner}
  FOwner := Owner;
end;

destructor TChunk.Destroy;
begin
  FreeMem(FData, FDataSize + 1);
  inherited Destroy;
end;

function TChunk.SaveData(Stream: IStream): Boolean;
var
  ChunkSize, ChunkCRC: Cardinal;
begin
  {First, write the size for the following data in the chunk}
  ChunkSize := ByteSwap(DataSize);
  GMSafeIStreamWrite(Stream, @ChunkSize, SizeOf(ChunkSize));
  {The chunk name}
  GMSafeIStreamWrite(Stream, @FName, SizeOf(FName));
  {If there is data for the chunk, write it}
  if DataSize > 0 then GMSafeIStreamWrite(Stream, Data, DataSize);
  {Calculates and write CRC}
  ChunkCRC := update_crc($ffffffff, @FName[0], SizeOf(FName));
  ChunkCRC := Byteswap(update_crc(ChunkCRC, Data, DataSize) xor $ffffffff);
  GMSafeIStreamWrite(Stream, @ChunkCRC, SizeOf(ChunkCRC));

  {Returns that everything went ok}
  Result := TRUE;
end;

function TChunk.SaveToStream(Stream: IStream): Boolean;
begin
  Result := SaveData(Stream)
end;

function TChunk.LoadFromStream(Stream: IStream; const ChunkName: TChunkName; Size: Integer): Boolean;
var CheckCRC: Cardinal; {$IFDEF CheckCRC}RightCRC: Cardinal;{$ENDIF}
begin
  {Copies data from source}
  ResizeData(Size);
  if Size > 0 then GMSafeIStreamRead(Stream, FData, Size);
  {Reads CRC}
  GMSafeIStreamRead(Stream, @CheckCRC, SizeOf(CheckCRC));
  CheckCrc := ByteSwap(CheckCRC);

  {Check if crc readed is valid}
  {$IFDEF CheckCRC}
    RightCRC := update_crc($ffffffff, @ChunkName[0], SizeOf(ChunkName));
    RightCRC := update_crc(RightCRC, FData, Size) xor $ffffffff;
    Result := RightCRC = CheckCrc;

    {Handle CRC error}
    if not Result then
    begin
      {In case it coult not load chunk}
      Owner.RaiseError(EPngInvalidCRC, EPngInvalidCRCText);
      Exit;
    end
  {$ELSE}Result := TRUE; {$ENDIF}

end;

{TChunktIME implementation}

{Chunk being loaded from a stream}
function TChunktIME.LoadFromStream(Stream: IStream;
  const ChunkName: TChunkName; Size: Integer): Boolean;
begin
  {Let ancestor load the data}
  Result := inherited LoadFromStream(Stream, ChunkName, Size);
  if not Result or (Size <> 7) then Exit; {Size must be 7}

  {Reads data}
  FYear := ((pByte(LongInt(Data) )^) * 256)+ (pByte(LongInt(Data) + 1)^);
  FMonth := pByte(LongInt(Data) + 2)^;
  FDay := pByte(LongInt(Data) + 3)^;
  FHour := pByte(LongInt(Data) + 4)^;
  FMinute := pByte(LongInt(Data) + 5)^;
  FSecond := pByte(LongInt(Data) + 6)^;
end;

{Assigns from another TChunk}
procedure TChunktIME.Assign(Source: TChunk);
begin
  FYear := TChunktIME(Source).FYear;
  FMonth := TChunktIME(Source).FMonth;
  FDay := TChunktIME(Source).FDay;
  FHour := TChunktIME(Source).FHour;
  FMinute := TChunktIME(Source).FMinute;
  FSecond := TChunktIME(Source).FSecond;
end;

{Saving the chunk to a stream}
function TChunktIME.SaveToStream(Stream: IStream): Boolean;
begin
  {Update data}
  ResizeData(7);  {Make sure the size is 7}
  pWord(Data)^ := ByteSwap16(Year);
  pByte(LongInt(Data) + 2)^ := Month;
  pByte(LongInt(Data) + 3)^ := Day;
  pByte(LongInt(Data) + 4)^ := Hour;
  pByte(LongInt(Data) + 5)^ := Minute;
  pByte(LongInt(Data) + 6)^ := Second;

  {Let inherited save data}
  Result := inherited SaveToStream(Stream);
end;

{TChunkztXt implementation}

{Loading the chunk from a stream}
function TChunkzTXt.LoadFromStream(Stream: IStream;
  const ChunkName: TChunkName; Size: Integer): Boolean;
var
  ErrorOutput: String;
  CompressionMethod: Byte;
  Output: Pointer;
  OutputSize: LongWord;
begin
  {Load data from stream and validate}
  Result := inherited LoadFromStream(Stream, ChunkName, Size);
  if not Result or (Size < 4) then Exit;
  FKeyword := PAnsiChar(Data);  {Get keyword and compression method bellow}
  if LongInt(FKeyword) = 0 then
    CompressionMethod := pByte(Data)^
  else
    CompressionMethod := pByte(LongInt(FKeyword) + Length(FKeyword))^;
  FText := '';

  {In case the compression is 0 (only one accepted by specs), reads it}
  if CompressionMethod = 0 then
  begin
    Output := nil;
    if DecompressZLIB(PAnsiChar(LongInt(Data) + Length(FKeyword) + 2),
      Size - Length(FKeyword) - 2, Output, OutputSize, ErrorOutput) then
    begin
      SetLength(FText, OutputSize);
      CopyMemory(@FText[1], Output, OutputSize);
    end {if DecompressZLIB(...};
    FreeMem(Output);
  end {if CompressionMethod = 0}

end;

{Saving the chunk to a stream}
function TChunkztXt.SaveToStream(Stream: IStream): Boolean;
var
  Output: Pointer;
  OutputSize: LongWord;
  ErrorOutput: String;
begin
  Output := nil; {Initializes output}
  if FText = '' then FText := ' ';

  {Compresses the data}
  if CompressZLIB(@FText[1], Length(FText), Owner.CompressionLevel, Output,
    OutputSize, ErrorOutput) then
  begin
    {Size is length from keyword, plus a null character to divide}
    {plus the compression method, plus the length of the text (zlib compressed)}
    ResizeData(Cardinal(Length(FKeyword)) + 2 + OutputSize);

    Fillchar(Data^, DataSize, #0);
    {Copies the keyword data}
    if Keyword <> '' then
      CopyMemory(Data, @FKeyword[1], Length(Keyword));
    {Compression method 0 (inflate/deflate)}
    pByte(Ptr(LongInt(Data) + Length(Keyword) + 1))^ := 0;
    if OutputSize > 0 then
      CopyMemory(Ptr(LongInt(Data) + Length(Keyword) + 2), Output, OutputSize);

    {Let ancestor calculate crc and save}
    Result := SaveData(Stream);
  end {if CompressZLIB(...} else Result := False;

  {Frees output}
  if Output <> nil then FreeMem(Output)
end;

{TChunktEXt implementation}

{Assigns from another text chunk}
procedure TChunktEXt.Assign(Source: TChunk);
begin
  FKeyword := TChunktEXt(Source).FKeyword;
  FText := TChunktEXt(Source).FText;
end;

{Loading the chunk from a stream}
function TChunktEXt.LoadFromStream(Stream: IStream;
  const ChunkName: TChunkName; Size: Integer): Boolean;
begin
  {Load data from stream and validate}
  Result := inherited LoadFromStream(Stream, ChunkName, Size);
  if not Result or (Size < 3) then Exit;
  {Get text}
  FKeyword := PAnsiChar(Data);
  SetLength(FText, Size - Length(FKeyword) - 1);
  CopyMemory(@FText[1], Ptr(LongInt(Data) + Length(FKeyword) + 1),
    Length(FText));
end;

{Saving the chunk to a stream}
function TChunktEXt.SaveToStream(Stream: IStream): Boolean;
begin
  {Size is length from keyword, plus a null character to divide}
  {plus the length of the text}
  ResizeData(Length(FKeyword) + 1 + Length(FText));
  Fillchar(Data^, DataSize, #0);
  {Copy data}
  if Keyword <> '' then
    CopyMemory(Data, @FKeyword[1], Length(Keyword));
  if Text <> '' then
    CopyMemory(Ptr(LongInt(Data) + Length(Keyword) + 1), @FText[1],
      Length(Text));
  {Let ancestor calculate crc and save}
  Result := inherited SaveToStream(Stream);
end;


{TChunkIHDR implementation}

{Chunk being created}
constructor TChunkIHDR.Create(Owner: TGMPngImage);
begin
  {Prepare pointers}
  FImageHandle := 0;
  FImagePalette := 0;
  FImageDC := 0;

  {Call inherited}
  inherited Create(Owner);
end;

{Chunk being destroyed}
destructor TChunkIHDR.Destroy;
begin
  {Free memory}
  FreeImageData();

  {Calls TChunk destroy}
  inherited Destroy;
end;

{Copies the palette}
procedure CopyPalette(Source: HPALETTE; Destination: HPALETTE);
var
  PaletteSize: Integer;
  Entries: array[Byte] of TPaletteEntry;
begin
  PaletteSize := 0;
  if GetObject(Source, SizeOf(PaletteSize), @PaletteSize) = 0 then Exit;
  if PaletteSize = 0 then Exit;
  ResizePalette(Destination, PaletteSize);
  GetPaletteEntries(Source, 0, PaletteSize, Entries);
  SetPaletteEntries(Destination, 0, PaletteSize, Entries);
end;

{Assigns from another IHDR chunk}
procedure TChunkIHDR.Assign(Source: TChunk);
begin
  {Copy the IHDR data}
  if Source is TChunkIHDR then
  begin
    {Copy IHDR values}
    FIHDRData := TChunkIHDR(Source).FIHDRData;

    {Prepare to hold data by filling FBitmapInfo structure and}
    {resizing FImageData and FImageAlpha memory allocations}
    PrepareImageData();

    {Copy image data}
    CopyMemory(FImageData, TChunkIHDR(Source).FImageData,
      BytesPerRow * Integer(Height));
    CopyMemory(FImageAlpha, TChunkIHDR(Source).FImageAlpha,
      Integer(Width) * Integer(Height));

    {Copy palette colors}
    FBitmapInfo.bmiColors := TChunkIHDR(Source).FBitmapInfo.bmiColors;
    {Copy palette also}
    CopyPalette(TChunkIHDR(Source).FImagePalette, FImagePalette);
  end
  else
    Owner.RaiseError(EPNGError, EPNGCannotAssignChunkText);
end;

{Release allocated image data}
procedure TChunkIHDR.FreeImageData;
begin
  {Free old image data}
  if FImageHandle <> 0  then DeleteObject(FImageHandle);
  if FImageDC     <> 0  then DeleteDC(FImageDC);
  if FImageAlpha <> nil then FreeMem(FImageAlpha);
  if FImagePalette <> 0 then DeleteObject(FImagePalette);
  {$IFDEF Store16bits}
  if FExtraImageData <> nil then FreeMem(FExtraImageData);
  {$ENDIF}
  FImageHandle := 0; FImageDC := 0; FImageAlpha := nil; FImageData := nil;
  FImagePalette := 0; FExtraImageData := nil;
end;

{Chunk being loaded from a stream}
function TChunkIHDR.LoadFromStream(Stream: IStream; const ChunkName: TChunkName;
  Size: Integer): Boolean;
begin
  {Let TChunk load it}
  Result := inherited LoadFromStream(Stream, ChunkName, Size);
  if not Result then Exit;

  {Now check values}
  {Note: It's recommended by png specification to make sure that the size}
  {must be 13 bytes to be valid, but some images with 14 bytes were found}
  {which could be loaded by internet explorer and other tools}
  if (FDataSize < SIZEOF(TIHdrData)) then
  begin
    {Ihdr must always have at least 13 bytes}
    Result := False;
    Owner.RaiseError(EPNGInvalidIHDR, EPNGInvalidIHDRText);
    Exit;
  end;

  {Everything ok, reads IHDR}
  FIHDRData := pIHDRData(FData)^;
  FIHDRData.Width := ByteSwap(FIHDRData.Width);
  FIHDRData.Height := ByteSwap(FIHDRData.Height);

  {The width and height must not be larger than 65535 pixels}
  if (FIHDRData.Width > High(Word)) or (FIHDRData.Height > High(Word)) then
  begin
    Result := False;
    Owner.RaiseError(EPNGSizeExceeds, EPNGSizeExceedsText);
    Exit;
  end {if FIHDRData.Width > High(Word)};
  {Compression method must be 0 (inflate/deflate)}
  if (FIHDRData.CompressionMethod <> 0) then
  begin
    Result := False;
    Owner.RaiseError(EPNGUnknownCompression, EPNGUnknownCompressionText);
    Exit;
  end;
  {Interlace must be either 0 (none) or 7 (adam7)}
  if (FIHDRData.InterlaceMethod <> 0) and (FIHDRData.InterlaceMethod <> 1) then
  begin
    Result := False;
    Owner.RaiseError(EPNGUnknownInterlace, EPNGUnknownInterlaceText);
    Exit;
  end;

  {Updates owner properties}
  Owner.InterlaceMethod := TInterlaceMethod(FIHDRData.InterlaceMethod);

  {Prepares data to hold image}
  PrepareImageData();
end;

{Saving the IHDR chunk to a stream}
function TChunkIHDR.SaveToStream(Stream: IStream): Boolean;
begin
  {Ignore 2 bits images}
  if BitDepth = 2 then BitDepth := 4;

  {It needs to do is update the data with the IHDR data}
  {structure containing the write values}
  ResizeData(SizeOf(TIHDRData));
  pIHDRData(FData)^ := FIHDRData;
  {..byteswap 4 byte types}
  pIHDRData(FData)^.Width := ByteSwap(pIHDRData(FData)^.Width);
  pIHDRData(FData)^.Height := ByteSwap(pIHDRData(FData)^.Height);
  {..update interlace method}
  pIHDRData(FData)^.InterlaceMethod := Byte(Owner.InterlaceMethod);
  {..and then let the ancestor SaveToStream do the hard work}
  Result := inherited SaveToStream(Stream);
end;

{Creates a grayscale palette}
function TChunkIHDR.CreateGrayscalePalette(Bitdepth: Integer): HPalette;
var
  j: Integer;
  palEntries: TMaxLogPalette;
begin
  {Prepares and fills the strucutre}
  if Bitdepth = 16 then Bitdepth := 8;
  fillchar(palEntries, sizeof(palEntries), 0);
  palEntries.palVersion := $300;
  palEntries.palNumEntries := 1 shl Bitdepth;
  {Fill it with grayscale colors}
  for j := 0 to palEntries.palNumEntries - 1 do
  begin
    palEntries.palPalEntry[j].peRed  :=
      FOwner.GammaTable[MulDiv(j, 255, palEntries.palNumEntries - 1)];
    palEntries.palPalEntry[j].peGreen := palEntries.palPalEntry[j].peRed;
    palEntries.palPalEntry[j].peBlue := palEntries.palPalEntry[j].peRed;
  end;
  {Creates and returns the palette}
  Result := CreatePalette(pLogPalette(@palEntries)^);
end;

{Copies the palette to the Device Independent bitmap header}
procedure TChunkIHDR.PaletteToDIB(Palette: HPalette);
var
  j: Integer;
  palEntries: TMaxLogPalette;
begin
  {Copy colors}
  Fillchar(palEntries, sizeof(palEntries), #0);
  FBitmapInfo.bmiHeader.biClrUsed := GetPaletteEntries(Palette, 0, 256, palEntries.palPalEntry[0]);
  for j := 0 to FBitmapInfo.bmiHeader.biClrUsed - 1 do
  begin
    FBitmapInfo.bmiColors[j].rgbBlue  := palEntries.palPalEntry[j].peBlue;
    FBitmapInfo.bmiColors[j].rgbRed   := palEntries.palPalEntry[j].peRed;
    FBitmapInfo.bmiColors[j].rgbGreen := palEntries.palPalEntry[j].peGreen;
  end;
end;

{Resizes the image data to fill the color type, bit depth, }
{width and height parameters}
procedure TChunkIHDR.PrepareImageData();
  {Set the bitmap info}
  procedure SetInfo(const Bitdepth: Integer; const Palette: Boolean);
  begin

    {Copy if the bitmap contain palette entries}
    FHasPalette := Palette;
    {Fill the strucutre}
    with FBitmapInfo.bmiHeader do
    begin
      biSize := sizeof(TBitmapInfoHeader);
      biHeight := Height;
      biWidth := Width;
      biPlanes := 1;
      biBitCount := BitDepth;
      biCompression := BI_RGB;
    end {with FBitmapInfo.bmiHeader}
  end;
begin
  {Prepare bitmap info header}
  Fillchar(FBitmapInfo, sizeof(TMaxBitmapInfo), #0);
  {Release old image data}
  FreeImageData();

  {Obtain number of bits for each pixel}
  case ColorType of
    COLOR_GRAYSCALE, COLOR_PALETTE, COLOR_GRAYSCALEALPHA:
      case BitDepth of
        {These are supported by windows}
        1, 4, 8: SetInfo(BitDepth, TRUE);
        {2 bits for each pixel is not supported by windows bitmap}
        2      : SetInfo(4, TRUE);
        {Also 16 bits (2 bytes) for each pixel is not supported}
        {and should be transormed into a 8 bit grayscale}
        16     : SetInfo(8, TRUE);
      end;
    {Only 1 byte (8 bits) is supported}
    COLOR_RGB, COLOR_RGBALPHA:  SetInfo(24, FALSE);
  end {case ColorType};
  {Number of bytes for each scanline}
  BytesPerRow := (((FBitmapInfo.bmiHeader.biBitCount * Width) + 31)
    and not 31) div 8;

  {Build array for alpha information, if necessary}
  if (ColorType = COLOR_RGBALPHA) or (ColorType = COLOR_GRAYSCALEALPHA) then
  begin
    GetMem(FImageAlpha, Integer(Width) * Integer(Height));
    FillChar(FImageAlpha^, Integer(Width) * Integer(Height), #0);
  end;

  {Build array for extra byte information}
  {$IFDEF Store16bits}
  if (BitDepth = 16) then
  begin
    GetMem(FExtraImageData, BytesPerRow * Integer(Height));
    FillChar(FExtraImageData^, BytesPerRow * Integer(Height), #0);
  end;
  {$ENDIF}

  {Creates the image to hold the data, CreateDIBSection does a better}
  {work in allocating necessary memory}
  FImageDC := CreateCompatibleDC(0);
  {$IFDEF UseDelphi}Self.Owner.Canvas.Handle := FImageDC;{$ENDIF}

  {In case it is a palette image, create the palette}
  if FHasPalette then
  begin
    {Create a standard palette}
    if ColorType = COLOR_PALETTE then
      FImagePalette := CreateHalfTonePalette(FImageDC)
    else
      FImagePalette := CreateGrayscalePalette(Bitdepth);
    ResizePalette(FImagePalette, 1 shl FBitmapInfo.bmiHeader.biBitCount);
    FBitmapInfo.bmiHeader.biClrUsed := 1 shl FBitmapInfo.bmiHeader.biBitCount;
    SelectPalette(FImageDC, FImagePalette, False);
    RealizePalette(FImageDC);
    PaletteTODIB(FImagePalette);
  end;

  {Create the device independent bitmap}
  FImageHandle := CreateDIBSection(FImageDC, pBitmapInfo(@FBitmapInfo)^,
    DIB_RGB_COLORS, FImageData, 0, 0);
  SelectObject(FImageDC, FImageHandle);

  {Build array and allocate bytes for each row}
  fillchar(FImageData^, BytesPerRow * Integer(Height), 0);
end;

{TChunktRNS implementation}

{$IFNDEF UseDelphi}
function CompareMem(P1, P2: pByte; const Size: Integer): Boolean;
var i: Integer;
begin
  Result := True;
  for i := 1 to Size do
  begin
    if P1^ <> P2^ then Result := False;
    inc(P1); inc(P2);
  end {for i}
end;
{$ENDIF}

{Sets the transpararent color}
procedure TChunktRNS.SetTransparentColor(const Value: ColorRef);
var
  i: Byte;
  LookColor: TRGBQuad;
begin
  {Clears the palette values}
  Fillchar(PaletteValues, SizeOf(PaletteValues), #0);
  {Sets that it uses bit transparency}
  FBitTransparency := True;


  {Depends on the color type}
  with Header do
    case ColorType of
      COLOR_GRAYSCALE:
      begin
        Self.ResizeData(2);
        pWord(@PaletteValues[0])^ := ByteSwap16(GetRValue(Value));
      end;
      COLOR_RGB:
      begin
        Self.ResizeData(6);
        pWord(@PaletteValues[0])^ := ByteSwap16(GetRValue(Value));
        pWord(@PaletteValues[2])^ := ByteSwap16(GetGValue(Value));
        pWord(@PaletteValues[4])^ := ByteSwap16(GetBValue(Value));
      end;
      COLOR_PALETTE:
      begin
        {Creates a RGBQuad to search for the color}
        LookColor.rgbRed := GetRValue(Value);
        LookColor.rgbGreen := GetGValue(Value);
        LookColor.rgbBlue := GetBValue(Value);
        {Look in the table for the entry}
        for i := 0 to FBitmapInfo.bmiHeader.biClrUsed - 1 do
          if CompareMem(@FBitmapInfo.bmiColors[i], @LookColor, 3) then
            Break;
        {Fill the transparency table}
        Fillchar(PaletteValues, i, 255);
        Self.ResizeData(i + 1)

      end
    end {case / with};

end;

{Returns the transparent color for the image}
function TChunktRNS.GetTransparentColor: ColorRef;
var
  PaletteChunk: TChunkPLTE;
  i: Integer;
  Value: Byte;
begin
  Result := 0; {Default: Unknown transparent color}

  {Depends on the color type}
  with Header do
    case ColorType of
      COLOR_GRAYSCALE:
      begin
        Value := FBitmapInfo.bmiColors[PaletteValues[1]].rgbRed;
        Result := RGB(Value, Value, Value);
      end;
      COLOR_RGB:
        Result := RGB(FOwner.GammaTable[PaletteValues[1]],
        FOwner.GammaTable[PaletteValues[3]],
        FOwner.GammaTable[PaletteValues[5]]);
      COLOR_PALETTE:
      begin
        {Obtains the palette chunk}
        PaletteChunk := Owner.Chunks.ItemFromClass(TChunkPLTE) as TChunkPLTE;

        {Looks for an entry with 0 transparency meaning that it is the}
        {full transparent entry}
        for i := 0 to Self.DataSize - 1 do
          if PaletteValues[i] = 0 then
            with PaletteChunk.GetPaletteItem(i) do
            begin
              Result := RGB(rgbRed, rgbGreen, rgbBlue);
              break
            end
      end {COLOR_PALETTE}
    end {case Header.ColorType};
end;

{Saving the chunk to a stream}
function TChunktRNS.SaveToStream(Stream: IStream): Boolean;
begin
  {Copy palette into data buffer}
  if DataSize <= 256 then
    CopyMemory(FData, @PaletteValues[0], DataSize);

  Result := inherited SaveToStream(Stream);
end;

{Assigns from another chunk}
procedure TChunktRNS.Assign(Source: TChunk);
begin
  CopyMemory(@PaletteValues[0], @TChunkTrns(Source).PaletteValues[0], 256);
  FBitTransparency := TChunkTrns(Source).FBitTransparency;
  inherited Assign(Source);
end;

{Loads the chunk from a stream}
function TChunktRNS.LoadFromStream(Stream: IStream; const ChunkName: TChunkName;
  Size: Integer): Boolean;
var
  i, Differ255: Integer;
begin
  {Let inherited load}
  Result := inherited LoadFromStream(Stream, ChunkName, Size);

  if not Result then Exit;

  {Make sure size is correct}
  if Size > 256 then Owner.RaiseError(EPNGInvalidPalette,
    EPNGInvalidPaletteText);

  {The unset items should have value 255}
  Fillchar(PaletteValues[0], 256, 255);
  {Copy the other values}
  CopyMemory(@PaletteValues[0], FData, Size);

  {Create the mask if needed}
  case Header.ColorType of
    {Mask for grayscale and RGB}
    COLOR_RGB, COLOR_GRAYSCALE: FBitTransparency := True;
    COLOR_PALETTE:
    begin
      Differ255 := 0; {Count the entries with a value different from 255}
      {Tests if it uses bit transparency}
      for i := 0 to Size - 1 do
        if PaletteValues[i] <> 255 then inc(Differ255);

      {If it has one value different from 255 it is a bit transparency}
      FBitTransparency := (Differ255 = 1);
    end {COLOR_PALETTE}
  end {case Header.ColorType};

end;

{Prepares the image palette}
procedure TChunkIDAT.PreparePalette;
var
  Entries: Word;
  j      : Integer;
  palEntries: TMaxLogPalette;
begin
  {In case the image uses grayscale, build a grayscale palette}
  with Header do
    if (ColorType = COLOR_GRAYSCALE) or (ColorType = COLOR_GRAYSCALEALPHA) then
    begin
      {Calculate total number of palette entries}
      Entries := (1 shl Byte(FBitmapInfo.bmiHeader.biBitCount));
      Fillchar(palEntries, sizeof(palEntries), #0);
      palEntries.palVersion := $300;
      palEntries.palNumEntries := Entries;

      FOR j := 0 TO Entries - 1 DO
        with palEntries.palPalEntry[j] do
        begin

          {Calculate each palette entry}
          peRed := FOwner.GammaTable[MulDiv(j, 255, Entries - 1)];
          peGreen := peRed;
          peBlue := peRed;
        end {with FBitmapInfo.bmiColors[j]};
        Owner.SetPalette(CreatePalette(pLogPalette(@palEntries)^));
    end {if ColorType = COLOR_GRAYSCALE..., with Header}
end;

{Reads from ZLIB}
function TChunkIDAT.IDATZlibRead(var ZLIBStream: TZStreamRec2;
  Buffer: Pointer; Count: LongWord; var EndPos: Integer;
  var crcfile: Cardinal): Integer;
var
  ProcResult : Integer;
  IDATHeader : array[0..3] of AnsiChar;
  IDATCRC    : Cardinal;
begin
  {Uses internal record pointed by ZLIBStream to gather information}
  with ZLIBStream, ZLIBStream.zlib do
  begin
    {Set the buffer the zlib will read into}
    next_out := Buffer;
    avail_out := Count;

    {Decode until it reach the Count variable}
    while avail_out > 0 do
    begin
      {In case it needs more data and it's in the end of a IDAT chunk,}
      {it means that there are more IDAT chunks}
      if (GMIStreamPos(fStream) = EndPos) and (avail_out > 0) and
        (avail_in = 0) then
      begin
        {End this chunk by reading and testing the crc value}
        GMSafeIStreamRead(fStream, @IDATCRC, SizeOf(IDATCRC));

        {$IFDEF CheckCRC}
          if crcfile xor $ffffffff <> Cardinal(ByteSwap(IDATCRC)) then
          begin
            Result := -1;
            Owner.RaiseError(EPNGInvalidCRC, EPNGInvalidCRCText);
            Exit;
          end;
        {$ENDIF}

        {Start reading the next chunk}
        GMSafeIStreamRead(fStream, @EndPos, SizeOf(EndPos));        {Reads next chunk size}
        GMSafeIStreamRead(fStream, @IDATHeader[0], SizeOf(IDATHeader)); {Next chunk header}
        {It must be a IDAT chunk since image data is required and PNG}
        {specification says that multiple IDAT chunks must be consecutive}
        if IDATHeader <> 'IDAT' then
        begin
          Owner.RaiseError(EPNGMissingMultipleIDAT, EPNGMissingMultipleIDATText);
          Result := -1;
          Exit;
        end;

        {Calculate chunk name part of the crc}
        {$IFDEF CheckCRC}
          crcfile := update_crc($ffffffff, @IDATHeader[0], SizeOf(IDATHeader));
        {$ENDIF}
        EndPos := GMIStreamPos(fStream) + ByteSwap(EndPos);
      end;


      {In case it needs compressed data to read from}
      if avail_in = 0 then
      begin
        {In case it's trying to read more than it is avaliable}
        if GMIStreamPos(fStream) + ZLIBAllocate > EndPos then
          avail_in := GMIStreamRead(fStream, Data, EndPos - GMIStreamPos(fStream))
         else
          avail_in := GMIStreamRead(fStream, Data, ZLIBAllocate);
        {Update crc}
        {$IFDEF CheckCRC}
          crcfile := update_crc(crcfile, Data, avail_in);
        {$ENDIF}

        {In case there is no more compressed data to read from}
        if avail_in = 0 then
        begin
          Result := Count - avail_out;
          Exit;
        end;

        {Set next buffer to read and record current position}
        next_in := Data;

      end {if avail_in = 0};

      ProcResult := inflate(zlib, 0);

      {In case the Result was not sucessfull}
      if (ProcResult < 0) then
      begin
        Result := -1;
        Owner.RaiseError(EPNGZLIBError,
          EPNGZLIBErrorText + zliberrors[procresult]);
        Exit;
      end;

    end {while avail_out > 0};

  end {with};

  {If everything gone ok, it returns the count bytes}
  Result := Count;
end;

{TChunkIDAT implementation}

const
  {Adam 7 interlacing values}
  RowStart: array[0..6] of Integer = (0, 0, 4, 0, 2, 0, 1);
  ColumnStart: array[0..6] of Integer = (0, 4, 0, 2, 0, 1, 0);
  RowIncrement: array[0..6] of Integer = (8, 8, 8, 4, 4, 2, 2);
  ColumnIncrement: array[0..6] of Integer = (8, 8, 4, 4, 2, 2, 1);

{Copy interlaced images with 1 byte for R, G, B}
procedure TChunkIDAT.CopyInterlacedRGB8(const Pass: Byte;
  Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
var
  Col: Integer;
begin
  {Get first column and enter in loop}
  Col := ColumnStart[Pass];
  Dest := pByte(LongInt(Dest) + Col * 3);
  repeat
    {Copy this row}
    PByte(Dest)^ := FOwner.GammaTable[pByte(LongInt(Src) + 2)^]; inc(Dest);
    PByte(Dest)^ := FOwner.GammaTable[pByte(LongInt(Src) + 1)^]; inc(Dest);
    PByte(Dest)^ := FOwner.GammaTable[pByte(LongInt(Src)    )^]; inc(Dest);

    {Move to next column}
    inc(Src, 3);
    inc(Dest, ColumnIncrement[Pass] * 3 - 3);
    inc(Col, ColumnIncrement[Pass]);
  until Col >= ImageWidth;
end;

{Copy interlaced images with 2 bytes for R, G, B}
procedure TChunkIDAT.CopyInterlacedRGB16(const Pass: Byte;
  Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
var
  Col: Integer;
begin
  {Get first column and enter in loop}
  Col := ColumnStart[Pass];
  Dest := pByte(LongInt(Dest) + Col * 3);
  repeat
    {Copy this row}
    PByte(Dest)^ := Owner.GammaTable[pByte(LongInt(Src) + 4)^]; inc(Dest);
    PByte(Dest)^ := Owner.GammaTable[pByte(LongInt(Src) + 2)^]; inc(Dest);
    PByte(Dest)^ := Owner.GammaTable[pByte(LongInt(Src)    )^]; inc(Dest);
    {$IFDEF Store16bits}
    {Copy extra pixel values}
    PByte(Extra)^ := FOwner.GammaTable[pByte(LongInt(Src) + 5)^]; inc(Extra);
    PByte(Extra)^ := FOwner.GammaTable[pByte(LongInt(Src) + 3)^]; inc(Extra);
    PByte(Extra)^ := FOwner.GammaTable[pByte(LongInt(Src) + 1)^]; inc(Extra);
    {$ENDIF}

    {Move to next column}
    inc(Src, 6);
    inc(Dest, ColumnIncrement[Pass] * 3 - 3);
    inc(Col, ColumnIncrement[Pass]);
  until Col >= ImageWidth;
end;

{Copy �mages with palette using bit depths 1, 4 or 8}
procedure TChunkIDAT.CopyInterlacedPalette148(const Pass: Byte;
  Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
const
  BitTable: array[1..8] of Integer = ($1, $3, 0, $F, 0, 0, 0, $FF);
  StartBit: array[1..8] of Integer = (7 , 0 , 0, 4,  0, 0, 0, 0);
var
  CurBit, Col: Integer;
  Dest2: pByte;
begin
  {Get first column and enter in loop}
  Col := ColumnStart[Pass];
  repeat
    {Copy data}
    CurBit := StartBit[Header.BitDepth];
    repeat
      {Adjust pointer to pixel byte bounds}
      Dest2 := pByte(LongInt(Dest) + (Header.BitDepth * Col) div 8);
      {Copy data}
      PByte(Dest2)^ := Byte(Dest2^) or
        ( ((Byte(Src^) shr CurBit) and BitTable[Header.BitDepth])
          shl (StartBit[Header.BitDepth] - (Col * Header.BitDepth mod 8)));

      {Move to next column}
      inc(Col, ColumnIncrement[Pass]);
      {Will read next bits}
      dec(CurBit, Header.BitDepth);
    until CurBit < 0;

    {Move to next byte in source}
    inc(Src);
  until Col >= ImageWidth;
end;

{Copy �mages with palette using bit depth 2}
procedure TChunkIDAT.CopyInterlacedPalette2(const Pass: Byte; Src, Dest,
  Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
var
  CurBit, Col: Integer;
  Dest2: pByte;
begin
  {Get first column and enter in loop}
  Col := ColumnStart[Pass];
  repeat
    {Copy data}
    CurBit := 6;
    repeat
      {Adjust pointer to pixel byte bounds}
      Dest2 := pByte(LongInt(Dest) + Col div 2);
      {Copy data}
      PByte(Dest2)^ := Byte(Dest2^) or (((Byte(Src^) shr CurBit) and $3)
         shl (4 - (4 * Col) mod 8));
      {Move to next column}
      inc(Col, ColumnIncrement[Pass]);
      {Will read next bits}
      dec(CurBit, 2);
    until CurBit < 0;

    {Move to next byte in source}
    inc(Src);
  until Col >= ImageWidth;
end;

{Copy �mages with grayscale using bit depth 2}
procedure TChunkIDAT.CopyInterlacedGray2(const Pass: Byte;
  Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
var
  CurBit, Col: Integer;
  Dest2: pByte;
begin
  {Get first column and enter in loop}
  Col := ColumnStart[Pass];
  repeat
    {Copy data}
    CurBit := 6;
    repeat
      {Adjust pointer to pixel byte bounds}
      Dest2 := pByte(LongInt(Dest) + Col div 2);
      {Copy data}
      PByte(Dest2)^ := Byte(Dest2^) or ((((Byte(Src^) shr CurBit) shl 2) and $F)
         shl (4 - (Col*4) mod 8));
      {Move to next column}
      inc(Col, ColumnIncrement[Pass]);
      {Will read next bits}
      dec(CurBit, 2);
    until CurBit < 0;

    {Move to next byte in source}
    inc(Src);
  until Col >= ImageWidth;
end;

{Copy �mages with palette using 2 bytes for each pixel}
procedure TChunkIDAT.CopyInterlacedGrayscale16(const Pass: Byte;
  Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
var
  Col: Integer;
begin
  {Get first column and enter in loop}
  Col := ColumnStart[Pass];
  Dest := pByte(LongInt(Dest) + Col);
  repeat
    {Copy this row}
    Dest^ := Src^; inc(Dest);
    {$IFDEF Store16bits}
    Extra^ := pByte(LongInt(Src) + 1)^; inc(Extra);
    {$ENDIF}

    {Move to next column}
    inc(Src, 2);
    inc(Dest, ColumnIncrement[Pass] - 1);
    inc(Col, ColumnIncrement[Pass]);
  until Col >= ImageWidth;
end;

{Decodes interlaced RGB alpha with 1 byte for each sample}
procedure TChunkIDAT.CopyInterlacedRGBAlpha8(const Pass: Byte;
  Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
var
  Col: Integer;
begin
  {Get first column and enter in loop}
  Col := ColumnStart[Pass];
  Dest := pByte(LongInt(Dest) + Col * 3);
  Trans := pByte(LongInt(Trans) + Col);
  repeat
    {Copy this row and alpha value}
    Trans^ := pByte(LongInt(Src) + 3)^;
    PByte(Dest)^  := FOwner.GammaTable[pByte(LongInt(Src) + 2)^]; inc(Dest);
    PByte(Dest)^  := FOwner.GammaTable[pByte(LongInt(Src) + 1)^]; inc(Dest);
    PByte(Dest)^  := FOwner.GammaTable[pByte(LongInt(Src)    )^]; inc(Dest);

    {Move to next column}
    inc(Src, 4);
    inc(Dest, ColumnIncrement[Pass] * 3 - 3);
    inc(Trans, ColumnIncrement[Pass]);
    inc(Col, ColumnIncrement[Pass]);
  until Col >= ImageWidth;
end;

{Decodes interlaced RGB alpha with 2 bytes for each sample}
procedure TChunkIDAT.CopyInterlacedRGBAlpha16(const Pass: Byte;
  Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
var
  Col: Integer;
begin
  {Get first column and enter in loop}
  Col := ColumnStart[Pass];
  Dest := pByte(LongInt(Dest) + Col * 3);
  Trans := pByte(LongInt(Trans) + Col);
  repeat
    {Copy this row and alpha value}
    Trans^ := pByte(LongInt(Src) + 6)^;
    PByte(Dest)^  := FOwner.GammaTable[pByte(LongInt(Src) + 4)^]; inc(Dest);
    PByte(Dest)^  := FOwner.GammaTable[pByte(LongInt(Src) + 2)^]; inc(Dest);
    PByte(Dest)^  := FOwner.GammaTable[pByte(LongInt(Src)    )^]; inc(Dest);
    {$IFDEF Store16bits}
    {Copy extra pixel values}
    PByte(Extra)^ := FOwner.GammaTable[pByte(LongInt(Src) + 5)^]; inc(Extra);
    PByte(Extra)^ := FOwner.GammaTable[pByte(LongInt(Src) + 3)^]; inc(Extra);
    PByte(Extra)^ := FOwner.GammaTable[pByte(LongInt(Src) + 1)^]; inc(Extra);
    {$ENDIF}

    {Move to next column}
    inc(Src, 8);
    inc(Dest, ColumnIncrement[Pass] * 3 - 3);
    inc(Trans, ColumnIncrement[Pass]);
    inc(Col, ColumnIncrement[Pass]);
  until Col >= ImageWidth;
end;

{Decodes 8 bit grayscale image followed by an alpha sample}
procedure TChunkIDAT.CopyInterlacedGrayscaleAlpha8(const Pass: Byte;
  Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
var
  Col: Integer;
begin
  {Get first column, pointers to the data and enter in loop}
  Col := ColumnStart[Pass];
  Dest := pByte(LongInt(Dest) + Col);
  Trans := pByte(LongInt(Trans) + Col);
  repeat
    {Copy this grayscale value and alpha}
    Dest^ := Src^;  inc(Src);
    Trans^ := Src^; inc(Src);

    {Move to next column}
    inc(Dest, ColumnIncrement[Pass]);
    inc(Trans, ColumnIncrement[Pass]);
    inc(Col, ColumnIncrement[Pass]);
  until Col >= ImageWidth;
end;

{Decodes 16 bit grayscale image followed by an alpha sample}
procedure TChunkIDAT.CopyInterlacedGrayscaleAlpha16(const Pass: Byte;
  Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
var
  Col: Integer;
begin
  {Get first column, pointers to the data and enter in loop}
  Col := ColumnStart[Pass];
  Dest := pByte(LongInt(Dest) + Col);
  Trans := pByte(LongInt(Trans) + Col);
  repeat
    {$IFDEF Store16bits}
    Extra^ := pByte(LongInt(Src) + 1)^; inc(Extra);
    {$ENDIF}
    {Copy this grayscale value and alpha, transforming 16 bits into 8}
    Dest^ := Src^;  inc(Src, 2);
    Trans^ := Src^; inc(Src, 2);

    {Move to next column}
    inc(Dest, ColumnIncrement[Pass]);
    inc(Trans, ColumnIncrement[Pass]);
    inc(Col, ColumnIncrement[Pass]);
  until Col >= ImageWidth;
end;

{Decodes an interlaced image}
procedure TChunkIDAT.DecodeInterlacedAdam7(Stream: IStream;
  var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: Cardinal);
var
  CurrentPass: Byte;
  PixelsThisRow: Integer;
  CurrentRow: Integer;
  Trans, Data{$IFDEF Store16bits}, Extra{$ENDIF}: pByte;
  CopyProc: procedure(const Pass: Byte; Src, Dest,
    Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte) of object;
begin

  CopyProc := nil; {Initialize}
  {Determine method to copy the image data}
  case Header.ColorType of
    {R, G, B values for each pixel}
    COLOR_RGB:
      case Header.BitDepth of
        8:  CopyProc := CopyInterlacedRGB8;
       16:  CopyProc := CopyInterlacedRGB16;
      end {case Header.BitDepth};
    {Palette}
    COLOR_PALETTE, COLOR_GRAYSCALE:
      case Header.BitDepth of
        1, 4, 8: CopyProc := CopyInterlacedPalette148;
        2      : if Header.ColorType = COLOR_PALETTE then
                   CopyProc := CopyInterlacedPalette2
                 else
                   CopyProc := CopyInterlacedGray2;
        16     : CopyProc := CopyInterlacedGrayscale16;
      end;
    {RGB followed by alpha}
    COLOR_RGBALPHA:
      case Header.BitDepth of
        8:  CopyProc := CopyInterlacedRGBAlpha8;
       16:  CopyProc := CopyInterlacedRGBAlpha16;
      end;
    {Grayscale followed by alpha}
    COLOR_GRAYSCALEALPHA:
      case Header.BitDepth of
        8:  CopyProc := CopyInterlacedGrayscaleAlpha8;
       16:  CopyProc := CopyInterlacedGrayscaleAlpha16;
      end;
  end {case Header.ColorType};

  {Adam7 method has 7 passes to make the final image}
  FOR CurrentPass := 0 TO 6 DO
  begin
    {Calculates the number of pixels and bytes for this pass row}
    PixelsThisRow := (ImageWidth - ColumnStart[CurrentPass] +
      ColumnIncrement[CurrentPass] - 1) div ColumnIncrement[CurrentPass];
    Row_Bytes := BytesForPixels(PixelsThisRow, Header.ColorType,
      Header.BitDepth);
    {Clear buffer for this pass}
    ZeroMemory(Row_Buffer[not RowUsed], Row_Bytes);

    {Get current row index}
    CurrentRow := RowStart[CurrentPass];
    {Get a pointer to the current row image data}
    Data := Ptr(LongInt(Header.FImageData) + Header.BytesPerRow *
      (ImageHeight - 1 - CurrentRow));
    Trans := Ptr(LongInt(Header.FImageAlpha) + ImageWidth * CurrentRow);
    {$IFDEF Store16bits}
    Extra := Ptr(LongInt(Header.FExtraImageData) + Header.BytesPerRow *
      (ImageHeight - 1 - CurrentRow));
    {$ENDIF}

    if Row_Bytes > 0 then {There must have bytes for this interlaced pass}
      while CurrentRow < ImageHeight do
      begin
        {Reads this line and filter}
        if IDATZlibRead(ZLIBStream, @Row_Buffer[RowUsed][0], Row_Bytes + 1,
          EndPos, CRCFile) = 0 then break;

        FilterRow;
        {Copy image data}

        CopyProc(CurrentPass, @Row_Buffer[RowUsed][1], Data, Trans
          {$IFDEF Store16bits}, Extra{$ENDIF});

        {Use the other RowBuffer item}
        RowUsed := not RowUsed;

        {Move to the next row}
        inc(CurrentRow, RowIncrement[CurrentPass]);
        {Move pointer to the next line}
        dec(Data, RowIncrement[CurrentPass] * Header.BytesPerRow);
        inc(Trans, RowIncrement[CurrentPass] * ImageWidth);
        {$IFDEF Store16bits}
        dec(Extra, RowIncrement[CurrentPass] * Header.BytesPerRow);
        {$ENDIF}
      end {while CurrentRow < ImageHeight};

  end {FOR CurrentPass};

end;

{Copy 8 bits RGB image}
procedure TChunkIDAT.CopyNonInterlacedRGB8(
  Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
var
  I: Integer;
begin
  FOR I := 1 TO ImageWidth DO
  begin
    {Copy pixel values}
    PByte(Dest)^ := FOwner.GammaTable[pByte(LongInt(Src) + 2)^]; inc(Dest);
    PByte(Dest)^ := FOwner.GammaTable[pByte(LongInt(Src) + 1)^]; inc(Dest);
    PByte(Dest)^ := FOwner.GammaTable[pByte(LongInt(Src)    )^]; inc(Dest);
    {Move to next pixel}
    inc(Src, 3);
  end {for I}
end;

{Copy 16 bits RGB image}
procedure TChunkIDAT.CopyNonInterlacedRGB16(
  Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
var
  I: Integer;
begin
  FOR I := 1 TO ImageWidth DO
  begin
    //Since windows does not supports 2 bytes for
    //each R, G, B value, the method will read only 1 byte from it
    {Copy pixel values}
    PByte(Dest)^ := FOwner.GammaTable[pByte(LongInt(Src) + 4)^]; inc(Dest);
    PByte(Dest)^ := FOwner.GammaTable[pByte(LongInt(Src) + 2)^]; inc(Dest);
    PByte(Dest)^ := FOwner.GammaTable[pByte(LongInt(Src)    )^]; inc(Dest);
    {$IFDEF Store16bits}
    {Copy extra pixel values}
    PByte(Extra)^ := FOwner.GammaTable[pByte(LongInt(Src) + 5)^]; inc(Extra);
    PByte(Extra)^ := FOwner.GammaTable[pByte(LongInt(Src) + 3)^]; inc(Extra);
    PByte(Extra)^ := FOwner.GammaTable[pByte(LongInt(Src) + 1)^]; inc(Extra);
    {$ENDIF}

    {Move to next pixel}
    inc(Src, 6);
  end {for I}
end;

{Copy types using palettes (1, 4 or 8 bits per pixel)}
procedure TChunkIDAT.CopyNonInterlacedPalette148(
  Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
begin
  {It's simple as copying the data}
  CopyMemory(Dest, Src, Row_Bytes);
end;

{Copy grayscale types using 2 bits for each pixel}
procedure TChunkIDAT.CopyNonInterlacedGray2(
  Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
var
  i: Integer;
begin
  {2 bits is not supported, this routine will converted into 4 bits}
  FOR i := 1 TO Row_Bytes do
  begin
    PByte(Dest)^ := ((Byte(Src^) shr 2) and $F) or ((Byte(Src^)) and $F0);
      inc(Dest);
    PByte(Dest)^ := ((Byte(Src^) shl 2) and $F) or ((Byte(Src^) shl 4) and $F0);
      inc(Dest);
    inc(Src);
  end {FOR i}
end;

{Copy types using palette with 2 bits for each pixel}
procedure TChunkIDAT.CopyNonInterlacedPalette2(
  Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
var
  i: Integer;
begin
  {2 bits is not supported, this routine will converted into 4 bits}
  FOR i := 1 TO Row_Bytes do
  begin
    PByte(Dest)^ := ((Byte(Src^) shr 4) and $3) or ((Byte(Src^) shr 2) and $30);
      inc(Dest);
    PByte(Dest)^ := (Byte(Src^) and $3) or ((Byte(Src^) shl 2) and $30);
      inc(Dest);
    inc(Src);
  end {FOR i}
end;

{Copy grayscale images with 16 bits}
procedure TChunkIDAT.CopyNonInterlacedGrayscale16(
  Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
var
  I: Integer;
begin
  FOR I := 1 TO ImageWidth DO
  begin
    {Windows does not supports 16 bits for each pixel in grayscale}
    {mode, so reduce to 8}
    Dest^ := Src^; inc(Dest);
    {$IFDEF Store16bits}
    Extra^ := pByte(LongInt(Src) + 1)^; inc(Extra);
    {$ENDIF}

    {Move to next pixel}
    inc(Src, 2);
  end {for I}
end;

{Copy 8 bits per sample RGB images followed by an alpha byte}
procedure TChunkIDAT.CopyNonInterlacedRGBAlpha8(
  Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
var
  i: Integer;
begin
  FOR I := 1 TO ImageWidth DO
  begin
    {Copy pixel values and transparency}
    Trans^ := pByte(LongInt(Src) + 3)^;
    PByte(Dest)^  := FOwner.GammaTable[pByte(LongInt(Src) + 2)^]; inc(Dest);
    PByte(Dest)^  := FOwner.GammaTable[pByte(LongInt(Src) + 1)^]; inc(Dest);
    PByte(Dest)^  := FOwner.GammaTable[pByte(LongInt(Src)    )^]; inc(Dest);
    {Move to next pixel}
    inc(Src, 4); inc(Trans);
  end {for I}
end;

{Copy 16 bits RGB image with alpha using 2 bytes for each sample}
procedure TChunkIDAT.CopyNonInterlacedRGBAlpha16(
  Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
var
  I: Integer;
begin
  FOR I := 1 TO ImageWidth DO
  begin
    //Copy rgb and alpha values (transforming from 16 bits to 8 bits)
    {Copy pixel values}
    Trans^ := pByte(LongInt(Src) + 6)^;
    PByte(Dest)^  := FOwner.GammaTable[pByte(LongInt(Src) + 4)^]; inc(Dest);
    PByte(Dest)^  := FOwner.GammaTable[pByte(LongInt(Src) + 2)^]; inc(Dest);
    PByte(Dest)^  := FOwner.GammaTable[pByte(LongInt(Src)    )^]; inc(Dest);
    {$IFDEF Store16bits}
    {Copy extra pixel values}
    PByte(Extra)^ := FOwner.GammaTable[pByte(LongInt(Src) + 5)^]; inc(Extra);
    PByte(Extra)^ := FOwner.GammaTable[pByte(LongInt(Src) + 3)^]; inc(Extra);
    PByte(Extra)^ := FOwner.GammaTable[pByte(LongInt(Src) + 1)^]; inc(Extra);
    {$ENDIF}
    {Move to next pixel}
    inc(Src, 8); inc(Trans);
  end {for I}
end;

{Copy 8 bits per sample grayscale followed by alpha}
procedure TChunkIDAT.CopyNonInterlacedGrayscaleAlpha8(
  Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
var
  I: Integer;
begin
  FOR I := 1 TO ImageWidth DO
  begin
    {Copy alpha value and then gray value}
    Dest^  := Src^;  inc(Src);
    Trans^ := Src^;  inc(Src);
    inc(Dest); inc(Trans);
  end;
end;

{Copy 16 bits per sample grayscale followed by alpha}
procedure TChunkIDAT.CopyNonInterlacedGrayscaleAlpha16(
  Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte);
var
  I: Integer;
begin
  FOR I := 1 TO ImageWidth DO
  begin
    {Copy alpha value and then gray value}
    {$IFDEF Store16bits}
    Extra^ := pByte(LongInt(Src) + 1)^; inc(Extra);
    {$ENDIF}
    Dest^  := Src^;  inc(Src, 2);
    Trans^ := Src^;  inc(Src, 2);
    inc(Dest); inc(Trans);
  end;
end;

{Decode non interlaced image}
procedure TChunkIDAT.DecodeNonInterlaced(Stream: IStream;
  var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: Cardinal);
var
  j: Cardinal;
  Trans, Data{$IFDEF Store16bits}, Extra{$ENDIF}: pByte;
  CopyProc: procedure(
    Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pByte) of object;
begin
  CopyProc := nil; {Initialize}
  {Determines the method to copy the image data}
  case Header.ColorType of
    {R, G, B values}
    COLOR_RGB:
      case Header.BitDepth of
        8: CopyProc := CopyNonInterlacedRGB8;
       16: CopyProc := CopyNonInterlacedRGB16;
      end;
    {Types using palettes}
    COLOR_PALETTE, COLOR_GRAYSCALE:
      case Header.BitDepth of
        1, 4, 8: CopyProc := CopyNonInterlacedPalette148;
        2      : if Header.ColorType = COLOR_PALETTE then
                   CopyProc := CopyNonInterlacedPalette2
                 else
                   CopyProc := CopyNonInterlacedGray2;
        16     : CopyProc := CopyNonInterlacedGrayscale16;
      end;
    {R, G, B followed by alpha}
    COLOR_RGBALPHA:
      case Header.BitDepth of
        8  : CopyProc := CopyNonInterlacedRGBAlpha8;
       16  : CopyProc := CopyNonInterlacedRGBAlpha16;
      end;
    {Grayscale followed by alpha}
    COLOR_GRAYSCALEALPHA:
      case Header.BitDepth of
        8  : CopyProc := CopyNonInterlacedGrayscaleAlpha8;
       16  : CopyProc := CopyNonInterlacedGrayscaleAlpha16;
      end;
  end;

  {Get the image data pointer}
  LongInt(Data) := LongInt(Header.FImageData) +
    Header.BytesPerRow * (ImageHeight - 1);
  Trans := Header.FImageAlpha;
  {$IFDEF Store16bits}
  LongInt(Extra) := LongInt(Header.FExtraImageData) +
    Header.BytesPerRow * (ImageHeight - 1);
  {$ENDIF}
  {Reads each line}
  FOR j := 0 to ImageHeight - 1 do
  begin
    {Read this line Row_Buffer[RowUsed][0] if the filter type for this line}
    if IDATZlibRead(ZLIBStream, @Row_Buffer[RowUsed][0], Row_Bytes + 1, EndPos,
      CRCFile) = 0 then break;

    {Filter the current row}
    FilterRow;
    {Copies non interlaced row to image}
    CopyProc(@Row_Buffer[RowUsed][1], Data, Trans{$IFDEF Store16bits}, Extra
      {$ENDIF});

    {Invert line used}
    RowUsed := not RowUsed;
    dec(Data, Header.BytesPerRow);
    {$IFDEF Store16bits}dec(Extra, Header.BytesPerRow);{$ENDIF}
    inc(Trans, ImageWidth);
  end {for I};


end;

{Filter the current line}
procedure TChunkIDAT.FilterRow;
var
  pp: Byte;
  vv, left, above, aboveleft: Integer;
  Col: Cardinal;
begin
  {Test the filter}
  case Row_Buffer[RowUsed]^[0] of
    {No filtering for this line}
    FILTER_NONE: begin end;
    {AND 255 serves only to never let the Result be larger than one byte}
    {Sub filter}
    FILTER_SUB:
      FOR Col := Offset + 1 to Row_Bytes DO
        Row_Buffer[RowUsed][Col] := (Row_Buffer[RowUsed][Col] +
          Row_Buffer[RowUsed][Col - Offset]) and 255;
    {Up filter}
    FILTER_UP:
      FOR Col := 1 to Row_Bytes DO
        Row_Buffer[RowUsed][Col] := (Row_Buffer[RowUsed][Col] +
          Row_Buffer[not RowUsed][Col]) and 255;
    {Average filter}
    FILTER_AVERAGE:
      FOR Col := 1 to Row_Bytes DO
      begin
        {Obtains up and left pixels}
        above := Row_Buffer[not RowUsed][Col];
        if col - 1 < Offset then
          left := 0
        else
          Left := Row_Buffer[RowUsed][Col - Offset];

        {Calculates}
        Row_Buffer[RowUsed][Col] := (Row_Buffer[RowUsed][Col] +
          (left + above) div 2) and 255;
      end;
    {Paeth filter}
    FILTER_PAETH:
    begin
      {Initialize}
      left := 0;
      aboveleft := 0;
      {Test each byte}
      FOR Col := 1 to Row_Bytes DO
      begin
        {Obtains above pixel}
        above := Row_Buffer[not RowUsed][Col];
        {Obtains left and top-left pixels}
        if (col - 1 >= offset) Then
        begin
          left := row_buffer[RowUsed][col - offset];
          aboveleft := row_buffer[not RowUsed][col - offset];
        end;

        {Obtains current pixel and paeth predictor}
        vv := row_buffer[RowUsed][Col];
        pp := PaethPredictor(left, above, aboveleft);

        {Calculates}
        Row_Buffer[RowUsed][Col] := (pp + vv) and $FF;
      end {for};
    end;

  end {case};
end;

{Reads the image data from the stream}
function TChunkIDAT.LoadFromStream(Stream: IStream; const ChunkName: TChunkName;
  Size: Integer): Boolean;
var
  ZLIBStream: TZStreamRec2;
  CRCCheck,
  CRCFile  : Cardinal;
begin
  {Get pointer to the header chunk}
  Header := Owner.Chunks.Item[0] as TChunkIHDR;
  {Build palette if necessary}
  if Header.FHasPalette then PreparePalette();

  {Copy image width and height}
  ImageWidth := Header.Width;
  ImageHeight := Header.Height;

  {Initialize to calculate CRC}
  {$IFDEF CheckCRC}
    CRCFile := update_crc($ffffffff, @ChunkName[0], SizeOf(ChunkName));
  {$ENDIF}

  Owner.GetPixelInfo(Row_Bytes, Offset); {Obtain line information}
  ZLIBStream := ZLIBInitInflate(Stream);  {Initializes decompression}

  {Calculate ending position for the current IDAT chunk}
  EndPos := GMIStreamPos(Stream) + Size;

  {Allocate memory}
  GetMem(Row_Buffer[false], Row_Bytes + 1);
  GetMem(Row_Buffer[true], Row_Bytes + 1);
  ZeroMemory(Row_Buffer[false], Row_bytes + 1);
  {Set the variable to alternate the Row_Buffer item to use}
  RowUsed := TRUE;

  {Call special methods for the different interlace methods}
  case Owner.InterlaceMethod of
    imNone:  DecodeNonInterlaced(stream, ZLIBStream, Size, crcfile);
    imAdam7: DecodeInterlacedAdam7(stream, ZLIBStream, size, crcfile);
  end;

  {Free memory}
  ZLIBTerminateInflate(ZLIBStream); {Terminates decompression}
  FreeMem(Row_Buffer[False], Row_Bytes + 1);
  FreeMem(Row_Buffer[True], Row_Bytes + 1);

  {Now checks CRC}
  GMSafeIStreamRead(Stream, @CRCCheck, SizeOf(CRCCheck));
  {$IFDEF CheckCRC}
    CRCFile := CRCFile xor $ffffffff;
    CRCCheck := ByteSwap(CRCCheck);
    Result := CRCCheck = CRCFile;

    {Handle CRC error}
    if not Result then
    begin
      {In case it coult not load chunk}
      Owner.RaiseError(EPngInvalidCRC, EPngInvalidCRCText);
      Exit;
    end;
  {$ELSE}Result := TRUE; {$ENDIF}
end;

const
  IDATHeader: array[0..3] of AnsiChar = ('I', 'D', 'A', 'T');
  BUFFER = 5;

{Saves the IDAT chunk to a stream}
function TChunkIDAT.SaveToStream(Stream: IStream): Boolean;
var
  ZLIBStream : TZStreamRec2;
begin
  {Get pointer to the header chunk}
  Header := Owner.Chunks.Item[0] as TChunkIHDR;
  {Copy image width and height}
  ImageWidth := Header.Width;
  ImageHeight := Header.Height;
  Owner.GetPixelInfo(Row_Bytes, Offset); {Obtain line information}

  {Allocate memory}
  GetMem(Encode_Buffer[BUFFER], Row_Bytes);
  ZeroMemory(Encode_Buffer[BUFFER], Row_Bytes);
  {Allocate buffers for the filters selected}
  {Filter none will always be calculated to the other filters to work}
  GetMem(Encode_Buffer[FILTER_NONE], Row_Bytes);
  ZeroMemory(Encode_Buffer[FILTER_NONE], Row_Bytes);
  if pfSub in Owner.Filters then
    GetMem(Encode_Buffer[FILTER_SUB], Row_Bytes);
  if pfUp in Owner.Filters then
    GetMem(Encode_Buffer[FILTER_UP], Row_Bytes);
  if pfAverage in Owner.Filters then
    GetMem(Encode_Buffer[FILTER_AVERAGE], Row_Bytes);
  if pfPaeth in Owner.Filters then
    GetMem(Encode_Buffer[FILTER_PAETH], Row_Bytes);

  {Initialize ZLIB}
  ZLIBStream := ZLIBInitDeflate(Stream, Owner.FCompressionLevel,
    Owner.MaxIdatSize);
  {Write data depending on the interlace method}
  case Owner.InterlaceMethod of
    imNone: EncodeNonInterlaced(stream, ZLIBStream);
    imAdam7: EncodeInterlacedAdam7(stream, ZLIBStream);
  end;
  {Terminates ZLIB}
  ZLIBTerminateDeflate(ZLIBStream);

  {Release allocated memory}
  FreeMem(Encode_Buffer[BUFFER], Row_Bytes);
  FreeMem(Encode_Buffer[FILTER_NONE], Row_Bytes);
  if pfSub in Owner.Filters then
    FreeMem(Encode_Buffer[FILTER_SUB], Row_Bytes);
  if pfUp in Owner.Filters then
    FreeMem(Encode_Buffer[FILTER_UP], Row_Bytes);
  if pfAverage in Owner.Filters then
    FreeMem(Encode_Buffer[FILTER_AVERAGE], Row_Bytes);
  if pfPaeth in Owner.Filters then
    FreeMem(Encode_Buffer[FILTER_PAETH], Row_Bytes);

  {Everything went ok}
  Result := True;
end;

{Writes the IDAT using the settings}
procedure WriteIDAT(Stream: IStream; Data: Pointer; const Length: Cardinal);
var
  ChunkLen, CRC: Cardinal;
begin
  {Writes IDAT header}
  ChunkLen := ByteSwap(Length);
  GMSafeIStreamWrite(Stream, @ChunkLen, SizeOf(ChunkLen));                      {Chunk length}
  GMSafeIStreamWrite(Stream, @IDATHeader[0], SizeOf(IDATHeader));                 {Idat header}
  CRC := update_crc($ffffffff, @IDATHeader[0], SizeOf(IDATHeader)); {Crc part for header}

  {Writes IDAT data and calculates CRC for data}
  GMSafeIStreamWrite(Stream, Data, Length);
  CRC := Byteswap(update_crc(CRC, Data, Length) xor $ffffffff);
  {Writes final CRC}
  GMSafeIStreamWrite(Stream, @CRC, SizeOf(CRC));
end;

{Compress and writes IDAT chunk data}
procedure TChunkIDAT.IDATZlibWrite(var ZLIBStream: TZStreamRec2;
  Buffer: Pointer; const Length: Cardinal);
begin
  with ZLIBStream, ZLIBStream.ZLIB do
  begin
    {Set data to be compressed}
    next_in := Buffer;
    avail_in := Length;

    {Compress all the data avaliable to compress}
    while avail_in > 0 do
    begin
      deflate(ZLIB, Z_NO_FLUSH);

      {The whole buffer was used, save data to stream and restore buffer}
      if avail_out = 0 then
      begin
        {Writes this IDAT chunk}
        WriteIDAT(fStream, Data, Owner.MaxIdatSize);

        {Restore buffer}
        next_out := Data;
        avail_out := Owner.MaxIdatSize;
      end {if avail_out = 0};

    end {while avail_in};

  end {with ZLIBStream, ZLIBStream.ZLIB}
end;

{Finishes compressing data to write IDAT chunk}
procedure TChunkIDAT.FinishIDATZlib(var ZLIBStream: TZStreamRec2);
begin
  with ZLIBStream, ZLIBStream.ZLIB do
  begin
    {Set data to be compressed}
    next_in := nil;
    avail_in := 0;

    while deflate(ZLIB,Z_FINISH) <> Z_STREAM_END do
    begin
      {Writes this IDAT chunk}
      WriteIDAT(fStream, Data, Owner.MaxIdatSize - avail_out);
      {Re-update buffer}
      next_out := Data;
      avail_out := Owner.MaxIdatSize;
    end;

    if avail_out < Owner.MaxIdatSize then
      {Writes final IDAT}
      WriteIDAT(fStream, Data, Owner.MaxIdatSize - avail_out);

  end {with ZLIBStream, ZLIBStream.ZLIB};
end;

{Copy memory to encode RGB image with 1 byte for each color sample}
procedure TChunkIDAT.EncodeNonInterlacedRGB8(Src, Dest, Trans: pByte);
var
  I: Integer;
begin
  FOR I := 1 TO ImageWidth DO
  begin
    {Copy pixel values}
    PByte(Dest)^ := FOwner.FInverseGamma[pByte(LongInt(Src) + 2)^]; inc(Dest);
    PByte(Dest)^ := FOwner.FInverseGamma[pByte(LongInt(Src) + 1)^]; inc(Dest);
    PByte(Dest)^ := FOwner.FInverseGamma[pByte(LongInt(Src)    )^]; inc(Dest);
    {Move to next pixel}
    inc(Src, 3);
  end {for I}
end;

{Copy memory to encode RGB images with 16 bits for each color sample}
procedure TChunkIDAT.EncodeNonInterlacedRGB16(Src, Dest, Trans: pByte);
var
  I: Integer;
begin
  FOR I := 1 TO ImageWidth DO
  begin
    //Now we copy from 1 byte for each sample stored to a 2 bytes (or 1 word)
    //for sample
    {Copy pixel values}
    pWORD(Dest)^ := FOwner.FInverseGamma[pByte(LongInt(Src) + 2)^]; inc(Dest, 2);
    pWORD(Dest)^ := FOwner.FInverseGamma[pByte(LongInt(Src) + 1)^]; inc(Dest, 2);
    pWORD(Dest)^ := FOwner.FInverseGamma[pByte(LongInt(Src)    )^]; inc(Dest, 2);
    {Move to next pixel}
    inc(Src, 3);
  end {for I}

end;

{Copy memory to encode types using palettes (1, 4 or 8 bits per pixel)}
procedure TChunkIDAT.EncodeNonInterlacedPalette148(Src, Dest, Trans: pByte);
begin
  {It's simple as copying the data}
  CopyMemory(Dest, Src, Row_Bytes);
end;

{Copy memory to encode grayscale images with 2 bytes for each sample}
procedure TChunkIDAT.EncodeNonInterlacedGrayscale16(Src, Dest, Trans: pByte);
var
  I: Integer;
begin
  FOR I := 1 TO ImageWidth DO
  begin
    //Now we copy from 1 byte for each sample stored to a 2 bytes (or 1 word)
    //for sample
    pWORD(Dest)^ := pByte(LongInt(Src))^; inc(Dest, 2);
    {Move to next pixel}
    inc(Src);
  end {for I}
end;

{Encode images using RGB followed by an alpha value using 1 byte for each}
procedure TChunkIDAT.EncodeNonInterlacedRGBAlpha8(Src, Dest, Trans: pByte);
var
  i: Integer;
begin
  {Copy the data to the destination, including data from Trans pointer}
  FOR i := 1 TO ImageWidth do
  begin
    PByte(Dest)^ := Owner.FInverseGamma[PByte(LongInt(Src) + 2)^]; inc(Dest);
    PByte(Dest)^ := Owner.FInverseGamma[PByte(LongInt(Src) + 1)^]; inc(Dest);
    PByte(Dest)^ := Owner.FInverseGamma[PByte(LongInt(Src)    )^]; inc(Dest);
    Dest^ := Trans^; inc(Dest);
    inc(Src, 3); inc(Trans);
  end {for i};
end;

{Encode images using RGB followed by an alpha value using 2 byte for each}
procedure TChunkIDAT.EncodeNonInterlacedRGBAlpha16(Src, Dest, Trans: pByte);
var
  i: Integer;
begin
  {Copy the data to the destination, including data from Trans pointer}
  FOR i := 1 TO ImageWidth do
  begin
    pWord(Dest)^ := Owner.FInverseGamma[PByte(LongInt(Src) + 2)^]; inc(Dest, 2);
    pWord(Dest)^ := Owner.FInverseGamma[PByte(LongInt(Src) + 1)^]; inc(Dest, 2);
    pWord(Dest)^ := Owner.FInverseGamma[PByte(LongInt(Src)    )^]; inc(Dest, 2);
    pWord(Dest)^ := PByte(LongInt(Trans)  )^; inc(Dest, 2);
    inc(Src, 3); inc(Trans);
  end {for i};
end;

{Encode grayscale images followed by an alpha value using 1 byte for each}
procedure TChunkIDAT.EncodeNonInterlacedGrayscaleAlpha8(
  Src, Dest, Trans: pByte);
var
  i: Integer;
begin
  {Copy the data to the destination, including data from Trans pointer}
  FOR i := 1 TO ImageWidth do
  begin
    Dest^ := Src^; inc(Dest);
    Dest^ := Trans^; inc(Dest);
    inc(Src); inc(Trans);
  end {for i};
end;

{Encode grayscale images followed by an alpha value using 2 byte for each}
procedure TChunkIDAT.EncodeNonInterlacedGrayscaleAlpha16(
  Src, Dest, Trans: pByte);
var
  i: Integer;
begin
  {Copy the data to the destination, including data from Trans pointer}
  FOR i := 1 TO ImageWidth do
  begin
    pWord(Dest)^ := pByte(Src)^;    inc(Dest, 2);
    pWord(Dest)^ := pByte(Trans)^;  inc(Dest, 2);
    inc(Src); inc(Trans);
  end {for i};
end;

{Encode non interlaced images}
procedure TChunkIDAT.EncodeNonInterlaced(Stream: IStream;
  var ZLIBStream: TZStreamRec2);
var
  {Current line}
  j: Cardinal;
  {Pointers to image data}
  Data, Trans: pByte;
  {Filter used for this line}
  Filter: Byte;
  {Method which will copy the data into the buffer}
  CopyProc: procedure(Src, Dest, Trans: pByte) of object;
begin
  CopyProc := nil;  {Initialize to avoid warnings}
  {Defines the method to copy the data to the buffer depending on}
  {the image parameters}
  case Header.ColorType of
    {R, G, B values}
    COLOR_RGB:
      case Header.BitDepth of
        8: CopyProc := EncodeNonInterlacedRGB8;
       16: CopyProc := EncodeNonInterlacedRGB16;
      end;
    {Palette and grayscale values}
    COLOR_GRAYSCALE, COLOR_PALETTE:
      case Header.BitDepth of
        1, 4, 8: CopyProc := EncodeNonInterlacedPalette148;
             16: CopyProc := EncodeNonInterlacedGrayscale16;
      end;
    {RGB with a following alpha value}
    COLOR_RGBALPHA:
      case Header.BitDepth of
          8: CopyProc := EncodeNonInterlacedRGBAlpha8;
         16: CopyProc := EncodeNonInterlacedRGBAlpha16;
      end;
    {Grayscale images followed by an alpha}
    COLOR_GRAYSCALEALPHA:
      case Header.BitDepth of
        8:  CopyProc := EncodeNonInterlacedGrayscaleAlpha8;
       16:  CopyProc := EncodeNonInterlacedGrayscaleAlpha16;
      end;
  end {case Header.ColorType};

  {Get the image data pointer}
  LongInt(Data) := LongInt(Header.FImageData) +
    Header.BytesPerRow * (ImageHeight - 1);
  Trans := Header.FImageAlpha;

  {Writes each line}
  FOR j := 0 to ImageHeight - 1 do
  begin
    {Copy data into buffer}
    CopyProc(Data, @Encode_Buffer[BUFFER][0], Trans);
    {Filter data}
    Filter := FilterToEncode;

    {Compress data}
    IDATZlibWrite(ZLIBStream, @Filter, 1);
    IDATZlibWrite(ZLIBStream, @Encode_Buffer[Filter][0], Row_Bytes);

    {Adjust pointers to the actual image data}
    dec(Data, Header.BytesPerRow);
    inc(Trans, ImageWidth);
  end;

  {Compress and finishes copying the remaining data}
  FinishIDATZlib(ZLIBStream);
end;

{Copy memory to encode interlaced images using RGB value with 1 byte for}
{each color sample}
procedure TChunkIDAT.EncodeInterlacedRGB8(const Pass: Byte;
  Src, Dest, Trans: pByte);
var
  Col: Integer;
begin
  {Get first column and enter in loop}
  Col := ColumnStart[Pass];
  Src := pByte(LongInt(Src) + Col * 3);
  repeat
    {Copy this row}
    PByte(Dest)^ := FOwner.FInverseGamma[pByte(LongInt(Src) + 2)^]; inc(Dest);
    PByte(Dest)^ := FOwner.FInverseGamma[pByte(LongInt(Src) + 1)^]; inc(Dest);
    PByte(Dest)^ := FOwner.FInverseGamma[pByte(LongInt(Src)    )^]; inc(Dest);

    {Move to next column}
    inc(Src, ColumnIncrement[Pass] * 3);
    inc(Col, ColumnIncrement[Pass]);
  until Col >= ImageWidth;
end;

{Copy memory to encode interlaced RGB images with 2 bytes each color sample}
procedure TChunkIDAT.EncodeInterlacedRGB16(const Pass: Byte;
  Src, Dest, Trans: pByte);
var
  Col: Integer;
begin
  {Get first column and enter in loop}
  Col := ColumnStart[Pass];
  Src := pByte(LongInt(Src) + Col * 3);
  repeat
    {Copy this row}
    pWord(Dest)^ := Owner.FInverseGamma[pByte(LongInt(Src) + 2)^]; inc(Dest, 2);
    pWord(Dest)^ := Owner.FInverseGamma[pByte(LongInt(Src) + 1)^]; inc(Dest, 2);
    pWord(Dest)^ := Owner.FInverseGamma[pByte(LongInt(Src)    )^]; inc(Dest, 2);

    {Move to next column}
    inc(Src, ColumnIncrement[Pass] * 3);
    inc(Col, ColumnIncrement[Pass]);
  until Col >= ImageWidth;
end;

{Copy memory to encode interlaced images using palettes using bit depths}
{1, 4, 8 (each pixel in the image)}
procedure TChunkIDAT.EncodeInterlacedPalette148(const Pass: Byte;
  Src, Dest, Trans: pByte);
const
  BitTable: array[1..8] of Integer = ($1, $3, 0, $F, 0, 0, 0, $FF);
  StartBit: array[1..8] of Integer = (7 , 0 , 0, 4,  0, 0, 0, 0);
var
  CurBit, Col: Integer;
  Src2: pByte;
begin
  {Clean the line}
  fillchar(Dest^, Row_Bytes, #0);
  {Get first column and enter in loop}
  Col := ColumnStart[Pass];
  with Header.FBitmapInfo.bmiHeader do
    repeat
      {Copy data}
      CurBit := StartBit[biBitCount];
      repeat
        {Adjust pointer to pixel byte bounds}
        Src2 := pByte(LongInt(Src) + (biBitCount * Col) div 8);
        {Copy data}
        PByte(Dest)^ := Byte(Dest^) or
          (((Byte(Src2^) shr (StartBit[Header.BitDepth] - (biBitCount * Col)
            mod 8))) and (BitTable[biBitCount])) shl CurBit;

        {Move to next column}
        inc(Col, ColumnIncrement[Pass]);
        {Will read next bits}
        dec(CurBit, biBitCount);
      until CurBit < 0;

      {Move to next byte in source}
      inc(Dest);
    until Col >= ImageWidth;
end;

{Copy to encode interlaced grayscale images using 16 bits for each sample}
procedure TChunkIDAT.EncodeInterlacedGrayscale16(const Pass: Byte;
  Src, Dest, Trans: pByte);
var
  Col: Integer;
begin
  {Get first column and enter in loop}
  Col := ColumnStart[Pass];
  Src := pByte(LongInt(Src) + Col);
  repeat
    {Copy this row}
    pWord(Dest)^ := Byte(Src^); inc(Dest, 2);

    {Move to next column}
    inc(Src, ColumnIncrement[Pass]);
    inc(Col, ColumnIncrement[Pass]);
  until Col >= ImageWidth;
end;

{Copy to encode interlaced rgb images followed by an alpha value, all using}
{one byte for each sample}
procedure TChunkIDAT.EncodeInterlacedRGBAlpha8(const Pass: Byte;
  Src, Dest, Trans: pByte);
var
  Col: Integer;
begin
  {Get first column and enter in loop}
  Col := ColumnStart[Pass];
  Src := pByte(LongInt(Src) + Col * 3);
  Trans := pByte(LongInt(Trans) + Col);
  repeat
    {Copy this row}
    PByte(Dest)^ := Owner.FInverseGamma[pByte(LongInt(Src) + 2)^]; inc(Dest);
    PByte(Dest)^ := Owner.FInverseGamma[pByte(LongInt(Src) + 1)^]; inc(Dest);
    PByte(Dest)^ := Owner.FInverseGamma[pByte(LongInt(Src)    )^]; inc(Dest);
    Dest^ := Trans^; inc(Dest);

    {Move to next column}
    inc(Src, ColumnIncrement[Pass] * 3);
    inc(Trans, ColumnIncrement[Pass]);
    inc(Col, ColumnIncrement[Pass]);
  until Col >= ImageWidth;
end;

{Copy to encode interlaced rgb images followed by an alpha value, all using}
{two byte for each sample}
procedure TChunkIDAT.EncodeInterlacedRGBAlpha16(const Pass: Byte;
  Src, Dest, Trans: pByte);
var
  Col: Integer;
begin
  {Get first column and enter in loop}
  Col := ColumnStart[Pass];
  Src := pByte(LongInt(Src) + Col * 3);
  Trans := pByte(LongInt(Trans) + Col);
  repeat
    {Copy this row}
    pWord(Dest)^ := pByte(LongInt(Src) + 2)^; inc(Dest, 2);
    pWord(Dest)^ := pByte(LongInt(Src) + 1)^; inc(Dest, 2);
    pWord(Dest)^ := pByte(LongInt(Src)    )^; inc(Dest, 2);
    pWord(Dest)^ := pByte(Trans)^; inc(Dest, 2);

    {Move to next column}
    inc(Src, ColumnIncrement[Pass] * 3);
    inc(Trans, ColumnIncrement[Pass]);
    inc(Col, ColumnIncrement[Pass]);
  until Col >= ImageWidth;
end;

{Copy to encode grayscale interlaced images followed by an alpha value, all}
{using 1 byte for each sample}
procedure TChunkIDAT.EncodeInterlacedGrayscaleAlpha8(const Pass: Byte;
  Src, Dest, Trans: pByte);
var
  Col: Integer;
begin
  {Get first column and enter in loop}
  Col := ColumnStart[Pass];
  Src := pByte(LongInt(Src) + Col);
  Trans := pByte(LongInt(Trans) + Col);
  repeat
    {Copy this row}
    Dest^ := Src^;   inc(Dest);
    Dest^ := Trans^; inc(Dest);

    {Move to next column}
    inc(Src, ColumnIncrement[Pass]);
    inc(Trans, ColumnIncrement[Pass]);
    inc(Col, ColumnIncrement[Pass]);
  until Col >= ImageWidth;
end;

{Copy to encode grayscale interlaced images followed by an alpha value, all}
{using 2 bytes for each sample}
procedure TChunkIDAT.EncodeInterlacedGrayscaleAlpha16(const Pass: Byte;
  Src, Dest, Trans: pByte);
var
  Col: Integer;
begin
  {Get first column and enter in loop}
  Col := ColumnStart[Pass];
  Src := pByte(LongInt(Src) + Col);
  Trans := pByte(LongInt(Trans) + Col);
  repeat
    {Copy this row}
    pWord(Dest)^ := pByte(Src)^; inc(Dest, 2);
    pWord(Dest)^ := pByte(Trans)^; inc(Dest, 2);

    {Move to next column}
    inc(Src, ColumnIncrement[Pass]);
    inc(Trans, ColumnIncrement[Pass]);
    inc(Col, ColumnIncrement[Pass]);
  until Col >= ImageWidth;
end;

{Encode interlaced images}
procedure TChunkIDAT.EncodeInterlacedAdam7(Stream: IStream;
  var ZLIBStream: TZStreamRec2);
var
  CurrentPass, Filter: Byte;
  PixelsThisRow: Integer;
  CurrentRow : Integer;
  Trans, Data: pByte;
  CopyProc: procedure(const Pass: Byte;
    Src, Dest, Trans: pByte) of object;
begin
  CopyProc := nil;  {Initialize to avoid warnings}
  {Defines the method to copy the data to the buffer depending on}
  {the image parameters}
  case Header.ColorType of
    {R, G, B values}
    COLOR_RGB:
      case Header.BitDepth of
        8: CopyProc := EncodeInterlacedRGB8;
       16: CopyProc := EncodeInterlacedRGB16;
      end;
    {Grayscale and palette}
    COLOR_PALETTE, COLOR_GRAYSCALE:
      case Header.BitDepth of
        1, 4, 8: CopyProc := EncodeInterlacedPalette148;
             16: CopyProc := EncodeInterlacedGrayscale16;
      end;
    {RGB followed by alpha}
    COLOR_RGBALPHA:
      case Header.BitDepth of
          8: CopyProc := EncodeInterlacedRGBAlpha8;
         16: CopyProc := EncodeInterlacedRGBAlpha16;
      end;
    COLOR_GRAYSCALEALPHA:
    {Grayscale followed by alpha}
      case Header.BitDepth of
          8: CopyProc := EncodeInterlacedGrayscaleAlpha8;
         16: CopyProc := EncodeInterlacedGrayscaleAlpha16;
      end;
  end {case Header.ColorType};

  {Compress the image using the seven passes for ADAM 7}
  FOR CurrentPass := 0 TO 6 DO
  begin
    {Calculates the number of pixels and bytes for this pass row}
    PixelsThisRow := (ImageWidth - ColumnStart[CurrentPass] +
      ColumnIncrement[CurrentPass] - 1) div ColumnIncrement[CurrentPass];
    Row_Bytes := BytesForPixels(PixelsThisRow, Header.ColorType,
      Header.BitDepth);
    ZeroMemory(Encode_Buffer[FILTER_NONE], Row_Bytes);

    {Get current row index}
    CurrentRow := RowStart[CurrentPass];
    {Get a pointer to the current row image data}
    Data := Ptr(LongInt(Header.FImageData) + Header.BytesPerRow *
      (ImageHeight - 1 - CurrentRow));
    Trans := Ptr(LongInt(Header.FImageAlpha) + ImageWidth * CurrentRow);

    {Process all the image rows}
    if Row_Bytes > 0 then
      while CurrentRow < ImageHeight do
      begin
        {Copy data into buffer}
        CopyProc(CurrentPass, Data, @Encode_Buffer[BUFFER][0], Trans);
        {Filter data}
        Filter := FilterToEncode;

        {Compress data}
        IDATZlibWrite(ZLIBStream, @Filter, 1);
        IDATZlibWrite(ZLIBStream, @Encode_Buffer[Filter][0], Row_Bytes);

        {Move to the next row}
        inc(CurrentRow, RowIncrement[CurrentPass]);
        {Move pointer to the next line}
        dec(Data, RowIncrement[CurrentPass] * Header.BytesPerRow);
        inc(Trans, RowIncrement[CurrentPass] * ImageWidth);
      end {while CurrentRow < ImageHeight}

  end {CurrentPass};

  {Compress and finishes copying the remaining data}
  FinishIDATZlib(ZLIBStream);
end;

{Filters the row to be encoded and returns the best filter}
function TChunkIDAT.FilterToEncode: Byte;
var
  Run, LongestRun, ii, jj: Cardinal;
  Last, Above, LastAbove: Byte;
begin
  {Selecting more filters using the Filters property from TGMPngImage}
  {increases the chances to the file be much smaller, but decreases}
  {the performace}

  {This method will creates the same line data using the different}
  {filter methods and select the best}

  {Sub-filter}
  if pfSub in Owner.Filters then
    for ii := 0 to Row_Bytes - 1 do
    begin
      {There is no previous pixel when it's on the first pixel, so}
      {set last as zero when in the first}
      if (ii >= Offset) then
        last := Encode_Buffer[BUFFER]^[ii - Offset]
      else
        last := 0;
      Encode_Buffer[FILTER_SUB]^[ii] := Encode_Buffer[BUFFER]^[ii] - last;
    end;

  {Up filter}
  if pfUp in Owner.Filters then
    for ii := 0 to Row_Bytes - 1 do
      Encode_Buffer[FILTER_UP]^[ii] := Encode_Buffer[BUFFER]^[ii] -
        Encode_Buffer[FILTER_NONE]^[ii];

  {Average filter}
  if pfAverage in Owner.Filters then
    for ii := 0 to Row_Bytes - 1 do
    begin
      {Get the previous pixel, if the current pixel is the first, the}
      {previous is considered to be 0}
      if (ii >= Offset) then
        last := Encode_Buffer[BUFFER]^[ii - Offset]
      else
        last := 0;
      {Get the pixel above}
      above := Encode_Buffer[FILTER_NONE]^[ii];

      {Calculates formula to the average pixel}
      Encode_Buffer[FILTER_AVERAGE]^[ii] := Encode_Buffer[BUFFER]^[ii] -
        (above + last) div 2 ;
    end;

  {Paeth filter (the slower)}
  if pfPaeth in Owner.Filters then
  begin
    {Initialize}
    last := 0;
    lastabove := 0;
    for ii := 0 to Row_Bytes - 1 do
    begin
      {In case this pixel is not the first in the line obtains the}
      {previous one and the one above the previous}
      if (ii >= Offset) then
      begin
        last := Encode_Buffer[BUFFER]^[ii - Offset];
        lastabove := Encode_Buffer[FILTER_NONE]^[ii - Offset];
      end;
      {Obtains the pixel above}
      above := Encode_Buffer[FILTER_NONE]^[ii];
      {Calculate paeth filter for this byte}
      Encode_Buffer[FILTER_PAETH]^[ii] := Encode_Buffer[BUFFER]^[ii] -
        PaethPredictor(last, above, lastabove);
    end;
  end;

  {Now calculates the same line using no filter, which is necessary}
  {in order to have data to the filters when the next line comes}
  CopyMemory(@Encode_Buffer[FILTER_NONE]^[0],
    @Encode_Buffer[BUFFER]^[0], Row_Bytes);

  {If only filter none is selected in the filter list, we don't need}
  {to proceed and further}
  if (Owner.Filters = [pfNone]) or (Owner.Filters = []) then
  begin
    Result := FILTER_NONE;
    Exit;
  end {if (Owner.Filters = [pfNone...};

  {Check which filter is the best by checking which has the larger}
  {sequence of the same byte, since they are best compressed}
  LongestRun := 0; Result := FILTER_NONE;
  for ii := FILTER_NONE TO FILTER_PAETH do
    {Check if this filter was selected}
    if TPNGFilter(ii) in Owner.Filters then
    begin
      Run := 0;
      {Check if it's the only filter}
      if Owner.Filters = [TPNGFilter(ii)] then
      begin
        Result := ii;
        Exit;
      end;

      {Check using a sequence of four bytes}
      for jj := 2 to Row_Bytes - 1 do
        if (Encode_Buffer[ii]^[jj] = Encode_Buffer [ii]^[jj-1]) or
            (Encode_Buffer[ii]^[jj] = Encode_Buffer [ii]^[jj-2]) then
          inc(Run);  {Count the number of sequences}

      {Check if this one is the best so far}
      if (Run > LongestRun) then
      begin
        Result := ii;
        LongestRun := Run;
      end {if (Run > LongestRun)};

    end {if TPNGFilter(ii) in Owner.Filters};
end;

{TChunkPLTE implementation}

{Returns an item in the palette}
function TChunkPLTE.GetPaletteItem(Index: Byte): TRGBQuad;
begin
  {Test if item is valid, if not raise error}
  if Index > Count - 1 then
    Owner.RaiseError(EPNGError, EPNGUnknownPalEntryText)
  else
    {Returns the item}
    Result := Header.FBitmapInfo.bmiColors[Index];
end;

{Loads the palette chunk from a stream}
function TChunkPLTE.LoadFromStream(Stream: IStream;
  const ChunkName: TChunkName; Size: Integer): Boolean;
type
  pPalEntry = ^PalEntry;
  PalEntry = record
    r, g, b: Byte;
  end;
var
  j        : Integer;          {For the FOR}
  PalColor : pPalEntry;
  palEntries: TMaxLogPalette;
begin
  {Let ancestor load data and check CRC}
  Result := inherited LoadFromStream(Stream, ChunkName, Size);
  if not Result then Exit;

  {This chunk must be divisible by 3 in order to be valid}
  if (Size mod 3 <> 0) or (Size div 3 > 256) then
  begin
    {Raise error}
    Result := FALSE;
    Owner.RaiseError(EPNGInvalidPalette, EPNGInvalidPaletteText);
    Exit;
  end {if Size mod 3 <> 0};

  {Fill array with the palette entries}
  FCount := Size div 3;
  Fillchar(palEntries, sizeof(palEntries), #0);
  palEntries.palVersion := $300;
  palEntries.palNumEntries := FCount;
  PalColor := Data;
  FOR j := 0 TO FCount - 1 DO
    with palEntries.palPalEntry[j] do
    begin
      peRed  :=  Owner.GammaTable[PalColor.r];
      peGreen := Owner.GammaTable[PalColor.g];
      peBlue :=  Owner.GammaTable[PalColor.b];
      peFlags := 0;
      {Move to next palette entry}
      inc(PalColor);
    end;
  Owner.SetPalette(CreatePalette(pLogPalette(@palEntries)^));
end;

{Saves the PLTE chunk to a stream}
function TChunkPLTE.SaveToStream(Stream: IStream): Boolean;
var
  J: Integer;
  DataPtr: pByte;
  FBitmapInfo: TMAXBITMAPINFO;
  palEntries: TMaxLogPalette;
begin
  {Adjust size to hold all the palette items}
  if FCount = 0 then FCount := Header.FBitmapInfo.bmiHeader.biClrUsed;
  ResizeData(FCount * 3);
  {Get all the palette entries}
  fillchar(palEntries, sizeof(palEntries), #0);
  GetPaletteEntries(Header.FImagePalette, 0, 256, palEntries.palPalEntry[0]);
  {Copy pointer to data}
  DataPtr := FData;

  {Copy palette items}
  FBitmapInfo := Header.FBitmapInfo;
  FOR j := 0 TO FCount - 1 DO
    with palEntries.palPalEntry[j] do
    begin
      DataPtr^ := Owner.FInverseGamma[peRed]; inc(DataPtr);
      DataPtr^ := Owner.FInverseGamma[peGreen]; inc(DataPtr);
      DataPtr^ := Owner.FInverseGamma[peBlue]; inc(DataPtr);
    end {with FBitmapInfo};

  {Let ancestor do the rest of the work}
  Result := inherited SaveToStream(Stream);
end;

{Assigns from another PLTE chunk}
procedure TChunkPLTE.Assign(Source: TChunk);
begin
  {Copy the number of palette items}
  if Source is TChunkPLTE then
    FCount := TChunkPLTE(Source).FCount
  else
    Owner.RaiseError(EPNGError, EPNGCannotAssignChunkText);
end;

{TChunkgAMA implementation}

{Assigns from another chunk}
procedure TChunkgAMA.Assign(Source: TChunk);
begin
  {Copy the gamma value}
  if Source is TChunkgAMA then
    Gamma := TChunkgAMA(Source).Gamma
  else
    Owner.RaiseError(EPNGError, EPNGCannotAssignChunkText);
end;

{Gamma chunk being created}
constructor TChunkgAMA.Create(Owner: TGMPngImage);
begin
  {Call ancestor}
  inherited Create(Owner);
  Gamma := 1;  {Initial value}
end;

{Returns gamma value}
function TChunkgAMA.GetValue: Cardinal;
begin
  {Make sure that the size is four bytes}
  if DataSize <> 4 then
  begin
    {Adjust size and returns 1}
    ResizeData(4);
    Result := 1;
  end
  {If it's right, read the value}
  else Result := Cardinal(ByteSwap(pCardinal(Data)^))
end;

function Power(Base, Exponent: Extended): Extended;
begin
  if Exponent = 0.0 then
    Result := 1.0               {Math rule}
  else if (Base = 0) or (Exponent = 0) then Result := 0
  else
    Result := Exp(Exponent * Ln(Base));
end;

{Loading the chunk from a stream}
function TChunkgAMA.LoadFromStream(Stream: IStream;
  const ChunkName: TChunkName; Size: Integer): Boolean;
var
  i: Integer;
  Value: Cardinal;
begin
  {Call ancestor and test if it went ok}
  Result := inherited LoadFromStream(Stream, ChunkName, Size);
  if not Result then Exit;
  Value := Gamma;
  {Build gamma table and inverse table for saving}
  if Value <> 0 then
    with Owner do
      FOR i := 0 TO 255 DO
      begin
        GammaTable[I] := Round(Power((I / 255), 1 /
          (Value / 100000 * 2.2)) * 255);
        FInverseGamma[Round(Power((I / 255), 1 /
          (Value / 100000 * 2.2)) * 255)] := I;
      end
end;

{Sets the gamma value}
procedure TChunkgAMA.SetValue(const Value: Cardinal);
begin
  {Make sure that the size is four bytes}
  if DataSize <> 4 then ResizeData(4);
  {If it's right, set the value}
  pCardinal(Data)^ := ByteSwap(Value);
end;

{TGMPngImage implementation}

{Assigns from another object}
procedure TGMPngImage.Assign(Source: TPersistent);
begin
  {Being cleared}
  if Source = nil then
    ClearChunks
  {Assigns contents from another TGMPngImage}
  else if Source is TGMPngImage then
    AssignPNG(Source as TGMPngImage)
  {Copy contents from a TBitmap}
  {$IFDEF UseDelphi}else if Source is TBitmap then
    with Source as TBitmap do
      AssignHandle(Handle, Transparent,
        ColorToRGB(TransparentColor)){$ENDIF}
  {Unknown source, let ancestor deal with it}
  else
    inherited;
end;

{Clear all the chunks in the list}
procedure TGMPngImage.ClearChunks;
var
  i: Integer;
begin
  {Initialize gamma}
  InitializeGamma();
  {Free all the objects and memory (0 chunks Bug fixed by Noel Sharpe)}
  for i := 0 TO Integer(Chunks.Count) - 1 do TObject(Chunks.Item[i]).Free;
  Chunks.Count := 0;
end;

constructor TGMPngImage.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  {$IFDEF UseDelphi}FCanvas := TCanvas.Create;{$ENDIF}
  FFilters := [pfSub];
  FCompressionLevel := 7;
  FInterlaceMethod := imNone;
  FMaxIdatSize := High(Word);
  {Create chunklist object}
  FChunkList := TChunkList.Create(Self);
end;

{Portable Network Graphics object being created as a blank image}
constructor TGMPngImage.CreateBlank(ColorType, BitDepth: Cardinal; cx, cy: Integer; const ARefLifeTime: Boolean = True);
var NewIHDR: TChunkIHDR;
begin
  {Calls creator}
  Create(ARefLifeTime);
  {Checks if the parameters are ok}
  if not (ColorType in [COLOR_GRAYSCALE, COLOR_RGB, COLOR_PALETTE,
    COLOR_GRAYSCALEALPHA, COLOR_RGBALPHA]) or not (BitDepth in
    [1,2,4,8, 16]) or ((ColorType = COLOR_PALETTE) and (BitDepth = 16)) or
    ((ColorType = COLOR_RGB) and (BitDepth < 8)) then
  begin
    RaiseError(EPNGInvalidSpec, EInvalidSpecText);
    Exit;
  end;
  if Bitdepth = 2 then Bitdepth := 4;

  {Add the basis chunks}
  InitializeGamma;
  FBeingCreated := True;
  Chunks.AddByClass(TChunkIEND);
  NewIHDR := Chunks.AddByClass(TChunkIHDR) as TChunkIHDR;
  NewIHDR.FIHDRData.ColorType := ColorType;
  NewIHDR.FIHDRData.BitDepth := BitDepth;
  NewIHDR.FIHDRData.Width := cx;
  NewIHDR.FIHDRData.Height := cy;
  NewIHDR.PrepareImageData;
  if NewIHDR.FHasPalette then
    TChunkPLTE(Chunks.AddByClass(TChunkPLTE)).FCount := 1 shl BitDepth;
  Chunks.AddByClass(TChunkIDAT);
  FBeingCreated := False;
end;

destructor TGMPngImage.Destroy;
begin
  {Free object list}
  ClearChunks;
  FChunkList.Free;
  {$IFDEF UseDelphi}if FCanvas <> nil then FCanvas.Free;{$ENDIF}

  inherited Destroy;
end;

function TGMPngImage.Obj: TGMPngImage;
begin
  Result := Self;
end;

{Returns linesize and byte offset for pixels}
procedure TGMPngImage.GetPixelInfo(var LineSize, Offset: Cardinal);
begin
  {There must be an Header chunk to calculate size}
  if HeaderPresent then
  begin
    {Calculate number of bytes for each line}
    LineSize := BytesForPixels(Header.Width, Header.ColorType, Header.BitDepth);

    {Calculates byte offset}
    Case Header.ColorType of
      {Grayscale}
      COLOR_GRAYSCALE:
        If Header.BitDepth = 16 Then
          Offset := 2
        Else
          Offset := 1 ;
      {It always smaller or equal one byte, so it occupes one byte}
      COLOR_PALETTE:
        offset := 1;
      {It might be 3 or 6 bytes}
      COLOR_RGB:
        offset := 3 * Header.BitDepth Div 8;
      {It might be 2 or 4 bytes}
      COLOR_GRAYSCALEALPHA:
        offset := 2 * Header.BitDepth Div 8;
      {4 or 8 bytes}
      COLOR_RGBALPHA:
        offset := 4 * Header.BitDepth Div 8;
      else
        Offset := 0;
      End ;

  end
  else
  begin
    {In case if there isn't any Header chunk}
    Offset := 0;
    LineSize := 0;
  end;

end;

{Returns image height}
function TGMPngImage.GetHeight: Integer;
begin
  {There must be a Header chunk to get the size, otherwise returns 0}
  if HeaderPresent then
    Result := TChunkIHDR(Chunks.Item[0]).Height
  else Result := 0;
end;

{Returns image width}
function TGMPngImage.GetWidth: Integer;
begin
  {There must be a Header chunk to get the size, otherwise returns 0}
  if HeaderPresent then
    Result := Header.Width
  else Result := 0;
end;

function TGMPngImage.Size: TPoint;
begin
  Result := GMPoint(Width, Height);
end;

{Returns if the image is empty}
function TGMPngImage.GetEmpty: Boolean;
begin
  Result := (Chunks.Count = 0);
end;

{Raises an error}
procedure TGMPngImage.RaiseError(ExceptionClass: ExceptClass; Text: String);
begin
  raise ExceptionClass.Create(Text);
end;

{Set the maximum size for IDAT chunk}
procedure TGMPngImage.SetMaxIdatSize(const Value: LongWord);
begin
  {Make sure the size is at least 65535}
  if Value < High(Word) then
    FMaxIdatSize := High(Word) else FMaxIdatSize := Value;
end;

{Draws the image using pixel information from TChunkpHYs}
procedure TGMPngImage.DrawUsingPixelInformation(Canvas: TCanvas; Point: TPoint);
  function Rect(Left, Top, Right, Bottom: Integer): TRect;
  begin
    Result.Left := Left;
    Result.Top := Top;
    Result.Right := Right;
    Result.Bottom := Bottom;
  end;
var
  PPMeterY, PPMeterX: Double;
  NewSizeX, NewSizeY: Integer;
  DC: HDC;
begin
  {Get system information}
  DC := GetDC(0);
  PPMeterY := GetDeviceCaps(DC, LOGPIXELSY) / 0.0254;
  PPMeterX := GetDeviceCaps(DC, LOGPIXELSX) / 0.0254;
  ReleaseDC(0, DC);

  {In case it does not has pixel information}
  if not HasPixelInformation then
    Draw(Canvas, Rect(Point.X, Point.Y, Point.X + Width,
      Point.Y + Height))
  else
    with PixelInformation do
    begin
      NewSizeX := Trunc(Self.Width / (PPUnitX / PPMeterX));
      NewSizeY := Trunc(Self.Height / (PPUnitY / PPMeterY));
      Draw(Canvas, Rect(Point.X, Point.Y, Point.X + NewSizeX,
      Point.Y + NewSizeY));
    end;
end;

{
  // Creates a file stream reading from the filename in the parameter and load
  procedure TGMPngImage.LoadFromFile(const Filename: String);
  var
    FileStream: TFileStream;
  begin
    // Test if the file exists
    if not FileExists(Filename) then
    begin
      // In case it does not exists, raise error
      RaiseError(EPNGNotExists, EPNGNotExistsText);
      Exit;
    end;

    // Creates the file stream to read
    FileStream := TFileStream.Create(Filename, [fsmRead]);
    LoadFromStream(FileStream);  // Loads the data
    FileStream.Free;             // Free file stream
  end;

  // Saves the current png image to a file
  procedure TGMPngImage.SaveToFile(const Filename: String);
  var
    FileStream: TFileStream;
  begin
    // Creates the file stream to write
    FileStream := TFileStream.Create(Filename, [fsmWrite]);
    SaveToStream(FileStream);    // Saves the data
    FileStream.Free;             // Free file stream
  end;
}

{Returns if it has the pixel information chunk}
function TGMPngImage.HasPixelInformation: Boolean;
begin
  Result := (Chunks.ItemFromClass(TChunkpHYs) as tChunkpHYs) <> nil;
end;

{Returns the pixel information chunk}
function TGMPngImage.GetPixelInformation: TChunkpHYs;
begin
  Result := Chunks.ItemFromClass(TChunkpHYs) as tChunkpHYs;
  if not Assigned(Result) then
  begin
    Result := Chunks.AddByClass(tChunkpHYs) as tChunkpHYs;
    Result.FUnit := utMeter;
  end;
end;

{Returns pointer to the chunk TChunkIHDR which should be the first}
function TGMPngImage.GetHeader: TChunkIHDR;
begin
  {If there is a TChunkIHDR returns it, otherwise returns nil}
  if (Chunks.Count <> 0) and (Chunks.Item[0] is TChunkIHDR) then
    Result := Chunks.Item[0] as TChunkIHDR
  else
  begin
    {No header, throw error message}
    RaiseError(EPNGHeaderNotPresent, EPNGHeaderNotPresentText);
    Result := nil
  end
end;

{Draws using partial transparency}
procedure TGMPngImage.DrawPartialTrans(DC: HDC; Rect: TRect);
  {Adjust the rectangle structure}
  procedure AdjustRect(var Rect: TRect);
  var
    t: Integer;
  begin
    if Rect.Right < Rect.Left then
    begin
      t := Rect.Right;
      Rect.Right := Rect.Left;
      Rect.Left := t;
    end;
    if Rect.Bottom < Rect.Top then
    begin
      t := Rect.Bottom;
      Rect.Bottom := Rect.Top;
      Rect.Top := t;
    end
  end;

type
  {Access to pixels}
  TPixelLine = array[Word] of TRGBQuad;
  pPixelLine = ^TPixelLine;
const
  {Structure used to create the bitmap}
  BitmapInfoHeader: TBitmapInfoHeader =
    (biSize: sizeof(TBitmapInfoHeader);
     biWidth: 100;
     biHeight: 100;
     biPlanes: 1;
     biBitCount: 32;
     biCompression: BI_RGB;
     biSizeImage: 0;
     biXPelsPerMeter: 0;
     biYPelsPerMeter: 0;
     biClrUsed: 0;
     biClrImportant: 0);
var
  {Buffer bitmap creation}
  FBitmapInfo  : TBitmapInfo;
  BufferDC    : HDC;
  BufferBits  : Pointer;
  OldBitmap,
  BufferBitmap: HBitmap;
  Header: TChunkIHDR;

  {Transparency/palette chunks}
  TransparencyChunk: TChunktRNS;
  PaletteChunk: TChunkPLTE;
  TransValue, PaletteIndex: Byte;
  CurBit: Integer;
  Data: PByte;

  {Buffer bitmap modification}
  BytesPerRowDest,
  BytesPerRowSrc,
  BytesPerRowAlpha: Integer;
  ImageSource, ImageSourceOrg,
  AlphaSource     : pByteArray;
  FImageData       : pPixelLine;
  i, j, i2, j2    : Integer;

  {For bitmap stretching}
  W, H            : Cardinal;
  Stretch         : Boolean;
  FactorX, FactorY: Double;
begin
  {Prepares the rectangle structure to stretch draw}
  if (Rect.Right = Rect.Left) or (Rect.Bottom = Rect.Top) then Exit;
  AdjustRect(Rect);
  {Gets the width and height}
  W := Rect.Right - Rect.Left;
  H := Rect.Bottom - Rect.Top;
  Header := Self.Header; {Fast access to header}
  Stretch := (W <> Header.Width) or (H <> Header.Height);
  if Stretch then FactorX := W / Header.Width else FactorX := 1;
  if Stretch then FactorY := H / Header.Height else FactorY := 1;

  {Prepare to create the bitmap}
  Fillchar(FBitmapInfo, sizeof(FBitmapInfo), #0);
  BitmapInfoHeader.biWidth := W;
  BitmapInfoHeader.biHeight := -Integer(H);
  FBitmapInfo.bmiHeader := BitmapInfoHeader;

  {Create the bitmap which will receive the background, the applied}
  {alpha blending and then will be painted on the background}
  BufferDC := CreateCompatibleDC(0);
  {In case BufferDC could not be created}
  if (BufferDC = 0) then RaiseError(EPNGOutMemory, EPNGOutMemoryText);
  BufferBitmap := CreateDIBSection(BufferDC, FBitmapInfo, DIB_RGB_COLORS, BufferBits, 0, 0);
  {In case buffer bitmap could not be created}
  if (BufferBitmap = 0) or (BufferBits = Nil) then
  begin
    if BufferBitmap <> 0 then DeleteObject(BufferBitmap);
    DeleteDC(BufferDC);
    RaiseError(EPNGOutMemory, EPNGOutMemoryText);
  end;

  {Selects new bitmap and release old bitmap}
  OldBitmap := SelectObject(BufferDC, BufferBitmap);

  {Draws the background on the buffer image}
  BitBlt(BufferDC, 0, 0, W, H, DC, Rect.Left, Rect.Top, SRCCOPY);

  BytesPerRowAlpha := Header.Width;
  BytesPerRowDest := (((FBitmapInfo.bmiHeader.biBitCount * W) + 31) and not 31) div 8; // <- Number of bytes for each image row in destination
  BytesPerRowSrc := (((Header.FBitmapInfo.bmiHeader.biBitCount * Header.Width) + 31) and not 31) div 8; // <- Number of bytes for each image row in source

  FImageData := BufferBits;
  AlphaSource := Header.FImageAlpha;
  LongInt(ImageSource) := LongInt(Header.FImageData) +
    Header.BytesPerRow * LongInt(Header.Height - 1);
  ImageSourceOrg := ImageSource;

  case Header.FBitmapInfo.bmiHeader.biBitCount of
    {R, G, B images}
    24:
      FOR j := 1 TO H DO
      begin
        {Process all the pixels in this line}
        FOR i := 0 TO W - 1 DO
        begin
          if Stretch then i2 := trunc(i / FactorX) else i2 := i;
          {Optmize when we don�t have transparency}
          if (AlphaSource[i2] <> 0) then
            if (AlphaSource[i2] = 255) then
            begin
              pRGBTriple(@FImageData[i])^ := pRGBTriple(@ImageSource[i2 * 3])^;
              FImageData[i].rgbReserved := 255;
            end
            else
              with FImageData[i] do
              begin
                rgbRed := (255+ImageSource[2+i2*3] * AlphaSource[i2] + rgbRed * (not AlphaSource[i2])) shr 8;
                rgbGreen := (255+ImageSource[1+i2*3] * AlphaSource[i2] + rgbGreen * (not AlphaSource[i2])) shr 8;
                rgbBlue := (255+ImageSource[i2*3] * AlphaSource[i2] + rgbBlue * (not AlphaSource[i2])) shr 8;
                rgbReserved := not ((255 + (not rgbReserved) * (not AlphaSource[i2])) shr 8);
            end;
          end;

        {Move pointers}
        inc(LongInt(FImageData), BytesPerRowDest);
        if Stretch then j2 := trunc(j / FactorY) else j2 := j;
        LongInt(ImageSource) := LongInt(ImageSourceOrg) - BytesPerRowSrc * j2;
        LongInt(AlphaSource) := LongInt(Header.FImageAlpha) + BytesPerRowAlpha * j2;
      end;
    {Palette images with 1 byte for each pixel}
    1,4,8: if Header.ColorType = COLOR_GRAYSCALEALPHA then
      FOR j := 1 TO H DO
      begin
        {Process all the pixels in this line}
        FOR i := 0 TO W - 1 DO
          with FImageData[i], Header.FBitmapInfo do begin
            if Stretch then i2 := trunc(i / FactorX) else i2 := i;
            rgbRed := (255 + ImageSource[i2] * AlphaSource[i2] + rgbRed * (255 - AlphaSource[i2])) shr 8;
            rgbGreen := (255 + ImageSource[i2] * AlphaSource[i2] + rgbGreen * (255 - AlphaSource[i2])) shr 8;
            rgbBlue := (255 + ImageSource[i2] * AlphaSource[i2] + rgbBlue * (255 - AlphaSource[i2])) shr 8;
          end;

        {Move pointers}
        LongInt(FImageData) := LongInt(FImageData) + BytesPerRowDest;
        if Stretch then j2 := trunc(j / FactorY) else j2 := j;
        LongInt(ImageSource) := LongInt(ImageSourceOrg) - BytesPerRowSrc * j2;
        LongInt(AlphaSource) := LongInt(Header.FImageAlpha) +
          BytesPerRowAlpha * j2;
      end
    else {Palette images}
    begin
      {Obtain pointer to the transparency chunk}
      TransparencyChunk := TChunktRNS(Chunks.ItemFromClass(TChunktRNS));
      PaletteChunk := TChunkPLTE(Chunks.ItemFromClass(TChunkPLTE));

      FOR j := 1 TO H DO
      begin
        {Process all the pixels in this line}
        i := 0;
        repeat
          CurBit := 0;
          if Stretch then i2 := trunc(i / FactorX) else i2 := i;
          Data := @ImageSource[i2];

          repeat
            {Obtains the palette index}
            case Header.BitDepth of
              1: PaletteIndex := (Data^ shr (7-(I Mod 8))) and 1;
            2,4: PaletteIndex := (Data^ shr ((1-(I Mod 2))*4)) and $0F;
             else PaletteIndex := Data^;
            end;

            {Updates the image with the new pixel}
            with FImageData[i] do
            begin
              TransValue := TransparencyChunk.PaletteValues[PaletteIndex];
              rgbRed := (255 + PaletteChunk.Item[PaletteIndex].rgbRed *
                 TransValue + rgbRed * (255 - TransValue)) shr 8;
              rgbGreen := (255 + PaletteChunk.Item[PaletteIndex].rgbGreen *
                 TransValue + rgbGreen * (255 - TransValue)) shr 8;
              rgbBlue := (255 + PaletteChunk.Item[PaletteIndex].rgbBlue *
                 TransValue + rgbBlue * (255 - TransValue)) shr 8;
            end;

            {Move to next data}
            inc(i); inc(CurBit, Header.FBitmapInfo.bmiHeader.biBitCount);
          until CurBit >= 8;
          {Move to next source data}
          //inc(Data);
        until i >= Integer(W);

        {Move pointers}
        LongInt(FImageData) := LongInt(FImageData) + BytesPerRowDest;
        if Stretch then j2 := trunc(j / FactorY) else j2 := j;
        LongInt(ImageSource) := LongInt(ImageSourceOrg) - BytesPerRowSrc * j2;
      end
    end {Palette images}
  end {case Header.FBitmapInfo.bmiHeader.biBitCount};

  {Draws the new bitmap on the foreground}
  BitBlt(DC, Rect.Left, Rect.Top, W, H, BufferDC, 0, 0, SRCCOPY);

  {Free bitmap}
  SelectObject(BufferDC, OldBitmap);
  DeleteObject(BufferBitmap);
  DeleteDC(BufferDC);
end;

{Draws the image into a canvas}
procedure TGMPngImage.Draw(ACanvas: TCanvas; const Rect: TRect);
var
  Header: TChunkIHDR;
begin
  {Quit in case there is no header, otherwise obtain it}
  if Empty then Exit;
  Header := Chunks.GetItem(0) as TChunkIHDR;

  {Copy the data to the canvas}
  case Self.TransparencyMode of
  {$IFDEF PartialTransparentDraw}
    ptmPartial:
      DrawPartialTrans(ACanvas{$IFDEF UseDelphi}.Handle{$ENDIF}, Rect);
  {$ENDIF}
    ptmBit: DrawTransparentBitmap(ACanvas{$IFDEF UseDelphi}.Handle{$ENDIF},
      Header.FImageData, Header.FBitmapInfo.bmiHeader,
      pBitmapInfo(@Header.FBitmapInfo), Rect,
      {$IFDEF UseDelphi}ColorToRGB({$ENDIF}TransparentColor)
      {$IFDEF UseDelphi}){$ENDIF}
    else
    begin
      SetStretchBltMode(ACanvas{$IFDEF UseDelphi}.Handle{$ENDIF}, COLORONCOLOR);
      StretchDiBits(ACanvas{$IFDEF UseDelphi}.Handle{$ENDIF}, Rect.Left,
        Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top, 0, 0,
        Header.Width, Header.Height, Header.FImageData,
        pBitmapInfo(@Header.FBitmapInfo)^, DIB_RGB_COLORS, SRCCOPY)
    end
  end {case}
end;

{Characters for the header}
const
  PngHeader: array[0..7] of AnsiChar = (#137, #80, #78, #71, #13, #10, #26, #10);

{Loads the image from a stream of data}
procedure TGMPngImage.LoadFromStream(Stream: IStream);
var
  Header    : array[0..7] of AnsiChar;
  HasIDAT   : Boolean;

  {Chunks reading}
  ChunkCount : LongInt;
  ChunkLength: Cardinal;
  ChunkName  : TChunkName;
begin
  {Initialize before start loading chunks}
  ChunkCount := 0;
  ClearChunks();
  {Reads the header}
  GMSafeIStreamRead(Stream, @Header[0], SizeOf(Header));

  {Test if the header matches}
  if Header <> PngHeader then
  begin
    RaiseError(EPNGInvalidFileHeader, EPNGInvalidFileHeaderText);
    Exit;
  end;


  HasIDAT := FALSE;
  Chunks.Count := 10;

  {Load chunks}
  repeat
    inc(ChunkCount);  {Increment number of chunks}
    if Chunks.Count < ChunkCount then  {Resize the chunks list if needed}
      Chunks.Count := Chunks.Count + 10;

    {Reads chunk length and invert since it is in network order}
    {also checks the Read method return, if it returns 0, it}
    {means that no bytes was readed, probably because it reached}
    {the end of the file}
    if GMIStreamRead(Stream, @ChunkLength, SizeOf(ChunkLength)) = 0 then
    begin
      {In case it found the end of the file here}
      Chunks.Count := ChunkCount - 1;
      RaiseError(EPNGUnexpectedEnd, EPNGUnexpectedEndText);
    end;

    ChunkLength := ByteSwap(ChunkLength);
    {Reads chunk name}
    GMSafeIStreamRead(Stream, @Chunkname, SizeOf(Chunkname));

    {Here we check if the first chunk is the Header which is necessary}
    {to the file in order to be a valid Portable Network Graphics image}
    if (ChunkCount = 1) and (ChunkName <> 'IHDR') then
    begin
      Chunks.Count := ChunkCount - 1;
      RaiseError(EPNGIHDRNotFirst, EPNGIHDRNotFirstText);
      Exit;
    end;

    {Has a previous IDAT}
    if (HasIDAT and (ChunkName = 'IDAT')) or (ChunkName = 'cHRM') then
    begin
      dec(ChunkCount);
      GMHrCheckObj(Stream.Seek(ChunkLength + 4, STREAM_SEEK_CUR, nil), Self);
      Continue;
    end;
    {Tell it has an IDAT chunk}
    if ChunkName = 'IDAT' then HasIDAT := TRUE;

    {Creates object for this chunk}
    Chunks.SetItem(ChunkCount - 1, CreateChunkByClass(Self, ChunkName));

    {Check if the chunk is critical and unknown}
    {$IFDEF ErrorOnUnknownCritical}
      if (TChunk(Chunks.Item[ChunkCount - 1]).ClassType = TChunk) and
        ((Byte(ChunkName[0]) AND $20) = 0) and (ChunkName <> '') then
      begin
        Chunks.Count := ChunkCount;
        RaiseError(EPNGUnknownCriticalChunk, EPNGUnknownCriticalChunkText);
      end;
    {$ENDIF}

    {Loads it}
    try if not TChunk(Chunks.Item[ChunkCount - 1]).LoadFromStream(Stream,
       ChunkName, ChunkLength) then break;
    except
      Chunks.Count := ChunkCount;
      raise;
    end;

  {Terminates when it reaches the IEND chunk}
  until (ChunkName = 'IEND');

  {Resize the list to the appropriate size}
  Chunks.Count := ChunkCount;

  {Check if there is data}
  if not HasIDAT then
    RaiseError(EPNGNoImageData, EPNGNoImageDataText);
end;

{Changing height is not supported}
procedure TGMPngImage.SetHeight(Value: Integer);
begin
  Resize(Width, Value)
end;

{Changing width is not supported}
procedure TGMPngImage.SetWidth(Value: Integer);
begin
  Resize(Value, Height)
end;

{$IFDEF UseDelphi}
{Saves to clipboard format (thanks to Antoine Pottern)}
procedure TGMPngImage.SaveToClipboardGMFormat(var AFormat: Word;
  var AData: THandle; var APalette: HPalette);
begin
  with TBitmap.Create do
    try
      Width := Self.Width;
      Height := Self.Height;
      Self.Draw(Canvas, Rect(0, 0, Width, Height));
      SaveToClipboardGMFormat(AFormat, AData, APalette);
    finally
      Free;
    end {try}
end;

{Loads data from clipboard}
procedure TGMPngImage.LoadFromClipboardGMFormat(AFormat: Word;
  AData: THandle; APalette: HPalette);
begin
  with TBitmap.Create do
    try
      LoadFromClipboardGMFormat(AFormat, AData, APalette);
      Self.AssignHandle(Handle, False, 0);
    finally
      Free;
    end {try}
end;

{Returns if the image is transparent}
function TGMPngImage.GetTransparent: Boolean;
begin
  Result := (TransparencyMode <> ptmNone);
end;

{$ENDIF}

{Saving the PNG image to a stream of data}
procedure TGMPngImage.SaveToStream(Stream: IStream);
var
  j: Integer;
begin
  {Reads the header}
  GMSafeIStreamWrite(Stream, @PNGHeader[0], SizeOf(PNGHeader));
  {Write each chunk}
  FOR j := 0 TO Chunks.Count - 1 DO
    Chunks.Item[j].SaveToStream(Stream)
end;

{Prepares the Header chunk}
procedure BuildHeader(Header: TChunkIHDR; Handle: HBitmap; Info: pBitmap);
var
  DC: HDC;
begin
  {Set width and height}
  Header.Width  := Info.bmWidth;
  Header.Height := abs(Info.bmHeight);
  {Set bit depth}
  if Info.bmBitsPixel >= 16 then
    Header.BitDepth := 8 else Header.BitDepth := Info.bmBitsPixel;
  {Set color type}
  if Info.bmBitsPixel >= 16 then
    Header.ColorType := COLOR_RGB else Header.ColorType := COLOR_PALETTE;
  {Set other info}
  Header.CompressionMethod := 0;  {deflate/inflate}
  Header.InterlaceMethod := 0;    {no interlace}

  {Prepares bitmap headers to hold data}
  Header.PrepareImageData();
  {Copy image data}
  DC := CreateCompatibleDC(0);
  GetDIBits(DC, Handle, 0, Header.Height, Header.FImageData,
    pBitmapInfo(@Header.FBitmapInfo)^, DIB_RGB_COLORS);

  DeleteDC(DC);
end;

{Assigns this TGMPngImage to another object}
procedure TGMPngImage.AssignTo(Dest: TPersistent);
{$IFDEF UseDelphi}
  function DetectPixelFormat: TPixelFormat;
  begin
    with Header do
    begin
      {Always use 24bits for partial transparency}
      if TransparencyMode = ptmPartial then
        DetectPixelFormat := pf24bit
      else
        case BitDepth of
          {Only supported by COLOR_PALETTE}
          1: DetectPixelFormat := pf1bit;
          2, 4: DetectPixelFormat := pf4bit;
          {8 may be palette or r, g, b values}
          8, 16:
            case ColorType of
              COLOR_RGB, COLOR_GRAYSCALE: DetectPixelFormat := pf24bit;
              COLOR_PALETTE: DetectPixelFormat := pf8bit;
              else raise Exception.Create('');
            end {case ColorFormat of}
          else raise Exception.Create('');
        end {case BitDepth of}
    end {with Header}
  end;
var
  TRNS: TChunkTRNS;
  BitmapData: PCardinal;
  PngData: PRGBTriple;
  AlphaData: PByte;
  I, J: Integer;
{$ENDIF}
begin
  {If the destination is also a TGMPngImage make it assign}
  {this one}
  if Dest is TGMPngImage then
    TGMPngImage(Dest).AssignPNG(Self)
  {$IFDEF UseDelphi}
  {In case the destination is a bitmap}
  else if (Dest is TBitmap) and HeaderPresent then
  begin
    {Copies the handle using CopyImage API}
    TBitmap(Dest).PixelFormat := DetectPixelFormat;
    TBitmap(Dest).Width := Width;
    TBitmap(Dest).Height := Height;
    TBitmap(Dest).Canvas.Draw(0, 0, Self);

    {Copy transparency mode}
    if (TransparencyMode = ptmBit) then
    begin
      TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;
      TBitmap(Dest).TransparentColor := TRNS.TransparentColor;
      TBitmap(Dest).Transparent := True
    end {if (TransparencyMode = ptmBit)}
    else if (TransparencyMode = ptmPartial) then
    begin
      TBitmap(Dest).PixelFormat := pf32bit;
      TBitmap(Dest).AlphaFormat := afIgnored;
      TBitmap(Dest).Canvas.Draw(0, 0, Self);

      for I := 0 to Height - 1 do
      begin
        BitmapData := TBitmap(Dest).ScanLine[I];
        PngData := Scanline[I];
        AlphaData := PByte(AlphaScanline[I]);
        for J := 0 to Width - 1 do
        begin
          if not Header.FHasPalette then
          begin
            BitmapData^ := (AlphaData^ shl 24) or (Round(PngData^.rgbtRed) shl 16) or (Round(PngData^.rgbtGreen) shl 8) or (Round(PngData^.rgbtBlue));
            BitmapData := PCardinal(Cardinal(BitmapData) + 4);
            PngData := PRGBTriple(Cardinal(PngData) + 3);
            AlphaData := PByte(Cardinal(AlphaData) + 1);
          end
          else
          begin
            BitmapData^ := (BitmapData^ and $00FFFFFF) or (AlphaData^ shl 24);
            BitmapData := PCardinal(Cardinal(BitmapData) + 4);
            AlphaData := PByte(Cardinal(AlphaData) + 1);
          end;
        end;
      end;

      TBitmap(Dest).AlphaFormat := afDefined;
    end;
  end
  else
    {Unknown destination kind}
    inherited AssignTo(Dest);
  {$ENDIF}
end;

{Assigns from a bitmap object}
procedure TGMPngImage.AssignHandle(Handle: HBitmap; Transparent: Boolean; TransparentColor: ColorRef);
var
  FBitmapInfo: Windows.TBitmap;
  {Chunks}
  Header: TChunkIHDR;
  PLTE: TChunkPLTE;
  IDAT: TChunkIDAT;
  IEND: TChunkIEND;
  TRNS: TChunkTRNS;
  i: Integer;
  palEntries : TMaxLogPalette;
begin
  {Obtain bitmap info}
  GetObject(Handle, SizeOf(FBitmapInfo), @FBitmapInfo);

  {Clear old chunks and prepare}
  ClearChunks();

  {Create the chunks}
  Header := TChunkIHDR.Create(Self);

  {This method will fill the Header chunk with bitmap information}
  {and copy the image data}
  BuildHeader(Header, Handle, @FBitmapInfo);

  if Header.FHasPalette then PLTE := TChunkPLTE.Create(Self) else PLTE := nil;
  if Transparent then TRNS := TChunkTRNS.Create(Self) else TRNS := nil;
  IDAT := TChunkIDAT.Create(Self);
  IEND := TChunkIEND.Create(Self);

  {Add chunks}
  Chunks.Add(Header);
  if Header.FHasPalette then Chunks.Add(PLTE);
  if Transparent then Chunks.Add(TRNS);
  Chunks.Add(IDAT);
  Chunks.Add(IEND);

  {In case there is a image data, set the PLTE chunk FCount variable}
  {to the actual number of palette colors which is 2^(Bits for each pixel)}
  if Header.FHasPalette then
  begin
    PLTE.FCount := 1 shl FBitmapInfo.bmBitsPixel;

    {Create and set palette}
    fillchar(palEntries, sizeof(palEntries), 0);
    palEntries.palVersion := $300;
    palEntries.palNumEntries := 1 shl FBitmapInfo.bmBitsPixel;
    for i := 0 to palEntries.palNumEntries - 1 do
    begin
      palEntries.palPalEntry[i].peRed   := Header.FBitmapInfo.bmiColors[i].rgbRed;
      palEntries.palPalEntry[i].peGreen := Header.FBitmapInfo.bmiColors[i].rgbGreen;
      palEntries.palPalEntry[i].peBlue  := Header.FBitmapInfo.bmiColors[i].rgbBlue;
    end;
    DoSetPalette(CreatePalette(pLogPalette(@palEntries)^), false);
  end;

  {In case it is a transparent bitmap, prepares it}
  if Transparent then TRNS.TransparentColor := TransparentColor;
end;

{Assigns from another PNG}
procedure TGMPngImage.AssignPNG(Source: TGMPngImage);
var
  J: Integer;
begin
  {Copy properties}
  InterlaceMethod := Source.InterlaceMethod;
  MaxIdatSize := Source.MaxIdatSize;
  CompressionLevel := Source.CompressionLevel;
  Filters := Source.Filters;

  {Clear old chunks and prepare}
  ClearChunks();
  Chunks.Count := Source.Chunks.Count;
  {Create chunks and makes a copy from the source}
  FOR J := 0 TO Chunks.Count - 1 DO
    with Source.Chunks do
    begin
      Chunks.SetItem(J, TChunkClass(TChunk(Item[J]).ClassType).Create(Self));
      TChunk(Chunks.Item[J]).Assign(TChunk(Item[J]));
    end {with};
end;

{Returns a alpha data scanline}
function TGMPngImage.GetAlphaScanline(const LineIndex: Integer): pByteArray;
begin
  with Header do
    if (ColorType = COLOR_RGBALPHA) or (ColorType = COLOR_GRAYSCALEALPHA) then
      LongInt(Result) := LongInt(FImageAlpha) + (LineIndex * LongInt(Width))
    else Result := nil;  {In case the image does not use alpha information}
end;

{$IFDEF Store16bits}
{Returns a png data extra scanline}
function TGMPngImage.GetExtraScanline(const LineIndex: Integer): Pointer;
begin
  with Header do
    LongInt(Result) := (LongInt(FExtraImageData) + ((LongInt(Height) - 1) * BytesPerRow)) - (LineIndex * BytesPerRow);
end;
{$ENDIF}

{Returns a png data scanline}
function TGMPngImage.GetScanline(const LineIndex: Integer): Pointer;
begin
  with Header do
    PtrInt(Result) := (PtrInt(FImageData) + ((LongInt(Height) - 1) * BytesPerRow)) - (LineIndex * BytesPerRow);
end;

{function TGMPngImage.GetSupportsPartialTransparency: Boolean;
begin
  Result := TransparencyMode = ptmPartial;
end;}

{Initialize gamma table}
procedure TGMPngImage.InitializeGamma;
var
  i: Integer;
begin
  {Build gamma table as if there was no gamma}
  FOR i := 0 to 255 do
  begin
    GammaTable[i] := i;
    FInverseGamma[i] := i;
  end {for i}
end;

{Returns the transparency mode used by this png}
function TGMPngImage.GetTransparencyMode: TPNGTransparencyMode;
var
  TRNS: TChunkTRNS;
begin
  with Header do
  begin
    Result := ptmNone; {Default Result}
    {Gets the TRNS chunk pointer}
    TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;

    {Test depending on the color type}
    case ColorType of
      {This modes are always partial}
      COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA: Result := ptmPartial;
      {This modes support bit transparency}
      COLOR_RGB, COLOR_GRAYSCALE: if TRNS <> nil then Result := ptmBit;
      {Supports booth translucid and bit}
      COLOR_PALETTE:
        {A TRNS chunk must be present, otherwise it won't support transparency}
        if TRNS <> nil then
          if TRNS.BitTransparency then
            Result := ptmBit else Result := ptmPartial
    end {case}

  end {with Header}
end;

{Add a text chunk}
procedure TGMPngImage.AddtEXt(const Keyword, Text: AnsiString);
var
  TextChunk: TChunkTEXT;
begin
  TextChunk := Chunks.AddByClass(TChunkText) as TChunkTEXT;
  TextChunk.Keyword := Keyword;
  TextChunk.Text := Text;
end;

{Add a text chunk}
procedure TGMPngImage.AddzTXt(const Keyword, Text: AnsiString);
var
  TextChunk: TChunkzTXt;
begin
  TextChunk := Chunks.AddByClass(TChunkzTXt) as TChunkzTXt;
  TextChunk.Keyword := Keyword;
  TextChunk.Text := Text;
end;

{Removes the image transparency}
procedure TGMPngImage.RemoveTransparency;
var
  TRNS: TChunkTRNS;
begin
  {Removes depending on the color type}
  with Header do
    case ColorType of
      {Palette uses the TChunktRNS to store alpha}
      COLOR_PALETTE:
      begin
       TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;
       if TRNS <> nil then Chunks.RemoveChunk(TRNS)
      end;
      {Png allocates different memory space to hold alpha information}
      {for these types}
      COLOR_GRAYSCALEALPHA, COLOR_RGBALPHA:
      begin
        {Transform into the appropriate color type}
        if ColorType = COLOR_GRAYSCALEALPHA then
          ColorType := COLOR_GRAYSCALE
        else ColorType := COLOR_RGB;
        {Free the pointer data}
        if FImageAlpha <> nil then FreeMem(FImageAlpha);
        FImageAlpha := nil
      end
    end
end;

{Generates alpha information}
procedure TGMPngImage.CreateAlpha;
var
  TRNS: TChunkTRNS;
begin
  {Generates depending on the color type}
  with Header do
    case ColorType of
      {Png allocates different memory space to hold alpha information}
      {for these types}
      COLOR_GRAYSCALE, COLOR_RGB:
      begin
        {Transform into the appropriate color type}
        if ColorType = COLOR_GRAYSCALE then
          ColorType := COLOR_GRAYSCALEALPHA
        else ColorType := COLOR_RGBALPHA;
        {Allocates memory to hold alpha information}
        GetMem(FImageAlpha, Integer(Width) * Integer(Height));
        FillChar(FImageAlpha^, Integer(Width) * Integer(Height), #255);
      end;
      {Palette uses the TChunktRNS to store alpha}
      COLOR_PALETTE:
      begin
        {Gets/creates TRNS chunk}
        if Chunks.ItemFromClass(TChunkTRNS) = nil then
          TRNS := Chunks.AddByClass(TChunkTRNS) as TChunkTRNS
        else
          TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;

          {Prepares the TRNS chunk}
          with TRNS do
          begin
            ResizeData(256);
            Fillchar(PaletteValues[0], 256, 255);
            FDataSize := 1 shl Header.BitDepth;
            FBitTransparency := False
          end {with Chunks.Add};
        end;
    end {case Header.ColorType}

end;

{Returns transparent color}
function TGMPngImage.GetTransparentColor: TColor;
var
  TRNS: TChunkTRNS;
begin
  TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;
  {Reads the transparency chunk to get this info}
  if Assigned(TRNS) then Result := TRNS.TransparentColor
    else Result := 0
end;

{$OPTIMIZATION OFF}
procedure TGMPngImage.SetTransparentColor(const Value: TColor);
var
  TRNS: TChunkTRNS;
begin
  if HeaderPresent then
    {Tests the ColorType}
    case Header.ColorType of
    {Not allowed for this modes}
    COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA: Self.RaiseError(
      EPNGCannotChangeTransparent, EPNGCannotChangeTransparentText);
    {Allowed}
    COLOR_PALETTE, COLOR_RGB, COLOR_GRAYSCALE:
      begin
        TRNS := Chunks.ItemFromClass(TChunkTRNS) as TChunkTRNS;
        if not Assigned(TRNS) then TRNS := Chunks.AddByClass(TChunkTRNS) as TChunkTRNS;

        {Sets the transparency value from TRNS chunk}
        TRNS.TransparentColor := {$IFDEF UseDelphi}ColorToRGB({$ENDIF}Value
          {$IFDEF UseDelphi}){$ENDIF}
      end {COLOR_PALETTE, COLOR_RGB, COLOR_GRAYSCALE)}
    end {case}
end;

{Returns if header is present}
function TGMPngImage.HeaderPresent: Boolean;
begin
  Result := ((Chunks.Count <> 0) and (Chunks.Item[0] is TChunkIHDR))
end;

{Returns pixel for png using palette and grayscale}
function GetByteArrayPixel(const png: TGMPngImage; const X, Y: Integer): TColor;
var
  ByteData: Byte;
  DataDepth: Byte;
begin
  with png, Header do
  begin
    {Make sure the bitdepth is not greater than 8}
    DataDepth := BitDepth;
    if DataDepth > 8 then DataDepth := 8;
    {Obtains the byte containing this pixel}
    ByteData := pByteArray(png.Scanline[Y])^[X div (8 div DataDepth)];
    {Moves the bits we need to the right}
    ByteData := (ByteData shr ((8 - DataDepth) -
      (X mod (8 div DataDepth)) * DataDepth));
    {Discard the unwanted pixels}
    ByteData:= ByteData and ($FF shr (8 - DataDepth));

    {For palette mode map the palette entry and for grayscale convert and
    returns the intensity}
    case ColorType of
      COLOR_PALETTE:
        with TChunkPLTE(png.Chunks.ItemFromClass(TChunkPLTE)).Item[ByteData] do
          Result := rgb(GammaTable[rgbRed], GammaTable[rgbGreen],
            GammaTable[rgbBlue]);
      COLOR_GRAYSCALE:
      begin
        if BitDepth = 1
        then ByteData := GammaTable[Byte(ByteData * 255)]
        else ByteData := GammaTable[Byte(ByteData * ((1 shl DataDepth) + 1))];
        Result := rgb(ByteData, ByteData, ByteData);
      end;
      else Result := 0;
    end {case};
  end {with}
end;

{In case vcl units are not being used}
{$IFNDEF UseDelphi}
function ColorToRGB(const Color: TColor): COLORREF;
begin
  Result := Color
end;
{$ENDIF}

{Sets a pixel for grayscale and palette pngs}
procedure SetByteArrayPixel(const png: TGMPngImage; const X, Y: Integer;
  const Value: TColor);
const
  ClearFlag: array[1..8] of Integer = (1, 3, 0, 15, 0, 0, 0, $FF);
var
  ByteData: pByte;
  DataDepth: Byte;
  ValEntry: Byte;
begin
  with png.Header do
  begin
    {Map into a palette entry}
    ValEntry := GetNearestPaletteIndex(Png.Palette, ColorToRGB(Value));

    {16 bits grayscale extra bits are discarted}
    DataDepth := BitDepth;
    if DataDepth > 8 then DataDepth := 8;
    {Gets a pointer to the byte we intend to change}
    ByteData := @pByteArray(png.Scanline[Y])^[X div (8 div DataDepth)];
    {Clears the old pixel data}
    ByteData^ := ByteData^ and not (ClearFlag[DataDepth] shl ((8 - DataDepth) - (X mod (8 div DataDepth)) * DataDepth));

    {Setting the new pixel}
    ByteData^ := ByteData^ or (ValEntry shl ((8 - DataDepth) - (X mod (8 div DataDepth)) * DataDepth));
  end {with png.Header}
end;

{Returns pixel when png uses RGB}
function GetRGBLinePixel(const png: TGMPngImage;
  const X, Y: Integer): TColor;
begin
  with pRGBLine(png.Scanline[Y])^[X] do
    Result := RGB(rgbtRed, rgbtGreen, rgbtBlue)
end;

{Sets pixel when png uses RGB}
procedure SetRGBLinePixel(const png: TGMPngImage;
 const X, Y: Integer; Value: TColor);
begin
  with pRGBLine(png.Scanline[Y])^[X] do
  begin
    rgbtRed := GetRValue(Value);
    rgbtGreen := GetGValue(Value);
    rgbtBlue := GetBValue(Value)
  end
end;

{Returns pixel when png uses grayscale}
function GetGrayLinePixel(const png: TGMPngImage;
  const X, Y: Integer): TColor;
var
  B: Byte;
begin
  B := PByteArray(png.Scanline[Y])^[X];
  Result := RGB(B, B, B);
end;

{Sets pixel when png uses grayscale}
procedure SetGrayLinePixel(const png: TGMPngImage;
 const X, Y: Integer; Value: TColor);
begin
  PByteArray(png.Scanline[Y])^[X] := GetRValue(Value);
end;

{Resizes the PNG image}
procedure TGMPngImage.Resize(const CX, CY: Integer);
  function Min(const A, B: Integer): Integer;
  begin
    if A < B then Result := A else Result := B;
  end;
var
  Header: TChunkIHDR;
  Line, NewBytesPerRow: Integer;
  NewHandle: HBitmap;
  NewDC: HDC;
  NewImageData: Pointer;
  NewImageAlpha: Pointer;
  NewImageExtra: Pointer;
begin
  if (CX > 0) and (CY > 0) then
  begin
    {Gets some actual information}
    Header := Self.Header;

    {Creates the new image}
    NewDC := CreateCompatibleDC(Header.FImageDC);
    Header.FBitmapInfo.bmiHeader.biWidth := cx;
    Header.FBitmapInfo.bmiHeader.biHeight := cy;
    NewHandle := CreateDIBSection(NewDC, pBitmapInfo(@Header.FBitmapInfo)^,
      DIB_RGB_COLORS, NewImageData, 0, 0);
    SelectObject(NewDC, NewHandle);
    {$IFDEF UseDelphi}Canvas.Handle := NewDC;{$ENDIF}
    NewBytesPerRow := (((Header.FBitmapInfo.bmiHeader.biBitCount * cx) + 31)
      and not 31) div 8;

    {Copies the image data}
    for Line := 0 to Min(CY - 1, Height - 1) do
      CopyMemory(Ptr(LongInt(NewImageData) + (LongInt(CY) - 1) *
      NewBytesPerRow - (Line * NewBytesPerRow)), Scanline[Line],
      Min(NewBytesPerRow, Header.BytesPerRow));

    {Build array for alpha information, if necessary}
    if (Header.ColorType = COLOR_RGBALPHA) or
      (Header.ColorType = COLOR_GRAYSCALEALPHA) then
    begin
      GetMem(NewImageAlpha, CX * CY);
      Fillchar(NewImageAlpha^, CX * CY, 255);
      for Line := 0 to Min(CY - 1, Height - 1) do
        CopyMemory(Ptr(LongInt(NewImageAlpha) + (Line * CX)),
        AlphaScanline[Line], Min(CX, Width));
      FreeMem(Header.FImageAlpha);
      Header.FImageAlpha := NewImageAlpha;
    end;

    {$IFDEF Store16bits}
    if (Header.BitDepth = 16) then
    begin
      GetMem(NewImageExtra, CX * CY);
      Fillchar(NewImageExtra^, CX * CY, 0);
      for Line := 0 to Min(CY - 1, Height - 1) do
        CopyMemory(Ptr(LongInt(NewImageExtra) + (Line * CX)),
        ExtraScanline[Line], Min(CX, Width));
      FreeMem(Header.FExtraImageData);
      Header.FExtraImageData := NewImageExtra;
    end;
    {$ENDIF}

    {Deletes the old image}
    DeleteObject(Header.FImageHandle);
    DeleteDC(Header.FImageDC);

    {Prepares the header to get the new image}
    Header.BytesPerRow := NewBytesPerRow;
    Header.FIHDRData.Width := CX;
    Header.FIHDRData.Height := CY;
    Header.FImageData := NewImageData;

    {Replaces with the new image}
    Header.FImageHandle := NewHandle;
    Header.FImageDC := NewDC;
  end
  else
    {The new size provided is invalid}
    RaiseError(EPNGInvalidNewSize, EInvalidNewSizeText)
end;

{Sets a pixel}
procedure TGMPngImage.SetPixels(const X, Y: Integer; const Value: TColor);
begin
  if ((X >= 0) and (X <= Width - 1)) and
        ((Y >= 0) and (Y <= Height - 1)) then
    with Header do
    begin
      if ColorType in [COLOR_GRAYSCALE, COLOR_PALETTE] then
        SetByteArrayPixel(Self, X, Y, Value)
      else if ColorType in [COLOR_GRAYSCALEALPHA] then
        SetGrayLinePixel(Self, X, Y, Value)
      else
        SetRGBLinePixel(Self, X, Y, Value)
    end {with}
end;


{Returns a pixel}
function TGMPngImage.GetPixels(const X, Y: Integer): TColor;
begin
  if ((X >= 0) and (X <= Width - 1)) and
        ((Y >= 0) and (Y <= Height - 1)) then
    with Header do
    begin
      if ColorType in [COLOR_GRAYSCALE, COLOR_PALETTE] then
        Result := GetByteArrayPixel(Self, X, Y)
      else if ColorType in [COLOR_GRAYSCALEALPHA] then
        Result := GetGrayLinePixel(Self, X, Y)
      else
        Result := GetRGBLinePixel(Self, X, Y)
    end {with}
  else Result := 0
end;

{Returns the image palette}
function TGMPngImage.GetPalette: HPALETTE;
begin
  Result := Header.FImagePalette;
end;

{Assigns from another TChunk}
procedure TChunkpHYs.Assign(Source: TChunk);
begin
  FPPUnitY := TChunkpHYs(Source).FPPUnitY;
  FPPUnitX := TChunkpHYs(Source).FPPUnitX;
  FUnit := TChunkpHYs(Source).FUnit;
end;

{Loads the chunk from a stream}
function TChunkpHYs.LoadFromStream(Stream: IStream; const ChunkName: TChunkName;
  Size: Integer): Boolean;
begin
  {Let ancestor load the data}
  Result := inherited LoadFromStream(Stream, ChunkName, Size);
  if not Result or (Size <> 9) then Exit; {Size must be 9}

  {Reads data}
  FPPUnitX := ByteSwap(pCardinal(LongInt(Data))^);
  FPPUnitY := ByteSwap(pCardinal(LongInt(Data) + 4)^);
  FUnit := pUnitType(LongInt(Data) + 8)^;
end;

{Saves the chunk to a stream}
function TChunkpHYs.SaveToStream(Stream: IStream): Boolean;
begin
  {Update data}
  ResizeData(9);  {Make sure the size is 9}
  pCardinal(Data)^ := ByteSwap(FPPUnitX);
  pCardinal(LongInt(Data) + 4)^ := ByteSwap(FPPUnitY);
  pUnitType(LongInt(Data) + 8)^ := FUnit;

  {Let inherited save data}
  Result := inherited SaveToStream(Stream);
end;

procedure TGMPngImage.DoSetPalette(Value: HPALETTE; const UpdateColors: boolean);
begin
  if (Header.FHasPalette)  then
  begin
    {Update the palette entries}
    if UpdateColors then Header.PaletteToDIB(Value);

    {Resize the new palette}
    SelectPalette(Header.FImageDC, Value, False);
    RealizePalette(Header.FImageDC);

    {Replaces}
    DeleteObject(Header.FImagePalette);
    Header.FImagePalette := Value;
  end
end;

{Set palette based on a windows palette handle}
procedure TGMPngImage.SetPalette(Value: HPALETTE);
begin
  DoSetPalette(Value, true);
end;

{Returns the library version}
//function TGMPngImage.GetLibraryVersion: String;
//begin
//Result := LibraryVersion
//end;

initialization
  {crc table has not being computed yet}
  crc_table_computed := FALSE;
  {$IFDEF UseDelphi}{$IFDEF RegisterGraphic}
    TPicture.RegisterFileGMFormat('PNG', 'Portable Network Graphics', TGMPngImage);
  {$ENDIF}{$ENDIF}
finalization
  {$IFDEF UseDelphi}{$IFDEF RegisterGraphic}
    TPicture.UnregisterGraphicClass(TGMPngImage);
  {$ENDIF}{$ENDIF}
end.