{Portable Network Graphics Delphi 1.432   (24 August 2002)    }

{This is the latest implementation for TPngImage component    }
{It's meant to be a full replacement for the previous one.    }
{There are lots of new improvements, including cleaner code,  }
{full partial transparency support, speed improvements,       }
{saving using ADAM 7 interlacing, better error handling, also }
{the best compression for the final image ever. And now it's  }
{truly able to read about any png image.                      }

{
  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 (hope)
               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: I'm currently looking for bugs on the library. If
            anyone has found one, please send me an email and
            I will fix right away. Thanks for all the help and
            ideias I'm receiving so far.}

{My new email is: gubadaud@terra.com.br}
{Website link   : pngdelphi.sourceforge.net}
{Gustavo Huffenbacher Daud}

unit pngimage;

interface

{Triggers avaliable}

{.$DEFINE UseDelphi}              //Disable fat vcl units (perfect to 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 Debug}                 //For programming purposes
{$RANGECHECKS OFF} {$J+}

uses
 Windows, pngzlib, pnglang;

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

type
  {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
    {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;
  {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
    {Gamma table values}
    GammaTable, InverseGamma: Array[Byte] of Byte;
    procedure InitializeGamma;
  private
    {Filters to test to encode}
    fFilters: TFilters;
    {Compression level for ZLIB}
    fCompressionLevel: TCompressionLevel;
    {Maximum size for IDAT chunks}
    fMaxIdatSize: Cardinal;
    {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;
    {Returns linesize and byte offset for pixels}
    procedure GetPixelInfo(var LineSize, Offset: Cardinal);
    procedure SetMaxIdatSize(const Value: Cardinal);
    function GetAlphaScanline(const LineIndex: Integer): pByteArray;
    function GetScanline(const LineIndex: Integer): Pointer;
    function GetTransparencyMode: TPNGTransparencyMode;
    function GetTransparentColor: TColor;
    procedure SetTransparentColor(const Value: TColor);
  protected
    {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}
  public
    {Generates alpha information}
    procedure CreateAlpha;
    {Removes the image transparency}
    procedure RemoveTransparency;
    {Transparent color}
    property TransparentColor: TColor read GetTransparentColor write
      SetTransparentColor;
    {Add text chunk, TChunkTEXT}
    procedure AddtEXt(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;
    property AlphaScanline[const Index: Integer]: pByteArray read GetAlphaScanline;
    {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}