pngimage.pas

This PNG Delphi version 1.56 documentation (this version is a major rewrite intended to replace the

{Portable Network Graphics Delphi 1.56        (09 May 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 ([e-mail])        }


{$OPTIMIZATION OFF}
{
  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磛e
	       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 (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: As always I磎 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    : [e-mail]}
{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 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 Store16bits}           //Stores the extra 8 bits from 16bits/sample
{.$DEFINE Debug}                 //For programming purposes
{$RANGECHECKS OFF} {$J+}



uses
 Windows {$IFDEF UseDelphi}, Classes, Graphics, SysUtils{$ENDIF} {$IFDEF Debug},
 dialogs{$ENDIF}, pngzlib, pnglang;

const
  LibraryVersion = '1.56';

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