{Portable Network Graphics Delphi 1.564      (31 July 2006)   }



{This is a full, open sourced implementation of png in Delphi }

{It has native support for most of png features including the }

{partial transparency, gamma and more.                        }

{For the latest version, please be sure to check my website   }

{http://pngdelphi.sourceforge.net                             }

{Gustavo Huffenbacher Daud (gustavo.daud@terra.com.br)        }





{

  Version 1.564

  2006-07-25   BUG 1     - There was one GDI Palette object leak

                           when assigning from other PNG (fixed)

               BUG 2     - Loosing color information when assigning png

                           to bmp on lower screen depth system

               BUG 3     - There was a bug in TStream.GetSize

                           (fixed thanks to Vladimir Panteleev)

               IMPROVE 1 - When assigning png to bmp now alpha information

                           is drawn (simulated into a white background)



  Version 1.563

  2006-07-25   BUG 1     - There was a memory bug in the main component

                           destructor (fixed thanks to Steven L Brenner)

               BUG 2     - The packages name contained spaces which was

                           causing some strange bugs in Delphi

                           (fixed thanks to Martijn Saly)

               BUG 3     - Lots of fixes when handling palettes

                           (bugs implemented in the last version)

                           Fixed thanks to Gabriel Corneanu!!!

               BUG 4     - CreateAlpha was raising an error because it did

                           not resized the palette chunk it created;

                           Fixed thanks to Miha Sokolov

               IMPROVE 1 - Renamed the pngzlib.pas unit to zlibpas.pas

                           as a tentative to all libraries use the same

                           shared zlib implementation and to avoid including

                           two or three times the same P-Code.

                           (Gabriel Corneanu idea)







  Version 1.561

  2006-05-17   BUG 1     - There was a bug in the method that draws semi

                           transparent images (a memory leak). fixed.



  Version 1.56

  2006-05-09 - IMPROVE 1 - Delphi standard TCanvas support is now implemented

               IMPROVE 2 - The PNG files may now be resized and created from

                           scratch using CreateBlank, Resize, Width and Height

               BUG 1     - Fixed some bugs on handling tRNS transparencies

               BUG 2     - Fixed bugs related to palette handling



  Version 1.535

  2006-04-21 - IMPROVE 1 - Now the library uses the latest ZLIB release (1.2.3)

                           (thanks to: Roberto Della Pasqua

                           http://www.dellapasqua.com/delphizlib/)



  Version 1.53

  2006-04-14 -

               BUG 1 - Remove transparency was not working for

                       RGB Alpha and Grayscale alpha. fixed

               BUG 2 - There was a bug were compressed text chunks no keyword

                       name could not be read

               IMPROVE 1 - Add classes and methods to work with the pHYs chunk

                           (including TPNGObject.DrawUsingPixelInformation)

               IMPROVE 3 - Included a property Version to return the library

                           version

               IMPROVE 4 - New polish translation (thanks to Piotr Domanski)

               IMPROVE 5 - Now packages for delphi 5, 6, 7, 2005 and 2006



               Also Martijn Saly (thany) made some improvements in the library:

               IMPROVE 1 - SetPixel now works with grayscale

               IMPROVE 2 - Palette property now can be written using a

                           windows handle

               Thanks !!



  Version 1.5

  2005-06-29 - Fixed a lot of bugs using tips from mails that I´ve

	       being receiving for some time

                 BUG 1 - Loosing palette when assigning to TBitmap. fixed

                 BUG 2 - SetPixels and GetPixels worked only with

                         parameters in range 0..255. fixed

                 BUG 3 - Force type address off using directive

                 BUG 4 - TChunkzTXt contained an error

                 BUG 5 - MaxIdatSize was not working correctly (fixed thanks

                 to Gabriel Corneanu

                 BUG 6 - Corrected german translation (thanks to Mael Horz)

               And the following improvements:

                 IMPROVE 1 - Create ImageHandleValue properties as public in

                             TChunkIHDR to get access to this handle

                 IMPROVE 2 - Using SetStretchBltMode to improve stretch quality

                 IMPROVE 3 - Scale is now working for alpha transparent images

                 IMPROVE 4 - GammaTable propery is now public to support an

                             article in the help file



  Version 1.4361

  2003-03-04 - Fixed important bug for simple transparency when using

               RGB, Grayscale color modes



  Version 1.436

  2003-03-04 - * NEW * Property Pixels for direct access to pixels

               * IMPROVED * Palette property (TPngObject) (read only)

               Slovenian traslation for the component (Miha Petelin)

               Help file update (scanline article/png->jpg example)



  Version 1.435

  2003-11-03 - * NEW * New chunk implementation zTXt (method AddzTXt)

               * NEW * New compiler flags to store the extra 8 bits

               from 16 bits samples (when saving it is ignored), the

               extra data may be acessed using ExtraScanline property

               * Fixed * a bug on tIMe chunk

               French translation included (Thanks to IBE Software)

               Bugs fixed



  Version 1.432

  2002-08-24 - * NEW *  A new method, CreateAlpha will transform the

               current image into partial transparency.

               Help file updated with a new article on how to handle

               partial transparency.



  Version 1.431

  2002-08-14 - Fixed and tested to work on:

               C++ Builder 3

               C++ Builder 5

               Delphi 3

               There was an error when setting TransparentColor, fixed

               New method, RemoveTransparency to remove image

               BIT TRANSPARENCY



  Version 1.43

  2002-08-01 - * NEW * Support for Delphi 3 and C++ Builder 3

               Implements mostly some things that were missing,

               a few tweaks and fixes.



  Version 1.428

  2002-07-24 - More minor fixes (thanks to Ian Boyd)

               Bit transparency fixes

               * NEW * Finally support to bit transparency

               (palette / rgb / grayscale -> all)



  Version 1.427

  2002-07-19 - Lots of bugs and leaks fixed

               * NEW * method to easy adding text comments, AddtEXt

               * NEW * property for setting bit transparency,

                       TransparentColor



  Version 1.426

  2002-07-18 - Clipboard finally fixed and working

               Changed UseDelphi trigger to UseDelphi

               * NEW * Support for bit transparency bitmaps

                       when assigning from/to TBitmap objects

               Altough it does not support drawing transparent

               parts of bit transparency pngs (only partial)

               it is closer than ever



  Version 1.425

  2002-07-01 - Clipboard methods implemented

               Lots of bugs fixed



  Version 1.424

  2002-05-16 - Scanline and AlphaScanline are now working correctly.

               New methods for handling the clipboard



  Version 1.423

  2002-05-16 - * NEW * Partial transparency for 1, 2, 4 and 8 bits is

               also supported using the tRNS chunk (for palette and

               grayscaling).

               New bug fixes (Peter Haas).



  Version 1.422

  2002-05-14 - Fixed some critical leaks, thanks to Peter Haas tips.

               New translation for German (Peter Haas).



  Version 1.421

  2002-05-06 - Now uses new ZLIB version, 1.1.4 with some security

               fixes.

               LoadFromResourceID and LoadFromResourceName added and

               help file updated for that.

               The resources strings are now located in pnglang.pas.

               New translation for Brazilian Portuguese.

               Bugs fixed.



 IMPORTANT: As always I´m looking for bugs on the library. If

            anyone has found one, please send me an email and

            I will fix asap. Thanks for all the help and ideas

            I'm receiving so far.}



{My email is    : gustavo.daud@terra.com.br}

{Website link   : http://pngdelphi.sourceforge.net}

{Gustavo Huffenbacher Daud}



unit pngimage;



interface



{Triggers avaliable (edit the fields bellow)}

{$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+}







uses

 Windows {$IFDEF UseDelphi}, Classes, Graphics, SysUtils{$ENDIF},

 zlibpas, pnglang;



const

  LibraryVersion = '1.564';



{$IFNDEF UseDelphi}

  const

    soFromBeginning = 0;

    soFromCurrent = 1;

    soFromEnd = 2;

{$ENDIF}



const

  {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)');

  Z_NO_FLUSH      = 0;

  Z_FINISH        = 4;

  Z_STREAM_END    = 1;



  {Avaliable PNG filters for mode 0}

  FILTER_NONE    = 0;

  FILTER_SUB     = 1;

  FILTER_UP      = 2;

  FILTER_AVERAGE = 3;

  FILTER_PAETH   = 4;



  {Avaliable color modes for PNG}

  COLOR_GRAYSCALE      = 0;

  COLOR_RGB            = 2;

  COLOR_PALETTE        = 3;

  COLOR_GRAYSCALEALPHA = 4;

  COLOR_RGBALPHA       = 6;





type

  {$IFNDEF UseDelphi}

    {Custom exception handler}

    Exception = class(TObject)

      constructor Create(Msg: String);

    end;

    ExceptClass = class of Exception;

    TColor = ColorRef;

  {$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

  {Direct access to pixels using R,G,B}

  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;



  {Transparency mode for pngs}

  TPNGTransparencyMode = (ptmNone, ptmBit, ptmPartial);

  {Pointer to a cardinal type}

  pCardinal = ^Cardinal;

  {Access to a rgb pixel}

  pRGBPixel = ^TRGBPixel;

  TRGBPixel = packed record

    B, G, R: Byte;

  end;



  {Pointer to an array of bytes type}

  TByteArray = Array[Word] of Byte;

  pByteArray = ^TByteArray;



  {Forward}

  TPNGObject = class;

  pPointerArray = ^TPointerArray;

  TPointerArray = Array[Word] of Pointer;



  {Contains a list of objects}

  TPNGPointerList = class

  private

    fOwner: TPNGObject;

    fCount : Cardinal;

    fMemory: pPointerArray;

    function GetItem(Index: Cardinal): Pointer;

    procedure SetItem(Index: Cardinal; const Value: Pointer);

  protected

    {Removes an item}

    function Remove(Value: Pointer): Pointer; virtual;

    {Inserts an item}

    procedure Insert(Value: Pointer; Position: Cardinal);

    {Add a new item}

    procedure Add(Value: Pointer);

    {Returns an item}

    property Item[Index: Cardinal]: Pointer read GetItem write SetItem;

    {Set the size of the list}

    procedure SetSize(const Size: Cardinal);

    {Returns owner}

    property Owner: TPNGObject read fOwner;

  public

    {Returns number of items}

    property Count: Cardinal read fCount write SetSize;

    {Object being either created or destroyed}

    constructor Create(AOwner: TPNGObject);

    destructor Destroy; override;

  end;



  {Forward declaration}

  TChunk = class;

  TChunkClass = class of TChunk;



  {Same as TPNGPointerList but providing typecasted values}

  TPNGList = class(TPNGPointerList)

  private

    {Used with property Item}

    function GetItem(Index: Cardinal): TChunk;

  public

    {Finds the first item with this class}

    function FindChunk(ChunkClass: TChunkClass): TChunk;

    {Removes an item}

    procedure RemoveChunk(Chunk: TChunk); overload;

    {Add a new chunk using the class from the parameter}

    function Add(ChunkClass: TChunkClass): TChunk;

    {Returns pointer to the first chunk of class}

    function ItemFromClass(ChunkClass: TChunkClass): TChunk;

    {Returns a chunk item from the list}

    property Item[Index: Cardinal]: TChunk read GetItem;

  end;



  {$IFNDEF UseDelphi}

    {The STREAMs bellow are only needed in case delphi provided ones is not}

    {avaliable (UseDelphi trigger not set)}

    {Object becomes handles}

    TCanvas = THandle;

    TBitmap = HBitmap;

    {Trick to work}

    TPersistent = TObject;



    {Base class for all streams}

    TStream = class

    protected

      {Returning/setting size}

      function GetSize: Longint; virtual;

      procedure SetSize(const Value: Longint); virtual; abstract;

      {Returns/set position}

      function GetPosition: Longint; virtual;

      procedure SetPosition(const Value: Longint); virtual;

    public

      {Returns/sets current position}

      property Position: Longint read GetPosition write SetPosition;

      {Property returns/sets size}

      property Size: Longint read GetSize write SetSize;

      {Allows reading/writing data}

      function Read(var Buffer; Count: Longint): Cardinal; virtual; abstract;

      function Write(const Buffer; Count: Longint): Cardinal; virtual; abstract;

      {Copies from another Stream}

      function CopyFrom(Source: TStream;

        Count: Cardinal): Cardinal; virtual;

      {Seeks a stream position}

      function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;

    end;



    {File stream modes}

    TFileStreamMode = (fsmRead, fsmWrite, fsmCreate);

    TFileStreamModeSet = set of TFileStreamMode;



    {File stream for reading from files}

    TFileStream = class(TStream)

    private

      {Opened mode}

      Filemode: TFileStreamModeSet;

      {Handle}

      fHandle: THandle;

    protected

      {Set the size of the file}

      procedure SetSize(const Value: Longint); override;

    public

      {Seeks a file position}

      function Seek(Offset: Longint; Origin: Word): Longint; override;

      {Reads/writes data from/to the file}

      function Read(var Buffer; Count: Longint): Cardinal; override;

      function Write(const Buffer; Count: Longint): Cardinal; override;

      {Stream being created and destroy}

      constructor Create(Filename: String; Mode: TFileStreamModeSet);

      destructor Destroy; override;

    end;



    {Stream for reading from resources}

    TResourceStream = class(TStream)

      constructor Create(Instance: HInst; const ResName: String; ResType:PChar);

    private

      {Variables for reading}

      Size: Integer;

      Memory: Pointer;

      Position: Integer;

    protected

      {Set the size of the file}

      procedure SetSize(const Value: Longint); override;

    public

      {Stream processing}

      function Read(var Buffer; Count: Integer): Cardinal; override;

      function Seek(Offset: Integer; Origin: Word): Longint; override;

      function Write(const Buffer; Count: Longint): Cardinal; override;

    end;

  {$ENDIF}



  {Forward}

  TChunkIHDR = class;

  TChunkpHYs = class;

  {Interlace method}

  TInterlaceMethod = (imNone, imAdam7);

  {Compression level type}

  TCompressionLevel = 0..9;

  {Filters type}

  TFilter = (pfNone, pfSub, pfUp, pfAverage, pfPaeth);

  TFilters = set of TFilter;



  {Png implementation object}

  TPngObject = class{$IFDEF UseDelphi}(TGraphic){$ENDIF}

  protected

    {Inverse gamma table values}

    InverseGamma: Array[Byte] of Byte;

    procedure InitializeGamma;

  private

    {Canvas}

    {$IFDEF UseDelphi}fCanvas: TCanvas;{$ENDIF}

    {Filters to test to encode}

    fFilters: TFilters;

    {Compression level for ZLIB}

    fCompressionLevel: TCompressionLevel;

    {Maximum size for IDAT chunks}

    fMaxIdatSize: Integer;

    {Returns if image is interlaced}

    fInterlaceMethod: TInterlaceMethod;

    {Chunks object}

    fChunkList: TPngList;

    {Clear all chunks in the list}

    procedure ClearChunks;

    {Returns if header is present}

    function HeaderPresent: Boolean;

    procedure GetPixelInfo(var LineSize, Offset: Cardinal);

    {Returns linesize and byte offset for pixels}

    procedure SetMaxIdatSize(const Value: Integer);

    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);

    {Returns the version}

    function GetLibraryVersion: String;

  protected

    {Being created}

    BeingCreated: Boolean;

    {Returns / set the image palette}

    function GetPalette: HPALETTE; {$IFDEF UseDelphi}override;{$ENDIF}

    procedure SetPalette(Value: HPALETTE); {$IFDEF UseDelphi}override;{$ENDIF}

    procedure DoSetPalette(Value: HPALETTE; const UpdateColors: Boolean);

    {Returns/sets image width and height}

    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}

    {Assigns from another TPNGObject}

    procedure AssignPNG(Source: TPNGObject);

    {Returns if the image is empty}

    function GetEmpty: Boolean; {$IFDEF UseDelphi}override; {$ENDIF}

    {Used with property Header}

    function GetHeader: TChunkIHDR;

    {Draws using partial transparency}

    procedure DrawPartialTrans(DC: HDC; Rect: TRect);

    {$IFDEF UseDelphi}

    {Returns if the image is transparent}

    function GetTransparent: Boolean; override;

    {$ENDIF}

    {Returns a pixel}

    function GetPixels(const X, Y: Integer): TColor; virtual;

    procedure SetPixels(const X, Y: Integer; const Value: TColor); virtual;

  public

    {Gamma table array}

    GammaTable: Array[Byte] of Byte;

    {Resizes the PNG image}

    procedure Resize(const CX, CY: Integer);

    {Generates alpha information}

    procedure CreateAlpha;

    {Removes the image transparency}

    procedure RemoveTransparency;

    {Transparent color}

    property TransparentColor: TColor read GetTransparentColor write

      SetTransparentColor;

    {Add text chunk, TChunkTEXT, TChunkzTXT}

    procedure AddtEXt(const Keyword, Text: String);

    procedure AddzTXt(const Keyword, Text: String);

    {$IFDEF UseDelphi}

    {Saves to clipboard format (thanks to Antoine Pottern)}

    procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;

      var APalette: HPalette); override;

    procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;

      APalette: HPalette); override;

    {$ENDIF}

    {Calling errors}

    procedure RaiseError(ExceptionClass: ExceptClass; Text: String);

    {Returns a scanline from png}

    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);



    {Canvas}

    {$IFDEF UseDelphi}property Canvas: TCanvas read fCanvas;{$ENDIF}

    {Returns pointer to the header}

    property Header: TChunkIHDR read GetHeader;

    {Returns the transparency mode used by this png}

    property TransparencyMode: TPNGTransparencyMode read GetTransparencyMode;

    {Assigns from another object}

    procedure Assign(Source: TPersistent);{$IFDEF UseDelphi}override;{$ENDIF}

    {Assigns to another object}

    procedure AssignTo(Dest: TPersistent);{$IFDEF UseDelphi}override;{$ENDIF}

    {Assigns from a windows bitmap handle}

    procedure AssignHandle(Handle: HBitmap; Transparent: Boolean;

      TransparentColor: ColorRef);

    {Draws the image into a canvas}

    procedure Draw(ACanvas: TCanvas; const Rect: TRect);

      {$IFDEF UseDelphi}override;{$ENDIF}

    {Width and height properties}

    property Width: Integer read GetWidth;

    property Height: Integer read GetHeight;

    {Returns if the image is interlaced}

    property InterlaceMethod: TInterlaceMethod read fInterlaceMethod

      write fInterlaceMethod;

    {Filters to test to encode}

    property Filters: TFilters read fFilters write fFilters;

    {Maximum size for IDAT chunks, default and minimum is 65536}

    property MaxIdatSize: Integer read fMaxIdatSize write SetMaxIdatSize;

    {Property to return if the image is empty or not}

    property Empty: Boolean read GetEmpty;

    {Compression level}

    property CompressionLevel: TCompressionLevel read fCompressionLevel

      write fCompressionLevel;

    {Access to the chunk list}

    property Chunks: TPngList read fChunkList;

    {Object being created and destroyed}

    constructor Create; {$IFDEF UseDelphi}override;{$ENDIF}

    constructor CreateBlank(ColorType, Bitdepth: Cardinal; cx, cy: Integer);

    destructor Destroy; override;

    {$IFNDEF UseDelphi}procedure LoadFromFile(const Filename: String);{$ENDIF}

    {$IFNDEF UseDelphi}procedure SaveToFile(const Filename: String);{$ENDIF}

    procedure LoadFromStream(Stream: TStream);

      {$IFDEF UseDelphi}override;{$ENDIF}

    procedure SaveToStream(Stream: TStream); {$IFDEF UseDelphi}override;{$ENDIF}

    {Loading the image from resources}

    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;

    {Palette property}

    {$IFNDEF UseDelphi}property Palette: HPalette read GetPalette write

      SetPalette;{$ENDIF}

    {Returns the version}

    property Version: String read GetLibraryVersion;

  end;



  {Chunk name object}

  TChunkName = Array[0..3] of Char;



  {Global chunk object}

  TChunk = class

  private

    {Contains data}

    fData: Pointer;

    fDataSize: Cardinal;

    {Stores owner}

    fOwner: TPngObject;

    {Stores the chunk name}

    fName: TChunkName;

    {Returns pointer to the TChunkIHDR}

    function GetHeader: TChunkIHDR;

    {Used with property index}

    function GetIndex: Integer;

    {Should return chunk class/name}

    class function GetName: String; virtual;

    {Returns the chunk name}

    function GetChunkName: String;

  public

    {Returns index from list}

    property Index: Integer read GetIndex;

    {Returns pointer to the TChunkIHDR}

    property Header: TChunkIHDR read GetHeader;

    {Resize the data}

    procedure ResizeData(const NewSize: Cardinal);

    {Returns data and size}

    property Data: Pointer read fData;

    property DataSize: Cardinal read fDataSize;

    {Assigns from another TChunk}

    procedure Assign(Source: TChunk); virtual;

    {Returns owner}

    property Owner: TPngObject read fOwner;

    {Being destroyed/created}

    constructor Create(Owner: TPngObject); virtual;

    destructor Destroy; override;

    {Returns chunk class/name}

    property Name: String read GetChunkName;

    {Loads the chunk from a stream}

    function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;

      Size: Integer): Boolean; virtual;

    {Saves the chunk to a stream}

    function SaveData(Stream: TStream): Boolean;

    function SaveToStream(Stream: TStream): Boolean; virtual;

  end;



  {Chunk classes}

  TChunkIEND = class(TChunk);     {End chunk}



  {IHDR data}

  pIHDRData = ^TIHDRData;

  TIHDRData = packed record

    Width, Height: Cardinal;

    BitDepth,

    ColorType,

    CompressionMethod,

    FilterMethod,

    InterlaceMethod: Byte;

  end;



  {Information header chunk}

  TChunkIHDR = class(TChunk)

  private

    {Current image}

    ImageHandle: HBitmap;

    ImageDC: HDC;

    ImagePalette: HPalette;

    {Output windows bitmap}

    HasPalette: Boolean;

    BitmapInfo: TMaxBitmapInfo;

    {Stores the image bytes}

    {$IFDEF Store16bits}ExtraImageData: Pointer;{$ENDIF}

    ImageData: pointer;

    ImageAlpha: Pointer;



    {Contains all the ihdr data}

    IHDRData: TIHDRData;

  protected

    BytesPerRow: Integer;

    {Creates a grayscale palette}

    function CreateGrayscalePalette(Bitdepth: Integer): HPalette;

    {Copies the palette to the Device Independent bitmap header}

    procedure PaletteToDIB(Palette: HPalette);

    {Resizes the image data to fill the color type, bit depth, }

    {width and height parameters}

    procedure PrepareImageData;

    {Release allocated ImageData memory}

    procedure FreeImageData;

  public

    {Access to ImageHandle}

    property ImageHandleValue: HBitmap read ImageHandle;

    {Properties}

    property Width: Cardinal read IHDRData.Width write IHDRData.Width;

    property Height: Cardinal read IHDRData.Height write IHDRData.Height;

    property BitDepth: Byte read IHDRData.BitDepth write IHDRData.BitDepth;

    property ColorType: Byte read IHDRData.ColorType write IHDRData.ColorType;

    property CompressionMethod: Byte read IHDRData.CompressionMethod

      write IHDRData.CompressionMethod;

    property FilterMethod: Byte read IHDRData.FilterMethod

      write IHDRData.FilterMethod;

    property InterlaceMethod: Byte read IHDRData.InterlaceMethod

      write IHDRData.InterlaceMethod;

    {Loads the chunk from a stream}

    function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;

      Size: Integer): Boolean; override;

    {Saves the chunk to a stream}

    function SaveToStream(Stream: TStream): Boolean; override;

    {Destructor/constructor}

    constructor Create(Owner: TPngObject); override;

    destructor Destroy; override;

    {Assigns from another TChunk}

    procedure Assign(Source: TChunk); override;

  end;



  {pHYs chunk}

  pUnitType = ^TUnitType;

  TUnitType = (utUnknown, utMeter);

  TChunkpHYs = class(TChunk)

  private

    fPPUnitX, fPPUnitY: Cardinal;

    fUnit: TUnitType;

  public

    {Returns the properties}

    property PPUnitX: Cardinal read fPPUnitX write fPPUnitX;

    property PPUnitY: Cardinal read fPPUnitY write fPPUnitY;

    property UnitType: TUnitType read fUnit write fUnit;

    {Loads the chunk from a stream}

    function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;

      Size: Integer): Boolean; override;

    {Saves the chunk to a stream}

    function SaveToStream(Stream: TStream): Boolean; override;

    {Assigns from another TChunk}

    procedure Assign(Source: TChunk); override;

  end;



  {Gamma chunk}

  TChunkgAMA = class(TChunk)

  private

    {Returns/sets the value for the gamma chunk}

    function GetValue: Cardinal;

    procedure SetValue(const Value: Cardinal);

  public

    {Returns/sets gamma value}

    property Gamma: Cardinal read GetValue write SetValue;

    {Loading the chunk from a stream}

    function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;

      Size: Integer): Boolean; override;

    {Being created}

    constructor Create(Owner: TPngObject); override;

    {Assigns from another TChunk}

    procedure Assign(Source: TChunk); override;

  end;



  {ZLIB Decompression extra information}

  TZStreamRec2 = packed record

    {From ZLIB}

    ZLIB: TZStreamRec;

    {Additional info}

    Data: Pointer;

    fStream   : TStream;

  end;



  {Palette chunk}

  TChunkPLTE = class(TChunk)

  protected

    {Number of items in the palette}

    fCount: Integer;

  private

    {Contains the palette handle}

    function GetPaletteItem(Index: Byte): TRGBQuad;

  public

    {Returns the color for each item in the palette}

    property Item[Index: Byte]: TRGBQuad read GetPaletteItem;

    {Returns the number of items in the palette}

    property Count: Integer read fCount;

    {Loads the chunk from a stream}

    function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;

      Size: Integer): Boolean; override;

    {Saves the chunk to a stream}

    function SaveToStream(Stream: TStream): Boolean; override;

    {Assigns from another TChunk}

    procedure Assign(Source: TChunk); override;

  end;



  {Transparency information}

  TChunktRNS = class(TChunk)

  private

    fBitTransparency: Boolean;

    function GetTransparentColor: ColorRef;

    {Returns the transparent color}

    procedure SetTransparentColor(const Value: ColorRef);

  public

    {Palette values for transparency}

    PaletteValues: Array[Byte] of Byte;

    {Returns if it uses bit transparency}

    property BitTransparency: Boolean read fBitTransparency;

    {Returns the transparent color}

    property TransparentColor: ColorRef read GetTransparentColor write

      SetTransparentColor;

    {Loads/saves the chunk from/to a stream}

    function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;

      Size: Integer): Boolean; override;

    function SaveToStream(Stream: TStream): Boolean; override;

    {Assigns from another TChunk}

    procedure Assign(Source: TChunk); override;

  end;



  {Actual image information}

  TChunkIDAT = class(TChunk)

  private

    {Holds another pointer to the TChunkIHDR}

    Header: TChunkIHDR;

    {Stores temporary image width and height}

    ImageWidth, ImageHeight: Integer;

    {Size in bytes of each line and offset}

    Row_Bytes, Offset : Cardinal;

    {Contains data for the lines}

    Encode_Buffer: Array[0..5] of pByteArray;

    Row_Buffer: Array[Boolean] of pByteArray;

    {Variable to invert the Row_Buffer used}

    RowUsed: Boolean;

    {Ending position for the current IDAT chunk}

    EndPos: Integer;

    {Filter the current line}

    procedure FilterRow;

    {Filter to encode and returns the best filter}

    function FilterToEncode: Byte;

    {Reads ZLIB compressed data}

    function IDATZlibRead(var ZLIBStream: TZStreamRec2; Buffer: Pointer;

      Count: Integer; var EndPos: Integer; var crcfile: Cardinal): Integer;

    {Compress and writes IDAT data}

    procedure IDATZlibWrite(var ZLIBStream: TZStreamRec2; Buffer: Pointer;

      const Length: Cardinal);

    procedure FinishIDATZlib(var ZLIBStream: TZStreamRec2);

    {Prepares the palette}

    procedure PreparePalette;

  protected

    {Decode interlaced image}

    procedure DecodeInterlacedAdam7(Stream: TStream;

      var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: Cardinal);

    {Decode non interlaced imaged}

    procedure DecodeNonInterlaced(Stream: TStream;

      var ZLIBStream: TZStreamRec2; const Size: Integer;

      var crcfile: Cardinal);

  protected

    {Encode non interlaced images}

    procedure EncodeNonInterlaced(Stream: TStream;

      var ZLIBStream: TZStreamRec2);

    {Encode interlaced images}

    procedure EncodeInterlacedAdam7(Stream: TStream;

      var ZLIBStream: TZStreamRec2);

  protected

    {Memory copy methods to decode}

    procedure CopyNonInterlacedRGB8(

      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);

    procedure CopyNonInterlacedRGB16(

      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);

    procedure CopyNonInterlacedPalette148(

      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);

    procedure CopyNonInterlacedPalette2(

      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);

    procedure CopyNonInterlacedGray2(

      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);

    procedure CopyNonInterlacedGrayscale16(

      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);

    procedure CopyNonInterlacedRGBAlpha8(

      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);

    procedure CopyNonInterlacedRGBAlpha16(

      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);

    procedure CopyNonInterlacedGrayscaleAlpha8(

      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);

    procedure CopyNonInterlacedGrayscaleAlpha16(

      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);

    procedure CopyInterlacedRGB8(const Pass: Byte;

      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);

    procedure CopyInterlacedRGB16(const Pass: Byte;

      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);

    procedure CopyInterlacedPalette148(const Pass: Byte;

      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);

    procedure CopyInterlacedPalette2(const Pass: Byte;

      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);

    procedure CopyInterlacedGray2(const Pass: Byte;

      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);

    procedure CopyInterlacedGrayscale16(const Pass: Byte;

      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);

    procedure CopyInterlacedRGBAlpha8(const Pass: Byte;

      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);

    procedure CopyInterlacedRGBAlpha16(const Pass: Byte;

      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);

    procedure CopyInterlacedGrayscaleAlpha8(const Pass: Byte;

      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);

    procedure CopyInterlacedGrayscaleAlpha16(const Pass: Byte;

      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);

  protected

    {Memory copy methods to encode}

    procedure EncodeNonInterlacedRGB8(Src, Dest, Trans: pChar);

    procedure EncodeNonInterlacedRGB16(Src, Dest, Trans: pChar);

    procedure EncodeNonInterlacedGrayscale16(Src, Dest, Trans: pChar);

    procedure EncodeNonInterlacedPalette148(Src, Dest, Trans: pChar);

    procedure EncodeNonInterlacedRGBAlpha8(Src, Dest, Trans: pChar);

    procedure EncodeNonInterlacedRGBAlpha16(Src, Dest, Trans: pChar);

    procedure EncodeNonInterlacedGrayscaleAlpha8(Src, Dest, Trans: pChar);

    procedure EncodeNonInterlacedGrayscaleAlpha16(Src, Dest, Trans: pChar);

    procedure EncodeInterlacedRGB8(const Pass: Byte; Src, Dest, Trans: pChar);

    procedure EncodeInterlacedRGB16(const Pass: Byte; Src, Dest, Trans: pChar);

    procedure EncodeInterlacedPalette148(const Pass: Byte;

      Src, Dest, Trans: pChar);

    procedure EncodeInterlacedGrayscale16(const Pass: Byte;

      Src, Dest, Trans: pChar);

    procedure EncodeInterlacedRGBAlpha8(const Pass: Byte;

      Src, Dest, Trans: pChar);

    procedure EncodeInterlacedRGBAlpha16(const Pass: Byte;

      Src, Dest, Trans: pChar);

    procedure EncodeInterlacedGrayscaleAlpha8(const Pass: Byte;

      Src, Dest, Trans: pChar);

    procedure EncodeInterlacedGrayscaleAlpha16(const Pass: Byte;

      Src, Dest, Trans: pChar);

  public

    {Loads the chunk from a stream}

    function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;

      Size: Integer): Boolean; override;

    {Saves the chunk to a stream}

    function SaveToStream(Stream: TStream): Boolean; override;

  end;



  {Image last modification chunk}

  TChunktIME = class(TChunk)

  private

    {Holds the variables}

    fYear: Word;

    fMonth, fDay, fHour, fMinute, fSecond: Byte;

  public

    {Returns/sets variables}

    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;

    {Loads the chunk from a stream}

    function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;

      Size: Integer): Boolean; override;

    {Saves the chunk to a stream}

    function SaveToStream(Stream: TStream): Boolean; override;

    {Assigns from another TChunk}

    procedure Assign(Source: TChunk); override;

  end;



  {Textual data}

  TChunktEXt = class(TChunk)

  private

    fKeyword, fText: String;

  public

    {Keyword and text}

    property Keyword: String read fKeyword write fKeyword;

    property Text: String read fText write fText;

    {Loads the chunk from a stream}

    function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;

      Size: Integer): Boolean; override;

    {Saves the chunk to a stream}

    function SaveToStream(Stream: TStream): Boolean; override;

    {Assigns from another TChunk}

    procedure Assign(Source: TChunk); override;

  end;



  {zTXT chunk}

  TChunkzTXt = class(TChunktEXt)

    {Loads the chunk from a stream}

    function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;

      Size: Integer): Boolean; override;

    {Saves the chunk to a stream}

    function SaveToStream(Stream: TStream): 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}





{Registers a new chunk class}

procedure RegisterChunk(ChunkClass: TChunkClass);

{Calculates crc}

function update_crc(crc: {$IFNDEF DelphiBuilder3Less}Cardinal{$ELSE}Integer

  {$ENDIF}; buf: pByteArray; len: Integer): Cardinal;

{Invert bytes using assembly}

function ByteSwap(const a: integer): integer;



implementation



var

  ChunkClasses: TPngPointerList;

  {Table of CRCs of all 8-bit messages}

  crc_table: Array[0..255] of Cardinal;

  {Flag: has the table been computed? Initially false}

  crc_table_computed: Boolean;



{Draw transparent image using transparent color}

procedure DrawTransparentBitmap(dc: HDC; srcBits: Pointer;

  var srcHeader: TBitmapInfoHeader;

  srcBitmapInfo: pBitmapInfo; Rect: TRect; cTransparentColor: COLORREF);

var

  cColor:   COLORREF;

  bmAndBack, bmAndObject, bmAndMem: HBITMAP;

  bmBackOld, bmObjectOld, bmMemOld: HBITMAP;

  hdcMem, hdcBack, hdcObject, hdcTemp: HDC;

  ptSize, orgSize: TPOINT;

  OldBitmap, DrawBitmap: HBITMAP;

begin

  hdcTemp := CreateCompatibleDC(dc);

  {Select the bitmap}

  DrawBitmap := CreateDIBitmap(dc, srcHeader, CBM_INIT, srcBits, srcBitmapInfo^,

    DIB_RGB_COLORS);

  OldBitmap := SelectObject(hdcTemp, DrawBitmap);



  {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}

  hdcBack  := CreateCompatibleDC(dc);

  hdcObject := CreateCompatibleDC(dc);

  hdcMem   := CreateCompatibleDC(dc);



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

  // GDI functions.



  // Monochrome DCs

  bmAndBack  := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil);

  bmAndObject := 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.

  bmBackOld  := SelectObject(hdcBack, bmAndBack);

  bmObjectOld := SelectObject(hdcObject, bmAndObject);

  bmMemOld   := 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(hdcTemp, cTransparentColor);



  // Create the object mask for the bitmap by performing a BitBlt

  // from the source bitmap to a monochrome bitmap.

  StretchBlt(hdcObject, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0,

    orgSize.x, orgSize.y, SRCCOPY);



  // Set the background color of the source DC back to the original

  // color.

  SetBkColor(hdcTemp, cColor);



  // Create the inverse of the object mask.

  BitBlt(hdcBack, 0, 0, ptSize.x, ptSize.y, hdcObject, 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, hdcObject, 0, 0, SRCAND);



  // Mask out the transparent colored pixels on the bitmap.

//  BitBlt(hdcTemp, 0, 0, ptSize.x, ptSize.y, hdcBack, 0, 0, SRCAND);

  StretchBlt(hdcTemp, 0, 0, OrgSize.x, OrgSize.y, hdcBack, 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, hdcTemp, 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(hdcBack, bmBackOld));

  DeleteObject(SelectObject(hdcObject, bmObjectOld));

  DeleteObject(SelectObject(hdcMem, bmMemOld));

  DeleteObject(SelectObject(hdcTemp, OldBitmap));



  // Delete the memory DCs.

  DeleteDC(hdcMem);

  DeleteDC(hdcBack);

  DeleteDC(hdcObject);

  DeleteDC(hdcTemp);

end;



{Make the table for a fast CRC.}

procedure make_crc_table;

var

  c: Cardinal;

  n, k: Integer;

begin



  {fill the crc table}

  for n := 0 to 255 do

  begin

    c := Cardinal(n);

    for k := 0 to 7 do

    begin

      if Boolean(c and 1) then

        c := $edb88320 xor (c shr 1)

      else

        c := c shr 1;

    end;

    crc_table[n] := c;

  end;



  {The table has already being computated}

  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;



  {Create the crc table in case it has not being computed yet}

  if not crc_table_computed then make_crc_table;



  {Update}

  for n := 0 to len - 1 do

    c := crc_table[(c XOR buf^[n]) and $FF] XOR (c shr 8);



  {Returns}

  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}



{$IFNDEF UseDelphi}

  {Exception implementation}

  constructor Exception.Create(Msg: String);

  begin

  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;



type

  pChunkClassInfo = ^TChunkClassInfo;

  TChunkClassInfo = record

    ClassName: TChunkClass;

  end;



{Register a chunk type}

procedure RegisterChunk(ChunkClass: TChunkClass);

var

  NewClass: pChunkClassInfo;

begin

  {In case the list object has not being created yet}

  if ChunkClasses = nil then ChunkClasses := TPngPointerList.Create(nil);



  {Add this new class}

  new(NewClass);

  NewClass^.ClassName := ChunkClass;

  ChunkClasses.Add(NewClass);

end;



{Free chunk class list}

procedure FreeChunkClassList;

var

  i: Integer;

begin

  if (ChunkClasses <> nil) then

  begin

    FOR i := 0 TO ChunkClasses.Count - 1 do

      Dispose(pChunkClassInfo(ChunkClasses.Item[i]));

    ChunkClasses.Free;

  end;

end;



{Registering of common chunk classes}

procedure RegisterCommonChunks;

begin

  {Important chunks}

  RegisterChunk(TChunkIEND);

  RegisterChunk(TChunkIHDR);

  RegisterChunk(TChunkIDAT);

  RegisterChunk(TChunkPLTE);

  RegisterChunk(TChunkgAMA);

  RegisterChunk(TChunktRNS);



  {Not so important chunks}

  RegisterChunk(TChunkpHYs);

  RegisterChunk(TChunktIME);

  RegisterChunk(TChunktEXt);

  RegisterChunk(TChunkzTXt);

end;



{Creates a new chunk of this class}

function CreateClassChunk(Owner: TPngObject; Name: TChunkName): TChunk;

var

  i       : Integer;

  NewChunk: TChunkClass;

begin

  {Looks for this chunk}

  NewChunk := TChunk;  {In case there is no registered class for this}



  {Looks for this class in all registered chunks}

  if Assigned(ChunkClasses) then

    FOR i := 0 TO ChunkClasses.Count - 1 DO

    begin

      if pChunkClassInfo(ChunkClasses.Item[i])^.ClassName.GetName = Name then

      begin

        NewChunk := pChunkClassInfo(ChunkClasses.Item[i])^.ClassName;

        break;

      end;

    end;



  {Returns chunk class}

  Result := NewChunk.Create(Owner);

  Result.fName := Name;

end;



{ZLIB support}



const

  ZLIBAllocate = High(Word);



{Initializes ZLIB for decompression}

function ZLIBInitInflate(Stream: TStream): TZStreamRec2;

begin

  {Fill record}

  Fillchar(Result, SIZEOF(TZStreamRec2), #0);



  {Set internal record information}

  with Result do

  begin

    GetMem(Data, ZLIBAllocate);

    fStream := Stream;

  end;



  {Init decompression}

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

end;



{Initializes ZLIB for compression}

function ZLIBInitDeflate(Stream: TStream;

  Level: TCompressionlevel; Size: Cardinal): TZStreamRec2;

begin

  {Fill record}

  Fillchar(Result, SIZEOF(TZStreamRec2), #0);



  {Set internal record information}

  with Result, ZLIB do

  begin

    GetMem(Data, Size);

    fStream := Stream;

    next_out := Data;

    avail_out := Size;

  end;



  {Inits compression}

  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:…