开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 图形图像 > 2D图形编程 > 查看源码
pngimage.pas
资源名称：asphyre410.rar　[点击查看]
上传用户：ctlcnc
上传日期：2021-12-10
资源大小：4933k
文件大小：166k
源码类别：

2D图形编程

开发平台：

Delphi

pngimage.pas：源码内容
  1. {Portable Network Graphics Delphi 1.5       (29 June 2005)    }
  3. {This is the latest implementation for TPngImage component    }
  4. {It's meant to be a full replacement for the previous one.    }
  5. {There are lots of new improvements, including cleaner code,  }
  6. {full partial transparency support, speed improvements,       }
  7. {saving using ADAM 7 interlacing, better error handling, also }
  8. {the best compression for the final image ever. And now it's  }
  9. {truly able to read about any png image.                      }
  11. //---------------------------------------------------------------------------
  12. //   Notice from Lifepower (lifepower@mail333.com):
  13. //---------------------------------------------------------------------------
  14. // This file has modification - to use "asphyrezlib.pas" instead
  15. // of "pnglang.pas". This is used with the permission of the auhtor. 
  16. //---------------------------------------------------------------------------
  18. {
  19.   Version 1.5
  20.   2005-29-06 - Fixed a lot of bugs using tips from mails that I've
  21.        being receiving for some time
  22.                  BUG 1 - Loosing palette when assigning to TBitmap. fixed
  23.                  BUG 2 - SetPixels and GetPixels worked only with
  24.                          parameters in range 0..255. fixed
  25.                  BUG 3 - Force type address off using directive
  26.                  BUG 4 - TChunkzTXt contained an error
  27.                  BUG 5 - MaxIdatSize was not working correctly (fixed thanks
  28.                  to Gabriel Corneanu
  29.                  BUG 6 - Corrected german translation (thanks to Mael Horz)
  30.                And the following improvements:
  31.                  IMPROVE 1 - Create ImageHandleValue properties as public in
  32.                              TChunkIHDR to get access to this handle
  33.                  IMPROVE 2 - Using SetStretchBltMode to improve stretch quality
  34.                  IMPROVE 3 - Scale is now working for alpha transparent images
  35.                  IMPROVE 4 - GammaTable propery is now public to support an
  36.                              article in the help file
  38.   Version 1.4361
  39.   2003-03-04 - Fixed important bug for simple transparency when using
  40.                RGB, Grayscale color modes
  42.   Version 1.436
  43.   2003-03-04 - * NEW * Property Pixels for direct access to pixels
  44.                * IMPROVED * Palette property (TPngObject) (read only)
  45.                Slovenian traslation for the component (Miha Petelin)
  46.                Help file update (scanline article/png->jpg example)
  48.   Version 1.435
  49.   2003-11-03 - * NEW * New chunk implementation zTXt (method AddzTXt)
  50.                * NEW * New compiler flags to store the extra 8 bits
  51.                from 16 bits samples (when saving it is ignored), the
  52.                extra data may be acessed using ExtraScanline property
  53.                * Fixed * a bug on tIMe chunk
  54.                French translation included (Thanks to IBE Software)
  55.                Bugs fixed
  57.   Version 1.432
  58.   2002-08-24 - * NEW *  A new method, CreateAlpha will transform the
  59.                current image into partial transparency.
  60.                Help file updated with a new article on how to handle
  61.                partial transparency.
  63.   Version 1.431
  64.   2002-08-14 - Fixed and tested to work on:
  65.                C++ Builder 3
  66.                C++ Builder 5
  67.                Delphi 3
  68.                There was an error when setting TransparentColor, fixed
  69.                New method, RemoveTransparency to remove image
  70.                BIT TRANSPARENCY
  72.   Version 1.43
  73.   2002-08-01 - * NEW * Support for Delphi 3 and C++ Builder 3
  74.                Implements mostly some things that were missing,
  75.                a few tweaks and fixes.
  77.   Version 1.428
  78.   2002-07-24 - More minor fixes (thanks to Ian Boyd)
  79.                Bit transparency fixes
  80.                * NEW * Finally support to bit transparency
  81.                (palette / rgb / grayscale -> all)
  83.   Version 1.427
  84.   2002-07-19 - Lots of bugs and leaks fixed
  85.                * NEW * method to easy adding text comments, AddtEXt
  86.                * NEW * property for setting bit transparency,
  87.                        TransparentColor
  89.   Version 1.426
  90.   2002-07-18 - Clipboard finally fixed (hope)
  91.                Changed UseDelphi trigger to UseDelphi
  92.                * NEW * Support for bit transparency bitmaps
  93.                        when assigning from/to TBitmap objects
  94.                Altough it does not support drawing transparent
  95.                parts of bit transparency pngs (only partial)
  96.                it is closer than ever
  98.   Version 1.425
  99.   2002-07-01 - Clipboard methods implemented
  100.                Lots of bugs fixed
  102.   Version 1.424
  103.   2002-05-16 - Scanline and AlphaScanline are now working correctly.
  104.                New methods for handling the clipboard
  106.   Version 1.423
  107.   2002-05-16 - * NEW * Partial transparency for 1, 2, 4 and 8 bits is
  108.                also supported using the tRNS chunk (for palette and
  109.                grayscaling).
  110.                New bug fixes (Peter Haas).
  112.   Version 1.422
  113.   2002-05-14 - Fixed some critical leaks, thanks to Peter Haas tips.
  114.                New translation for German (Peter Haas).
  116.   Version 1.421
  117.   2002-05-06 - Now uses new ZLIB version, 1.1.4 with some security
  118.                fixes.
  119.                LoadFromResourceID and LoadFromResourceName added and
  120.                help file updated for that.
  121.                The resources strings are now located in pnglang.pas.
  122.                New translation for Brazilian Portuguese.
  123.                Bugs fixed.
  125.  IMPORTANT: I'm currently looking for bugs on the library. If
  126.             anyone has found one, please send me an email and
  127.             I will fix right away. Thanks for all the help and
  128.             ideias I'm receiving so far.}
  130. {My new email is: gubadaud@terra.com.br}
  131. {Website link   : pngdelphi.sourceforge.net}
  132. {Gustavo Huffenbacher Daud}
  134. unit pngimage;
  136. interface
  138. {Triggers avaliable (edit the fields bellow)}
  139. {$TYPEDADDRESS OFF}
  140. {$DEFINE UseDelphi}              //Disable fat vcl units (perfect to small apps)
  141. {$DEFINE ErrorOnUnknownCritical} //Error when finds an unknown critical chunk
  142. {$DEFINE CheckCRC}               //Enables CRC checking
  143. {.$DEFINE RegisterGraphic}        //Registers TPNGObject to use with TPicture
  144. {.$DEFINE PartialTransparentDraw} //Draws partial transparent images
  145. {.$DEFINE Store16bits}           //Stores the extra 8 bits from 16bits/sample
  146. {.$DEFINE Debug}                 //For programming purposes
  147. {$RANGECHECKS OFF} {$J+}
  151. uses
  152.  Windows {$IFDEF UseDelphi}, Classes, Graphics, SysUtils{$ENDIF} {$IFDEF Debug},
  153.  dialogs{$ENDIF}, asphyrezlib, pnglang;
  155. {$IFNDEF UseDelphi}
  156.   const
  157.     soFromBeginning = 0;
  158.     soFromCurrent = 1;
  159.     soFromEnd = 2;
  160. {$ENDIF}
  162. const
  163.   {ZLIB constants}
  164.   ZLIBErrors: Array[-6..2] of string = ('incompatible version (-6)',
  165.     'buffer error (-5)', 'insufficient memory (-4)', 'data error (-3)',
  166.     'stream error (-2)', 'file error (-1)', '(0)', 'stream end (1)',
  167.     'need dictionary (2)');
  168.   Z_NO_FLUSH      = 0;
  169.   Z_FINISH        = 4;
  170.   Z_STREAM_END    = 1;
  172.   {Avaliable PNG filters for mode 0}
  173.   FILTER_NONE    = 0;
  174.   FILTER_SUB     = 1;
  175.   FILTER_UP      = 2;
  176.   FILTER_AVERAGE = 3;
  177.   FILTER_PAETH   = 4;
  179.   {Avaliable color modes for PNG}
  180.   COLOR_GRAYSCALE      = 0;
  181.   COLOR_RGB            = 2;
  182.   COLOR_PALETTE        = 3;
  183.   COLOR_GRAYSCALEALPHA = 4;
  184.   COLOR_RGBALPHA       = 6;
  187. type
  188.   {$IFNDEF UseDelphi}
  189.     {Custom exception handler}
  190.     Exception = class(TObject)
  191.       constructor Create(Msg: String);
  192.     end;
  193.     ExceptClass = class of Exception;
  194.     TColor = ColorRef;
  195.   {$ENDIF}
  197.   {Error types}
  198.   EPNGOutMemory = class(Exception);
  199.   EPngError = class(Exception);
  200.   EPngUnexpectedEnd = class(Exception);
  201.   EPngInvalidCRC = class(Exception);
  202.   EPngInvalidIHDR = class(Exception);
  203.   EPNGMissingMultipleIDAT = class(Exception);
  204.   EPNGZLIBError = class(Exception);
  205.   EPNGInvalidPalette = class(Exception);
  206.   EPNGInvalidFileHeader = class(Exception);
  207.   EPNGIHDRNotFirst = class(Exception);
  208.   EPNGNotExists = class(Exception);
  209.   EPNGSizeExceeds = class(Exception);
  210.   EPNGMissingPalette = class(Exception);
  211.   EPNGUnknownCriticalChunk = class(Exception);
  212.   EPNGUnknownCompression = class(Exception);
  213.   EPNGUnknownInterlace = class(Exception);
  214.   EPNGNoImageData = class(Exception);
  215.   EPNGCouldNotLoadResource = class(Exception);
  216.   EPNGCannotChangeTransparent = class(Exception);
  217.   EPNGHeaderNotPresent = class(Exception);
  219. type
  220.   {Direct access to pixels using R,G,B}
  221.   TRGBLine = array[word] of TRGBTriple;
  222.   pRGBLine = ^TRGBLine;
  224.   {Same as TBitmapInfo but with allocated space for}
  225.   {palette entries}
  226.   TMAXBITMAPINFO = packed record
  227.     bmiHeader: TBitmapInfoHeader;
  228.     bmiColors: packed array[0..255] of TRGBQuad;
  229.   end;
  231.   {Transparency mode for pngs}
  232.   TPNGTransparencyMode = (ptmNone, ptmBit, ptmPartial);
  233.   {Pointer to a cardinal type}
  234.   pCardinal = ^Cardinal;
  235.   {Access to a rgb pixel}
  236.   pRGBPixel = ^TRGBPixel;
  237.   TRGBPixel = packed record
  238.     B, G, R: Byte;
  239.   end;
  241.   {Pointer to an array of bytes type}
  242.   TByteArray = Array[Word] of Byte;
  243.   pByteArray = ^TByteArray;
  245.   {Forward}
  246.   TPNGObject = class;
  247.   pPointerArray = ^TPointerArray;
  248.   TPointerArray = Array[Word] of Pointer;
  250.   {Contains a list of objects}
  251.   TPNGPointerList = class
  252.   private
  253.     fOwner: TPNGObject;
  254.     fCount : Cardinal;
  255.     fMemory: pPointerArray;
  256.     function GetItem(Index: Cardinal): Pointer;
  257.     procedure SetItem(Index: Cardinal; const Value: Pointer);
  258.   protected
  259.     {Removes an item}
  260.     function Remove(Value: Pointer): Pointer; virtual;
  261.     {Inserts an item}
  262.     procedure Insert(Value: Pointer; Position: Cardinal);
  263.     {Add a new item}
  264.     procedure Add(Value: Pointer);
  265.     {Returns an item}
  266.     property Item[Index: Cardinal]: Pointer read GetItem write SetItem;
  267.     {Set the size of the list}
  268.     procedure SetSize(const Size: Cardinal);
  269.     {Returns owner}
  270.     property Owner: TPNGObject read fOwner;
  271.   public
  272.     {Returns number of items}
  273.     property Count: Cardinal read fCount write SetSize;
  274.     {Object being either created or destroyed}
  275.     constructor Create(AOwner: TPNGObject);
  276.     destructor Destroy; override;
  277.   end;
  279.   {Forward declaration}
  280.   TChunk = class;
  281.   TChunkClass = class of TChunk;
  283.   {Same as TPNGPointerList but providing typecasted values}
  284.   TPNGList = class(TPNGPointerList)
  285.   private
  286.     {Used with property Item}
  287.     function GetItem(Index: Cardinal): TChunk;
  288.   public
  289.     {Removes an item}
  290.     procedure RemoveChunk(Chunk: TChunk); overload;
  291.     {Add a new chunk using the class from the parameter}
  292.     function Add(ChunkClass: TChunkClass): TChunk;
  293.     {Returns pointer to the first chunk of class}
  294.     function ItemFromClass(ChunkClass: TChunkClass): TChunk;
  295.     {Returns a chunk item from the list}
  296.     property Item[Index: Cardinal]: TChunk read GetItem;
  297.   end;
  299.   {$IFNDEF UseDelphi}
  300.     {The STREAMs bellow are only needed in case delphi provided ones is not}
  301.     {avaliable (UseDelphi trigger not set)}
  302.     {Object becomes handles}
  303.     TCanvas = THandle;
  304.     TBitmap = HBitmap;
  305.     {Trick to work}
  306.     TPersistent = TObject;
  308.     {Base class for all streams}
  309.     TStream = class
  310.     protected
  311.       {Returning/setting size}
  312.       function GetSize: Longint; virtual;
  313.       procedure SetSize(const Value: Longint); virtual; abstract;
  314.       {Returns/set position}
  315.       function GetPosition: Longint; virtual;
  316.       procedure SetPosition(const Value: Longint); virtual;
  317.     public
  318.       {Returns/sets current position}
  319.       property Position: Longint read GetPosition write SetPosition;
  320.       {Property returns/sets size}
  321.       property Size: Longint read GetSize write SetSize;
  322.       {Allows reading/writing data}
  323.       function Read(var Buffer; Count: Longint): Cardinal; virtual; abstract;
  324.       function Write(const Buffer; Count: Longint): Cardinal; virtual; abstract;
  325.       {Copies from another Stream}
  326.       function CopyFrom(Source: TStream;
  327.         Count: Cardinal): Cardinal; virtual;
  328.       {Seeks a stream position}
  329.       function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;
  330.     end;
  332.     {File stream modes}
  333.     TFileStreamMode = (fsmRead, fsmWrite, fsmCreate);
  334.     TFileStreamModeSet = set of TFileStreamMode;
  336.     {File stream for reading from files}
  337.     TFileStream = class(TStream)
  338.     private
  339.       {Opened mode}
  340.       Filemode: TFileStreamModeSet;
  341.       {Handle}
  342.       fHandle: THandle;
  343.     protected
  344.       {Set the size of the file}
  345.       procedure SetSize(const Value: Longint); override;
  346.     public
  347.       {Seeks a file position}
  348.       function Seek(Offset: Longint; Origin: Word): Longint; override;
  349.       {Reads/writes data from/to the file}
  350.       function Read(var Buffer; Count: Longint): Cardinal; override;
  351.       function Write(const Buffer; Count: Longint): Cardinal; override;
  352.       {Stream being created and destroy}
  353.       constructor Create(Filename: String; Mode: TFileStreamModeSet);
  354.       destructor Destroy; override;
  355.     end;
  357.     {Stream for reading from resources}
  358.     TResourceStream = class(TStream)
  359.       constructor Create(Instance: HInst; const ResName: String; ResType:PChar);
  360.     private
  361.       {Variables for reading}
  362.       Size: Integer;
  363.       Memory: Pointer;
  364.       Position: Integer;
  365.     protected
  366.       {Set the size of the file}
  367.       procedure SetSize(const Value: Longint); override;
  368.     public
  369.       {Stream processing}
  370.       function Read(var Buffer; Count: Integer): Cardinal; override;
  371.       function Seek(Offset: Integer; Origin: Word): Longint; override;
  372.       function Write(const Buffer; Count: Longint): Cardinal; override;
  373.     end;
  374.   {$ENDIF}
  376.   {Forward}
  377.   TChunkIHDR = class;
  378.   {Interlace method}
  379.   TInterlaceMethod = (imNone, imAdam7);
  380.   {Compression level type}
  381.   TCompressionLevel = 0..9;
  382.   {Filters type}
  383.   TFilter = (pfNone, pfSub, pfUp, pfAverage, pfPaeth);
  384.   TFilters = set of TFilter;
  386.   {Png implementation object}
  387.   TPngObject = class{$IFDEF UseDelphi}(TGraphic){$ENDIF}
  388.   protected
  389.     {Inverse gamma table values}
  390.     InverseGamma: Array[Byte] of Byte;
  391.     procedure InitializeGamma;
  392.   private
  393.     {Temporary palette}
  394.     TempPalette: HPalette;
  395.     {Filters to test to encode}
  396.     fFilters: TFilters;
  397.     {Compression level for ZLIB}
  398.     fCompressionLevel: TCompressionLevel;
  399.     {Maximum size for IDAT chunks}
  400.     fMaxIdatSize: Integer;
  401.     {Returns if image is interlaced}
  402.     fInterlaceMethod: TInterlaceMethod;
  403.     {Chunks object}
  404.     fChunkList: TPngList;
  405.     {Clear all chunks in the list}
  406.     procedure ClearChunks;
  407.     {Returns if header is present}
  408.     function HeaderPresent: Boolean;
  409.     {Returns linesize and byte offset for pixels}
  410.     procedure GetPixelInfo(var LineSize, Offset: Cardinal);
  411.     procedure SetMaxIdatSize(const Value: Integer);
  412.     function GetAlphaScanline(const LineIndex: Integer): pByteArray;
  413.     function GetScanline(const LineIndex: Integer): Pointer;
  414.     {$IFDEF Store16bits}
  415.     function GetExtraScanline(const LineIndex: Integer): Pointer;
  416.     {$ENDIF}
  417.     function GetTransparencyMode: TPNGTransparencyMode;
  418.     function GetTransparentColor: TColor;
  419.     procedure SetTransparentColor(const Value: TColor);
  420.   protected
  421.     {Returns the image palette}
  422.     function GetPalette: HPALETTE; {$IFDEF UseDelphi}override;{$ENDIF}
  423.     {Returns/sets image width and height}
  424.     function GetWidth: Integer; {$IFDEF UseDelphi}override;{$ENDIF}
  425.     function GetHeight: Integer; {$IFDEF UseDelphi}override; {$ENDIF}
  426.     procedure SetWidth(Value: Integer);  {$IFDEF UseDelphi}override; {$ENDIF}
  427.     procedure SetHeight(Value: Integer);  {$IFDEF UseDelphi}override;{$ENDIF}
  428.     {Assigns from another TPNGObject}
  429.     procedure AssignPNG(Source: TPNGObject);
  430.     {Returns if the image is empty}
  431.     function GetEmpty: Boolean; {$IFDEF UseDelphi}override; {$ENDIF}
  432.     {Used with property Header}
  433.     function GetHeader: TChunkIHDR;
  434.     {Draws using partial transparency}
  435.     procedure DrawPartialTrans(DC: HDC; Rect: TRect);
  436.     {$IFDEF UseDelphi}
  437.     {Returns if the image is transparent}
  438.     function GetTransparent: Boolean; override;
  439.     {$ENDIF}
  440.     {Returns a pixel}
  441.     function GetPixels(const X, Y: Integer): TColor; virtual;
  442.     procedure SetPixels(const X, Y: Integer; const Value: TColor); virtual;
  443.   public
  444.     {Gamma table array}
  445.     GammaTable: Array[Byte] of Byte;
  446.     {Generates alpha information}
  447.     procedure CreateAlpha;
  448.     {Removes the image transparency}
  449.     procedure RemoveTransparency;
  450.     {Transparent color}
  451.     property TransparentColor: TColor read GetTransparentColor write
  452.       SetTransparentColor;
  453.     {Add text chunk, TChunkTEXT, TChunkzTXT}
  454.     procedure AddtEXt(const Keyword, Text: String);
  455.     procedure AddzTXt(const Keyword, Text: String);
  456.     {$IFDEF UseDelphi}
  457.     {Saves to clipboard format (thanks to Antoine Pottern)}
  458.     procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
  459.       var APalette: HPalette); override;
  460.     procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
  461.       APalette: HPalette); override;
  462.     {$ENDIF}
  463.     {Calling errors}
  464.     procedure RaiseError(ExceptionClass: ExceptClass; Text: String);
  465.     {Returns a scanline from png}
  466.     property Scanline[const Index: Integer]: Pointer read GetScanline;
  467.     {$IFDEF Store16bits}
  468.     property ExtraScanline[const Index: Integer]: Pointer read GetExtraScanline;
  469.     {$ENDIF}
  470.     property AlphaScanline[const Index: Integer]: pByteArray read GetAlphaScanline;
  471.     {Returns pointer to the header}
  472.     property Header: TChunkIHDR read GetHeader;
  473.     {Returns the transparency mode used by this png}
  474.     property TransparencyMode: TPNGTransparencyMode read GetTransparencyMode;
  475.     {Assigns from another object}
  476.     procedure Assign(Source: TPersistent);{$IFDEF UseDelphi}override;{$ENDIF}
  477.     {Assigns to another object}
  478.     procedure AssignTo(Dest: TPersistent);{$IFDEF UseDelphi}override;{$ENDIF}
  479.     {Assigns from a windows bitmap handle}
  480.     procedure AssignHandle(Handle: HBitmap; Transparent: Boolean;
  481.       TransparentColor: ColorRef);
  482.     {Draws the image into a canvas}
  483.     procedure Draw(ACanvas: TCanvas; const Rect: TRect);
  484.       {$IFDEF UseDelphi}override;{$ENDIF}
  485.     {Width and height properties}
  486.     property Width: Integer read GetWidth;
  487.     property Height: Integer read GetHeight;
  488.     {Returns if the image is interlaced}
  489.     property InterlaceMethod: TInterlaceMethod read fInterlaceMethod
  490.       write fInterlaceMethod;
  491.     {Filters to test to encode}
  492.     property Filters: TFilters read fFilters write fFilters;
  493.     {Maximum size for IDAT chunks, default and minimum is 65536}
  494.     property MaxIdatSize: Integer read fMaxIdatSize write SetMaxIdatSize;
  495.     {Property to return if the image is empty or not}
  496.     property Empty: Boolean read GetEmpty;
  497.     {Compression level}
  498.     property CompressionLevel: TCompressionLevel read fCompressionLevel
  499.       write fCompressionLevel;
  500.     {Access to the chunk list}
  501.     property Chunks: TPngList read fChunkList;
  502.     {Object being created and destroyed}
  503.     constructor Create; {$IFDEF UseDelphi}override;{$ENDIF}
  504.     destructor Destroy; override;
  505.     {$IFNDEF UseDelphi}procedure LoadFromFile(const Filename: String);{$ENDIF}
  506.     {$IFNDEF UseDelphi}procedure SaveToFile(const Filename: String);{$ENDIF}
  507.     procedure LoadFromStream(Stream: TStream); {$IFDEF UseDelphi}override;{$ENDIF}
  508.     procedure SaveToStream(Stream: TStream); {$IFDEF UseDelphi}override;{$ENDIF}
  509.     {Loading the image from resources}
  510.     procedure LoadFromResourceName(Instance: HInst; const Name: String);
  511.     procedure LoadFromResourceID(Instance: HInst; ResID: Integer);
  512.     {Access to the png pixels}
  513.     property Pixels[const X, Y: Integer]: TColor read GetPixels write SetPixels;
  514.     {Palette property}
  515.     {$IFNDEF UseDelphi}property Palette: HPalette read GetPalette;{$ENDIF}
  516.   end;
  518.   {Chunk name object}
  519.   TChunkName = Array[0..3] of Char;
  521.   {Global chunk object}
  522.   TChunk = class
  523.   private
  524.     {Contains data}
  525.     fData: Pointer;
  526.     fDataSize: Cardinal;
  527.     {Stores owner}
  528.     fOwner: TPngObject;
  529.     {Stores the chunk name}
  530.     fName: TChunkName;
  531.     {Returns pointer to the TChunkIHDR}
  532.     function GetHeader: TChunkIHDR;
  533.     {Used with property index}
  534.     function GetIndex: Integer;
  535.     {Should return chunk class/name}
  536.     class function GetName: String; virtual;
  537.     {Returns the chunk name}
  538.     function GetChunkName: String;
  539.   public
  540.     {Returns index from list}
  541.     property Index: Integer read GetIndex;
  542.     {Returns pointer to the TChunkIHDR}
  543.     property Header: TChunkIHDR read GetHeader;
  544.     {Resize the data}
  545.     procedure ResizeData(const NewSize: Cardinal);
  546.     {Returns data and size}
  547.     property Data: Pointer read fData;
  548.     property DataSize: Cardinal read fDataSize;
  549.     {Assigns from another TChunk}
  550.     procedure Assign(Source: TChunk); virtual;
  551.     {Returns owner}
  552.     property Owner: TPngObject read fOwner;
  553.     {Being destroyed/created}
  554.     constructor Create(Owner: TPngObject); virtual;
  555.     destructor Destroy; override;
  556.     {Returns chunk class/name}
  557.     property Name: String read GetChunkName;
  558.     {Loads the chunk from a stream}
  559.     function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
  560.       Size: Integer): Boolean; virtual;
  561.     {Saves the chunk to a stream}
  562.     function SaveData(Stream: TStream): Boolean;
  563.     function SaveToStream(Stream: TStream): Boolean; virtual;
  564.   end;
  566.   {Chunk classes}
  567.   TChunkIEND = class(TChunk);     {End chunk}
  569.   {IHDR data}
  570.   pIHDRData = ^TIHDRData;
  571.   TIHDRData = packed record
  572.     Width, Height: Cardinal;
  573.     BitDepth,
  574.     ColorType,
  575.     CompressionMethod,
  576.     FilterMethod,
  577.     InterlaceMethod: Byte;
  578.   end;
  580.   {Information header chunk}
  581.   TChunkIHDR = class(TChunk)
  582.   private
  583.     {Current image}
  584.     ImageHandle: HBitmap;
  585.     ImageDC: HDC;
  586.     {Output windows bitmap}
  587.     HasPalette: Boolean;
  588.     BitmapInfo: TMaxBitmapInfo;
  589.     BytesPerRow: Integer;
  590.     {Stores the image bytes}
  591.     {$IFDEF Store16bits}ExtraImageData: Pointer;{$ENDIF}
  592.     ImageData: pointer;
  593.     ImageAlpha: Pointer;
  595.     {Contains all the ihdr data}
  596.     IHDRData: TIHDRData;
  597.   protected
  598.     {Resizes the image data to fill the color type, bit depth, }
  599.     {width and height parameters}
  600.     procedure PrepareImageData;
  601.     {Release allocated ImageData memory}
  602.     procedure FreeImageData;
  603.   public
  604.     {Access to ImageHandle}
  605.     property ImageHandleValue: HBitmap read ImageHandle;
  606.     {Properties}
  607.     property Width: Cardinal read IHDRData.Width write IHDRData.Width;
  608.     property Height: Cardinal read IHDRData.Height write IHDRData.Height;
  609.     property BitDepth: Byte read IHDRData.BitDepth write IHDRData.BitDepth;
  610.     property ColorType: Byte read IHDRData.ColorType write IHDRData.ColorType;
  611.     property CompressionMethod: Byte read IHDRData.CompressionMethod
  612.       write IHDRData.CompressionMethod;
  613.     property FilterMethod: Byte read IHDRData.FilterMethod
  614.       write IHDRData.FilterMethod;
  615.     property InterlaceMethod: Byte read IHDRData.InterlaceMethod
  616.       write IHDRData.InterlaceMethod;
  617.     {Loads the chunk from a stream}
  618.     function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
  619.       Size: Integer): Boolean; override;
  620.     {Saves the chunk to a stream}
  621.     function SaveToStream(Stream: TStream): Boolean; override;
  622.     {Destructor/constructor}
  623.     constructor Create(Owner: TPngObject); override;
  624.     destructor Destroy; override;
  625.     {Assigns from another TChunk}
  626.     procedure Assign(Source: TChunk); override;
  627.   end;
  629.   {Gamma chunk}
  630.   TChunkgAMA = class(TChunk)
  631.   private
  632.     {Returns/sets the value for the gamma chunk}
  633.     function GetValue: Cardinal;
  634.     procedure SetValue(const Value: Cardinal);
  635.   public
  636.     {Returns/sets gamma value}
  637.     property Gamma: Cardinal read GetValue write SetValue;
  638.     {Loading the chunk from a stream}
  639.     function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
  640.       Size: Integer): Boolean; override;
  641.     {Being created}
  642.     constructor Create(Owner: TPngObject); override;
  643.     {Assigns from another TChunk}
  644.     procedure Assign(Source: TChunk); override;
  645.   end;
  647.   {ZLIB Decompression extra information}
  648.   TZStreamRec2 = packed record
  649.     {From ZLIB}
  650.     ZLIB: TZStreamRec;
  651.     {Additional info}
  652.     Data: Pointer;
  653.     fStream   : TStream;
  654.   end;
  656.   {Palette chunk}
  657.   TChunkPLTE = class(TChunk)
  658.   private
  659.     {Number of items in the palette}
  660.     fCount: Integer;
  661.     {Contains the palette handle}
  662.     function GetPaletteItem(Index: Byte): TRGBQuad;
  663.   public
  664.     {Returns the color for each item in the palette}
  665.     property Item[Index: Byte]: TRGBQuad read GetPaletteItem;
  666.     {Returns the number of items in the palette}
  667.     property Count: Integer read fCount;
  668.     {Loads the chunk from a stream}
  669.     function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
  670.       Size: Integer): Boolean; override;
  671.     {Saves the chunk to a stream}
  672.     function SaveToStream(Stream: TStream): Boolean; override;
  673.     {Assigns from another TChunk}
  674.     procedure Assign(Source: TChunk); override;
  675.   end;
  677.   {Transparency information}
  678.   TChunktRNS = class(TChunk)
  679.   private
  680.     fBitTransparency: Boolean;
  681.     function GetTransparentColor: ColorRef;
  682.     {Returns the transparent color}
  683.     procedure SetTransparentColor(const Value: ColorRef);
  684.   public
  685.     {Palette values for transparency}
  686.     PaletteValues: Array[Byte] of Byte;
  687.     {Returns if it uses bit transparency}
  688.     property BitTransparency: Boolean read fBitTransparency;
  689.     {Returns the transparent color}
  690.     property TransparentColor: ColorRef read GetTransparentColor write
  691.       SetTransparentColor;
  692.     {Loads/saves the chunk from/to a stream}
  693.     function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
  694.       Size: Integer): Boolean; override;
  695.     function SaveToStream(Stream: TStream): Boolean; override;
  696.     {Assigns from another TChunk}
  697.     procedure Assign(Source: TChunk); override;
  698.   end;
  700.   {Actual image information}
  701.   TChunkIDAT = class(TChunk)
  702.   private
  703.     {Holds another pointer to the TChunkIHDR}
  704.     Header: TChunkIHDR;
  705.     {Stores temporary image width and height}
  706.     ImageWidth, ImageHeight: Integer;
  707.     {Size in bytes of each line and offset}
  708.     Row_Bytes, Offset : Cardinal;
  709.     {Contains data for the lines}
  710.     Encode_Buffer: Array[0..5] of pByteArray;
  711.     Row_Buffer: Array[Boolean] of pByteArray;
  712.     {Variable to invert the Row_Buffer used}
  713.     RowUsed: Boolean;
  714.     {Ending position for the current IDAT chunk}
  715.     EndPos: Integer;
  716.     {Filter the current line}
  717.     procedure FilterRow;
  718.     {Filter to encode and returns the best filter}
  719.     function FilterToEncode: Byte;
  720.     {Reads ZLIB compressed data}
  721.     function IDATZlibRead(var ZLIBStream: TZStreamRec2; Buffer: Pointer;
  722.       Count: Integer; var EndPos: Integer; var crcfile: Cardinal): Integer;
  723.     {Compress and writes IDAT data}
  724.     procedure IDATZlibWrite(var ZLIBStream: TZStreamRec2; Buffer: Pointer;
  725.       const Length: Cardinal);
  726.     procedure FinishIDATZlib(var ZLIBStream: TZStreamRec2);
  727.     {Prepares the palette}
  728.     procedure PreparePalette;
  729.   protected
  730.     {Decode interlaced image}
  731.     procedure DecodeInterlacedAdam7(Stream: TStream;
  732.       var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: Cardinal);
  733.     {Decode non interlaced imaged}
  734.     procedure DecodeNonInterlaced(Stream: TStream;
  735.       var ZLIBStream: TZStreamRec2; const Size: Integer;
  736.       var crcfile: Cardinal);
  737.   protected
  738.     {Encode non interlaced images}
  739.     procedure EncodeNonInterlaced(Stream: TStream;
  740.       var ZLIBStream: TZStreamRec2);
  741.     {Encode interlaced images}
  742.     procedure EncodeInterlacedAdam7(Stream: TStream;
  743.       var ZLIBStream: TZStreamRec2);
  744.   protected
  745.     {Memory copy methods to decode}
  746.     procedure CopyNonInterlacedRGB8(
  747.       Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  748.     procedure CopyNonInterlacedRGB16(
  749.       Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  750.     procedure CopyNonInterlacedPalette148(
  751.       Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  752.     procedure CopyNonInterlacedPalette2(
  753.       Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  754.     procedure CopyNonInterlacedGray2(
  755.       Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  756.     procedure CopyNonInterlacedGrayscale16(
  757.       Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  758.     procedure CopyNonInterlacedRGBAlpha8(
  759.       Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  760.     procedure CopyNonInterlacedRGBAlpha16(
  761.       Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  762.     procedure CopyNonInterlacedGrayscaleAlpha8(
  763.       Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  764.     procedure CopyNonInterlacedGrayscaleAlpha16(
  765.       Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  766.     procedure CopyInterlacedRGB8(const Pass: Byte;
  767.       Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  768.     procedure CopyInterlacedRGB16(const Pass: Byte;
  769.       Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  770.     procedure CopyInterlacedPalette148(const Pass: Byte;
  771.       Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  772.     procedure CopyInterlacedPalette2(const Pass: Byte;
  773.       Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  774.     procedure CopyInterlacedGray2(const Pass: Byte;
  775.       Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  776.     procedure CopyInterlacedGrayscale16(const Pass: Byte;
  777.       Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  778.     procedure CopyInterlacedRGBAlpha8(const Pass: Byte;
  779.       Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  780.     procedure CopyInterlacedRGBAlpha16(const Pass: Byte;
  781.       Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  782.     procedure CopyInterlacedGrayscaleAlpha8(const Pass: Byte;
  783.       Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  784.     procedure CopyInterlacedGrayscaleAlpha16(const Pass: Byte;
  785.       Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  786.   protected
  787.     {Memory copy methods to encode}
  788.     procedure EncodeNonInterlacedRGB8(Src, Dest, Trans: pChar);
  789.     procedure EncodeNonInterlacedRGB16(Src, Dest, Trans: pChar);
  790.     procedure EncodeNonInterlacedGrayscale16(Src, Dest, Trans: pChar);
  791.     procedure EncodeNonInterlacedPalette148(Src, Dest, Trans: pChar);
  792.     procedure EncodeNonInterlacedRGBAlpha8(Src, Dest, Trans: pChar);
  793.     procedure EncodeNonInterlacedRGBAlpha16(Src, Dest, Trans: pChar);
  794.     procedure EncodeNonInterlacedGrayscaleAlpha8(Src, Dest, Trans: pChar);
  795.     procedure EncodeNonInterlacedGrayscaleAlpha16(Src, Dest, Trans: pChar);
  796.     procedure EncodeInterlacedRGB8(const Pass: Byte; Src, Dest, Trans: pChar);
  797.     procedure EncodeInterlacedRGB16(const Pass: Byte; Src, Dest, Trans: pChar);
  798.     procedure EncodeInterlacedPalette148(const Pass: Byte;
  799.       Src, Dest, Trans: pChar);
  800.     procedure EncodeInterlacedGrayscale16(const Pass: Byte;
  801.       Src, Dest, Trans: pChar);
  802.     procedure EncodeInterlacedRGBAlpha8(const Pass: Byte;
  803.       Src, Dest, Trans: pChar);
  804.     procedure EncodeInterlacedRGBAlpha16(const Pass: Byte;
  805.       Src, Dest, Trans: pChar);
  806.     procedure EncodeInterlacedGrayscaleAlpha8(const Pass: Byte;
  807.       Src, Dest, Trans: pChar);
  808.     procedure EncodeInterlacedGrayscaleAlpha16(const Pass: Byte;
  809.       Src, Dest, Trans: pChar);
  810.   public
  811.     {Loads the chunk from a stream}
  812.     function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
  813.       Size: Integer): Boolean; override;
  814.     {Saves the chunk to a stream}
  815.     function SaveToStream(Stream: TStream): Boolean; override;
  816.   end;
  818.   {Image last modification chunk}
  819.   TChunktIME = class(TChunk)
  820.   private
  821.     {Holds the variables}
  822.     fYear: Word;
  823.     fMonth, fDay, fHour, fMinute, fSecond: Byte;
  824.   public
  825.     {Returns/sets variables}
  826.     property Year: Word read fYear write fYear;
  827.     property Month: Byte read fMonth write fMonth;
  828.     property Day: Byte read fDay write fDay;
  829.     property Hour: Byte read fHour write fHour;
  830.     property Minute: Byte read fMinute write fMinute;
  831.     property Second: Byte read fSecond write fSecond;
  832.     {Loads the chunk from a stream}
  833.     function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
  834.       Size: Integer): Boolean; override;
  835.     {Saves the chunk to a stream}
  836.     function SaveToStream(Stream: TStream): Boolean; override;
  837.   end;
  839.   {Textual data}
  840.   TChunktEXt = class(TChunk)
  841.   private
  842.     fKeyword, fText: String;
  843.   public
  844.     {Keyword and text}
  845.     property Keyword: String read fKeyword write fKeyword;
  846.     property Text: String read fText write fText;
  847.     {Loads the chunk from a stream}
  848.     function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
  849.       Size: Integer): Boolean; override;
  850.     {Saves the chunk to a stream}
  851.     function SaveToStream(Stream: TStream): Boolean; override;
  852.     {Assigns from another TChunk}
  853.     procedure Assign(Source: TChunk); override;
  854.   end;
  856.   {zTXT chunk}
  857.   TChunkzTXt = class(TChunktEXt)
  858.     {Loads the chunk from a stream}
  859.     function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
  860.       Size: Integer): Boolean; override;
  861.     {Saves the chunk to a stream}
  862.     function SaveToStream(Stream: TStream): Boolean; override;
  863.   end;
  865. {Here we test if it's c++ builder or delphi version 3 or less}
  866. {$IFDEF VER110}{$DEFINE DelphiBuilder3Less}{$ENDIF}
  867. {$IFDEF VER100}{$DEFINE DelphiBuilder3Less}{$ENDIF}
  868. {$IFDEF VER93}{$DEFINE DelphiBuilder3Less}{$ENDIF}
  869. {$IFDEF VER90}{$DEFINE DelphiBuilder3Less}{$ENDIF}
  870. {$IFDEF VER80}{$DEFINE DelphiBuilder3Less}{$ENDIF}
  873. {Registers a new chunk class}
  874. procedure RegisterChunk(ChunkClass: TChunkClass);
  875. {Calculates crc}
  876. function update_crc(crc: {$IFNDEF DelphiBuilder3Less}Cardinal{$ELSE}Integer
  877.   {$ENDIF}; buf: pByteArray; len: Integer): Cardinal;
  878. {Invert bytes using assembly}
  879. function ByteSwap(const a: integer): integer;
  881. implementation
  883. var
  884.   ChunkClasses: TPngPointerList;
  885.   {Table of CRCs of all 8-bit messages}
  886.   crc_table: Array[0..255] of Cardinal;
  887.   {Flag: has the table been computed? Initially false}
  888.   crc_table_computed: Boolean;
  890. {Draw transparent image using transparent color}
  891. procedure DrawTransparentBitmap(dc: HDC; srcBits: Pointer;
  892.   var srcHeader: TBitmapInfoHeader;
  893.   srcBitmapInfo: pBitmapInfo; Rect: TRect; cTransparentColor: COLORREF);
  894. var
  895.   cColor:   COLORREF;
  896.   bmAndBack, bmAndObject, bmAndMem: HBITMAP;
  897.   bmBackOld, bmObjectOld, bmMemOld: HBITMAP;
  898.   hdcMem, hdcBack, hdcObject, hdcTemp: HDC;
  899.   ptSize, orgSize: TPOINT;
  900.   OldBitmap, DrawBitmap: HBITMAP;
  901. begin
  902.   hdcTemp := CreateCompatibleDC(dc);
  903.   // Select the bitmap
  904.   DrawBitmap := CreateDIBitmap(dc, srcHeader, CBM_INIT, srcBits, srcBitmapInfo^,
  905.     DIB_RGB_COLORS);
  906.   OldBitmap := SelectObject(hdcTemp, DrawBitmap);
  908.   // Sizes
  909.   OrgSize.x := abs(srcHeader.biWidth);
  910.   OrgSize.y := abs(srcHeader.biHeight);
  911.   ptSize.x := Rect.Right - Rect.Left;        // Get width of bitmap
  912.   ptSize.y := Rect.Bottom - Rect.Top;        // Get height of bitmap
  914.   // Create some DCs to hold temporary data.
  915.   hdcBack  := CreateCompatibleDC(dc);
  916.   hdcObject := CreateCompatibleDC(dc);
  917.   hdcMem   := CreateCompatibleDC(dc);
  919.   // Create a bitmap for each DC. DCs are required for a number of
  920.   // GDI functions.
  922.   // Monochrome DCs
  923.   bmAndBack  := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil);
  924.   bmAndObject := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil);
  926.   bmAndMem   := CreateCompatibleBitmap(dc, ptSize.x, ptSize.y);
  928.   // Each DC must select a bitmap object to store pixel data.
  929.   bmBackOld  := SelectObject(hdcBack, bmAndBack);
  930.   bmObjectOld := SelectObject(hdcObject, bmAndObject);
  931.   bmMemOld   := SelectObject(hdcMem, bmAndMem);
  933.   // Set the background color of the source DC to the color.
  934.   // contained in the parts of the bitmap that should be transparent
  935.   cColor := SetBkColor(hdcTemp, cTransparentColor);
  937.   // Create the object mask for the bitmap by performing a BitBlt
  938.   // from the source bitmap to a monochrome bitmap.
  939.   StretchBlt(hdcObject, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0,
  940.     orgSize.x, orgSize.y, SRCCOPY);
  942.   // Set the background color of the source DC back to the original
  943.   // color.
  944.   SetBkColor(hdcTemp, cColor);
  946.   // Create the inverse of the object mask.
  947.   BitBlt(hdcBack, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0,
  948.        NOTSRCCOPY);
  950.   // Copy the background of the main DC to the destination.
  951.   BitBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, dc, Rect.Left, Rect.Top,
  952.        SRCCOPY);
  954.   // Mask out the places where the bitmap will be placed.
  955.   BitBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0, SRCAND);
  957.   // Mask out the transparent colored pixels on the bitmap.
  958. //  BitBlt(hdcTemp, 0, 0, ptSize.x, ptSize.y, hdcBack, 0, 0, SRCAND);
  959.   StretchBlt(hdcTemp, 0, 0, OrgSize.x, OrgSize.y, hdcBack, 0, 0,
  960.     PtSize.x, PtSize.y, SRCAND);
  962.   // XOR the bitmap with the background on the destination DC.
  963.   StretchBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0,
  964.     OrgSize.x, OrgSize.y, SRCPAINT);
  966.   // Copy the destination to the screen.
  967.   BitBlt(dc, Rect.Left, Rect.Top, ptSize.x, ptSize.y, hdcMem, 0, 0,
  968.        SRCCOPY);
  970.   // Delete the memory bitmaps.
  971.   DeleteObject(SelectObject(hdcBack, bmBackOld));
  972.   DeleteObject(SelectObject(hdcObject, bmObjectOld));
  973.   DeleteObject(SelectObject(hdcMem, bmMemOld));
  974.   DeleteObject(SelectObject(hdcTemp, OldBitmap));
  976.   // Delete the memory DCs.
  977.   DeleteDC(hdcMem);
  978.   DeleteDC(hdcBack);
  979.   DeleteDC(hdcObject);
  980.   DeleteDC(hdcTemp);
  981. end;
  983. {Make the table for a fast CRC.}
  984. procedure make_crc_table;
  985. var
  986.   c: Cardinal;
  987.   n, k: Integer;
  988. begin
  990.   {fill the crc table}
  991.   for n := 0 to 255 do
  992.   begin
  993.     c := Cardinal(n);
  994.     for k := 0 to 7 do
  995.     begin
  996.       if Boolean(c and 1) then
  997.         c := $edb88320 xor (c shr 1)
  998.       else
  999.         c := c shr 1;
  1000.     end;
  1001.     crc_table[n] := c;
  1002.   end;
  1004.   {The table has already being computated}
  1005.   crc_table_computed := true;
  1006. end;
  1008. {Update a running CRC with the bytes buf[0..len-1]--the CRC
  1009.  should be initialized to all 1's, and the transmitted value
  1010.  is the 1's complement of the final running CRC (see the
  1011.  crc() routine below)).}
  1012. function update_crc(crc: {$IFNDEF DelphiBuilder3Less}Cardinal{$ELSE}Integer
  1013.   {$ENDIF}; buf: pByteArray; len: Integer): Cardinal;
  1014. var
  1015.   c: Cardinal;
  1016.   n: Integer;
  1017. begin
  1018.   c := crc;
  1020.   {Create the crc table in case it has not being computed yet}
  1021.   if not crc_table_computed then make_crc_table;
  1023.   {Update}
  1024.   for n := 0 to len - 1 do
  1025.     c := crc_table[(c XOR buf^[n]) and $FF] XOR (c shr 8);
  1027.   {Returns}
  1028.   Result := c;
  1029. end;
  1031. {$IFNDEF UseDelphi}
  1032.   function FileExists(Filename: String): Boolean;
  1033.   var
  1034.     FindFile: THandle;
  1035.     FindData: TWin32FindData;
  1036.   begin
  1037.     FindFile := FindFirstFile(PChar(Filename), FindData);
  1038.     Result := FindFile <> INVALID_HANDLE_VALUE;
  1039.     if Result then Windows.FindClose(FindFile);
  1040.   end;
  1043. {$ENDIF}
  1045. {$IFNDEF UseDelphi}
  1046.   {Exception implementation}
  1047.   constructor Exception.Create(Msg: String);
  1048.   begin
  1049.   end;
  1050. {$ENDIF}
  1052. {Calculates the paeth predictor}
  1053. function PaethPredictor(a, b, c: Byte): Byte;
  1054. var
  1055.   pa, pb, pc: Integer;
  1056. begin
  1057.   { a = left, b = above, c = upper left }
  1058.   pa := abs(b - c);      { distances to a, b, c }
  1059.   pb := abs(a - c);
  1060.   pc := abs(a + b - c * 2);
  1062.   { return nearest of a, b, c, breaking ties in order a, b, c }
  1063.   if (pa <= pb) and (pa <= pc) then
  1064.     Result := a
  1065.   else
  1066.     if pb <= pc then
  1067.       Result := b
  1068.     else
  1069.       Result := c;
  1070. end;
  1072. {Invert bytes using assembly}
  1073. function ByteSwap(const a: integer): integer;
  1074. asm
  1075.   bswap eax
  1076. end;
  1077. function ByteSwap16(inp:word): word;
  1078. asm
  1079.   bswap eax
  1080.   shr   eax, 16
  1081. end;
  1083. {Calculates number of bytes for the number of pixels using the}
  1084. {color mode in the paramenter}
  1085. function BytesForPixels(const Pixels: Integer; const ColorType,
  1086.   BitDepth: Byte): Integer;
  1087. begin
  1088.   case ColorType of
  1089.     {Palette and grayscale contains a single value, for palette}
  1090.     {an value of size 2^bitdepth pointing to the palette index}
  1091.     {and grayscale the value from 0 to 2^bitdepth with color intesity}
  1092.     COLOR_GRAYSCALE, COLOR_PALETTE:
  1093.       Result := (Pixels * BitDepth + 7) div 8;
  1094.     {RGB contains 3 values R, G, B with size 2^bitdepth each}
  1095.     COLOR_RGB:
  1096.       Result := (Pixels * BitDepth * 3) div 8;
  1097.     {Contains one value followed by alpha value booth size 2^bitdepth}
  1098.     COLOR_GRAYSCALEALPHA:
  1099.       Result := (Pixels * BitDepth * 2) div 8;
  1100.     {Contains four values size 2^bitdepth, Red, Green, Blue and alpha}
  1101.     COLOR_RGBALPHA:
  1102.       Result := (Pixels * BitDepth * 4) div 8;
  1103.     else
  1104.       Result := 0;
  1105.   end {case ColorType}
  1106. end;
  1108. type
  1109.   pChunkClassInfo = ^TChunkClassInfo;
  1110.   TChunkClassInfo = record
  1111.     ClassName: TChunkClass;
  1112.   end;
  1114. {Register a chunk type}
  1115. procedure RegisterChunk(ChunkClass: TChunkClass);
  1116. var
  1117.   NewClass: pChunkClassInfo;
  1118. begin
  1119.   {In case the list object has not being created yet}
  1120.   if ChunkClasses = nil then ChunkClasses := TPngPointerList.Create(nil);
  1122.   {Add this new class}
  1123.   new(NewClass);
  1124.   NewClass^.ClassName := ChunkClass;
  1125.   ChunkClasses.Add(NewClass);
  1126. end;
  1128. {Free chunk class list}
  1129. procedure FreeChunkClassList;
  1130. var
  1131.   i: Integer;
  1132. begin
  1133.   if (ChunkClasses <> nil) then
  1134.   begin
  1135.     FOR i := 0 TO ChunkClasses.Count - 1 do
  1136.       Dispose(pChunkClassInfo(ChunkClasses.Item[i]));
  1137.     ChunkClasses.Free;
  1138.   end;
  1139. end;
  1141. {Registering of common chunk classes}
  1142. procedure RegisterCommonChunks;
  1143. begin
  1144.   {Important chunks}
  1145.   RegisterChunk(TChunkIEND);
  1146.   RegisterChunk(TChunkIHDR);
  1147.   RegisterChunk(TChunkIDAT);
  1148.   RegisterChunk(TChunkPLTE);
  1149.   RegisterChunk(TChunkgAMA);
  1150.   RegisterChunk(TChunktRNS);
  1152.   {Not so important chunks}
  1153.   RegisterChunk(TChunktIME);
  1154.   RegisterChunk(TChunktEXt);
  1155.   RegisterChunk(TChunkzTXt);
  1156. end;
  1158. {Creates a new chunk of this class}
  1159. function CreateClassChunk(Owner: TPngObject; Name: TChunkName): TChunk;
  1160. var
  1161.   i       : Integer;
  1162.   NewChunk: TChunkClass;
  1163. begin
  1164.   {Looks for this chunk}
  1165.   NewChunk := TChunk;  {In case there is no registered class for this}
  1167.   {Looks for this class in all registered chunks}
  1168.   if Assigned(ChunkClasses) then
  1169.     FOR i := 0 TO ChunkClasses.Count - 1 DO
  1170.     begin
  1171.       if pChunkClassInfo(ChunkClasses.Item[i])^.ClassName.GetName = Name then
  1172.       begin
  1173.         NewChunk := pChunkClassInfo(ChunkClasses.Item[i])^.ClassName;
  1174.         break;
  1175.       end;
  1176.     end;
  1178.   {Returns chunk class}
  1179.   Result := NewChunk.Create(Owner);
  1180.   Result.fName := Name;
  1181. end;
  1183. {ZLIB support}
  1185. const
  1186.   ZLIBAllocate = High(Word);
  1188. {Initializes ZLIB for decompression}
  1189. function ZLIBInitInflate(Stream: TStream): TZStreamRec2;
  1190. begin
  1191.   {Fill record}
  1192.   Fillchar(Result, SIZEOF(TZStreamRec2), #0);
  1194.   {Set internal record information}
  1195.   with Result do
  1196.   begin
  1197.     GetMem(Data, ZLIBAllocate);
  1198.     fStream := Stream;
  1199.   end;
  1201.   {Init decompression}
  1202.   InflateInit_(Result.zlib, zlib_version, SIZEOF(TZStreamRec));
  1203. end;
  1205. {Initializes ZLIB for compression}
  1206. function ZLIBInitDeflate(Stream: TStream;
  1207.   Level: TCompressionlevel; Size: Cardinal): TZStreamRec2;
  1208. begin
  1209.   {Fill record}
  1210.   Fillchar(Result, SIZEOF(TZStreamRec2), #0);
  1212.   {Set internal record information}
  1213.   with Result, ZLIB do
  1214.   begin
  1215.     GetMem(Data, Size);
  1216.     fStream := Stream;
  1217.     next_out := Data;
  1218.     avail_out := Size;
  1219.   end;
  1221.   {Inits compression}
  1222.   deflateInit_(Result.zlib, Level, zlib_version, sizeof(TZStreamRec));
  1223. end;
  1225. {Terminates ZLIB for compression}
  1226. procedure ZLIBTerminateDeflate(var ZLIBStream: TZStreamRec2);
  1227. begin
  1228.   {Terminates decompression}
  1229.   DeflateEnd(ZLIBStream.zlib);
  1230.   {Free internal record}
  1231.   FreeMem(ZLIBStream.Data, ZLIBAllocate);
  1232. end;
  1234. {Terminates ZLIB for decompression}
  1235. procedure ZLIBTerminateInflate(var ZLIBStream: TZStreamRec2);
  1236. begin
  1237.   {Terminates decompression}
  1238.   InflateEnd(ZLIBStream.zlib);
  1239.   {Free internal record}
  1240.   FreeMem(ZLIBStream.Data, ZLIBAllocate);
  1241. end;
  1243. {Decompresses ZLIB into a memory address}
  1244. function DecompressZLIB(const Input: Pointer; InputSize: Integer;
  1245.   var Output: Pointer; var OutputSize: Integer;
  1246.   var ErrorOutput: String): Boolean;
  1247. var
  1248.   StreamRec : TZStreamRec;
  1249.   Buffer    : Array[Byte] of Byte;
  1250.   InflateRet: Integer;
  1251. begin
  1252.   with StreamRec do
  1253.   begin
  1254.     {Initializes}
  1255.     Result := True;
  1256.     OutputSize := 0;
  1258.     {Prepares the data to decompress}
  1259.     FillChar(StreamRec, SizeOf(TZStreamRec), #0);
  1260.     InflateInit_(StreamRec, zlib_version, SIZEOF(TZStreamRec));
  1261.     next_in := Input;
  1262.     avail_in := InputSize;
  1264.     {Decodes data}
  1265.     repeat
  1266.       {In case it needs an output buffer}
  1267.       if (avail_out = 0) then
  1268.       begin
  1269.         next_out := @Buffer;
  1270.         avail_out := SizeOf(Buffer);
  1271.       end {if (avail_out = 0)};
  1273.       {Decompress and put in output}
  1274.       InflateRet := inflate(StreamRec, 0);
  1275.       if (InflateRet = Z_STREAM_END) or (InflateRet = 0) then
  1276.       begin
  1277.         {Reallocates output buffer}
  1278.         inc(OutputSize, total_out);
  1279.         if Output = nil then
  1280.           GetMem(Output, OutputSize) else ReallocMem(Output, OutputSize);
  1281.         {Copies the new data}
  1282.         CopyMemory(Ptr(Longint(Output) + OutputSize - total_out),
  1283.           @Buffer, total_out);
  1284.       end {if (InflateRet = Z_STREAM_END) or (InflateRet = 0)}
  1285.       {Now tests for errors}
  1286.       else if InflateRet < 0 then
  1287.       begin
  1288.         Result := False;
  1289.         ErrorOutput := StreamRec.msg;
  1290.         InflateEnd(StreamRec);
  1291.         Exit;
  1292.       end {if InflateRet < 0}
  1293.     until InflateRet = Z_STREAM_END;
  1295.     {Terminates decompression}
  1296.     InflateEnd(StreamRec);
  1297.   end {with StreamRec}
  1299. end;
  1301. {Compresses ZLIB into a memory address}
  1302. function CompressZLIB(Input: Pointer; InputSize, CompressionLevel: Integer;
  1303.   var Output: Pointer; var OutputSize: Integer;
  1304.   var ErrorOutput: String): Boolean;
  1305. var
  1306.   StreamRec : TZStreamRec;
  1307.   Buffer    : Array[Byte] of Byte;
  1308.   DeflateRet: Integer;
  1309. begin
  1310.   with StreamRec do
  1311.   begin
  1312.     Result := True; {By default returns TRUE as everything might have gone ok}
  1313.     OutputSize := 0; {Initialize}
  1314.     {Prepares the data to compress}
  1315.     FillChar(StreamRec, SizeOf(TZStreamRec), #0);
  1316.     DeflateInit_(StreamRec, CompressionLevel,zlib_version, SIZEOF(TZStreamRec));
  1318.     next_in := Input;
  1319.     avail_in := InputSize;
  1321.     while avail_in > 0 do
  1322.     begin
  1323.       {When it needs new buffer to stores the compressed data}
  1324.       if avail_out = 0 then
  1325.       begin
  1326.         {Restore buffer}
  1327.         next_out := @Buffer;
  1328.         avail_out := SizeOf(Buffer);
  1329.       end {if avail_out = 0};
  1331.       {Compresses}
  1332.       DeflateRet := deflate(StreamRec, Z_FINISH);
  1334.       if (DeflateRet = Z_STREAM_END) or (DeflateRet = 0) then
  1335.       begin
  1336.         {Updates the output memory}
  1337.         inc(OutputSize, total_out);
  1338.         if Output = nil then
  1339.           GetMem(Output, OutputSize) else ReallocMem(Output, OutputSize);
  1341.         {Copies the new data}
  1342.         CopyMemory(Ptr(Longint(Output) + OutputSize - total_out),
  1343.           @Buffer, total_out);
  1344.       end {if (InflateRet = Z_STREAM_END) or (InflateRet = 0)}
  1345.       {Now tests for errors}
  1346.       else if DeflateRet < 0 then
  1347.       begin
  1348.         Result := False;
  1349.         ErrorOutput := StreamRec.msg;
  1350.         DeflateEnd(StreamRec);
  1351.         Exit;
  1352.       end {if InflateRet < 0}
  1354.     end {while avail_in > 0};
  1356.     {Finishes compressing}
  1357.     DeflateEnd(StreamRec);
  1358.   end {with StreamRec}
  1360. end;
  1362. {TPngPointerList implementation}
  1364. {Object being created}
  1365. constructor TPngPointerList.Create(AOwner: TPNGObject);
  1366. begin
  1367.   inherited Create; {Let ancestor work}
  1368.   {Holds owner}
  1369.   fOwner := AOwner;
  1370.   {Memory pointer not being used yet}
  1371.   fMemory := nil;
  1372.   {No items yet}
  1373.   fCount := 0;
  1374. end;
  1376. {Removes value from the list}
  1377. function TPngPointerList.Remove(Value: Pointer): Pointer;
  1378. var
  1379.   I, Position: Integer;
  1380. begin
  1381.   {Gets item position}
  1382.   Position := -1;
  1383.   FOR I := 0 TO Count - 1 DO
  1384.     if Value = Item[I] then Position := I;
  1385.   {In case a match was found}
  1386.   if Position >= 0 then
  1387.   begin
  1388.     Result := Item[Position]; {Returns pointer}
  1389.     {Remove item and move memory}
  1390.     Dec(fCount);
  1391.     if Position < Integer(FCount) then
  1392.       System.Move(fMemory^[Position + 1], fMemory^[Position],
  1393.       (Integer(fCount) - Position) * SizeOf(Pointer));
  1394.   end {if Position >= 0} else Result := nil
  1395. end;
  1397. {Add a new value in the list}
  1398. procedure TPngPointerList.Add(Value: Pointer);
  1399. begin
  1400.   Count := Count + 1;
  1401.   Item[Count - 1] := Value;
  1402. end;
  1405. {Object being destroyed}
  1406. destructor TPngPointerList.Destroy;
  1407. begin
  1408.   {Release memory if needed}
  1409.   if fMemory <> nil then
  1410.     FreeMem(fMemory, fCount * sizeof(Pointer));
  1412.   {Free things}
  1413.   inherited Destroy;
  1414. end;
  1416. {Returns one item from the list}
  1417. function TPngPointerList.GetItem(Index: Cardinal): Pointer;
  1418. begin
  1419.   if (Index <= Count - 1) then
  1420.     Result := fMemory[Index]
  1421.   else
  1422.     {In case it's out of bounds}
  1423.     Result := nil;
  1424. end;
  1426. {Inserts a new item in the list}
  1427. procedure TPngPointerList.Insert(Value: Pointer; Position: Cardinal);
  1428. begin
  1429.   if (Position < Count) then
  1430.   begin
  1431.     {Increase item count}
  1432.     SetSize(Count + 1);
  1433.     {Move other pointers}
  1434.     if Position < Count then
  1435.       System.Move(fMemory^[Position], fMemory^[Position + 1],
  1436.         (Count - Position - 1) * SizeOf(Pointer));
  1437.     {Sets item}
  1438.     Item[Position] := Value;
  1439.   end;
  1440. end;
  1442. {Sets one item from the list}
  1443. procedure TPngPointerList.SetItem(Index: Cardinal; const Value: Pointer);
  1444. begin
  1445.   {If index is in bounds, set value}
  1446.   if (Index <= Count - 1) then
  1447.     fMemory[Index] := Value
  1448. end;
  1450. {This method resizes the list}
  1451. procedure TPngPointerList.SetSize(const Size: Cardinal);
  1452. begin
  1453.   {Sets the size}
  1454.   if (fMemory = nil) and (Size > 0) then
  1455.     GetMem(fMemory, Size * SIZEOF(Pointer))
  1456.   else
  1457.     if Size > 0 then  {Only realloc if the new size is greater than 0}
  1458.       ReallocMem(fMemory, Size * SIZEOF(Pointer))
  1459.     else
  1460.     {In case user is resize to 0 items}
  1461.     begin
  1462.       FreeMem(fMemory);
  1463.       fMemory := nil;
  1464.     end;
  1465.   {Update count}
  1466.   fCount := Size;
  1467. end;
  1469. {TPNGList implementation}
  1471. {Removes an item}
  1472. procedure TPNGList.RemoveChunk(Chunk: TChunk);
  1473. begin
  1474.   Remove(Chunk);
  1475.   Chunk.Free
  1476. end;
  1478. {Add a new item}
  1479. function TPNGList.Add(ChunkClass: TChunkClass): TChunk;
  1480. var
  1481.   IHDR: TChunkIHDR;
  1482.   IEND: TChunkIEND;
  1484.   IDAT: TChunkIDAT;
  1485.   PLTE: TChunkPLTE;
  1486. begin
  1487.   Result := nil; {Default result}
  1488.   {Adding these is not allowed}
  1489.   if (ChunkClass = TChunkIHDR) or (ChunkClass = TChunkIDAT) or
  1490.     (ChunkClass = TChunkPLTE) or (ChunkClass = TChunkIEND) then
  1491.     fOwner.RaiseError(EPngError, EPNGCannotAddChunkText)
  1492.   {Two of these is not allowed}
  1493.   else if ((ChunkClass = TChunkgAMA) and (ItemFromClass(TChunkgAMA) <> nil)) or
  1494.      ((ChunkClass = TChunktRNS) and (ItemFromClass(TChunktRNS) <> nil)) then
  1495.     fOwner.RaiseError(EPngError, EPNGCannotAddChunkText)
  1496.   {There must have an IEND and IHDR chunk}
  1497.   else if (ItemFromClass(TChunkIEND) = nil) or
  1498.     (ItemFromClass(TChunkIHDR) = nil) then
  1499.     fOwner.RaiseError(EPngError, EPNGCannotAddInvalidImageText)
  1500.   else
  1501.   begin
  1502.     {Get common chunks}
  1503.     IHDR := ItemFromClass(TChunkIHDR) as TChunkIHDR;
  1504.     IEND := ItemFromClass(TChunkIEND) as TChunkIEND;
  1505.     {Create new chunk}
  1506.     Result := ChunkClass.Create(Owner);
  1507.     {Add to the list}
  1508.     if (ChunkClass = TChunkgAMA) then
  1509.       Insert(Result, IHDR.Index + 1)
  1510.     {Transparency chunk (fix by Ian Boyd)}
  1511.     else if (ChunkClass = TChunktRNS) then
  1512.     begin
  1513.       {Transparecy chunk must be after PLTE; before IDAT}
  1514.       IDAT := ItemFromClass(TChunkIDAT) as TChunkIDAT;
  1515.       PLTE := ItemFromClass(TChunkPLTE) as TChunkPLTE;
  1517.       if Assigned(PLTE) then
  1518.         Insert(Result, PLTE.Index + 1)
  1519.       else if Assigned(IDAT) then
  1520.         Insert(Result, IDAT.Index)
  1521.       else
  1522.         Insert(Result, IHDR.Index + 1)
  1523.     end
  1524.     else {All other chunks}
  1525.       Insert(Result, IEND.Index);
  1526.   end {if}
  1527. end;
  1529. {Returns item from the list}
  1530. function TPNGList.GetItem(Index: Cardinal): TChunk;
  1531. begin
  1532.   Result := inherited GetItem(Index);
  1533. end;
  1535. {Returns first item from the list using the class from parameter}
  1536. function TPNGList.ItemFromClass(ChunkClass: TChunkClass): TChunk;
  1537. var
  1538.   i: Integer;
  1539. begin
  1540.   Result := nil; {Initial result}
  1541.   FOR i := 0 TO Count - 1 DO
  1542.     {Test if this item has the same class}
  1543.     if Item[i] is ChunkClass then
  1544.     begin
  1545.       {Returns this item and exit}
  1546.       Result := Item[i];
  1547.       break;
  1548.     end {if}
  1549. end;
  1551. {$IFNDEF UseDelphi}
  1553.   {TStream implementation}
  1555.   {Copies all from another stream}
  1556.   function TStream.CopyFrom(Source: TStream; Count: Cardinal): Cardinal;
  1557.   const
  1558.     MaxBytes = $f000;
  1559.   var
  1560.     Buffer:  PChar;
  1561.     BufSize, N: Cardinal;
  1562.   begin
  1563.     {If count is zero, copy everything from Source}
  1564.     if Count = 0 then
  1565.     begin
  1566.       Source.Seek(0, soFromBeginning);
  1567.       Count := Source.Size;
  1568.     end;
  1570.     Result := Count; {Returns the number of bytes readed}
  1571.     {Allocates memory}
  1572.     if Count > MaxBytes then BufSize := MaxBytes else BufSize := Count;
  1573.     GetMem(Buffer, BufSize);
  1575.     {Copy memory}
  1576.     while Count > 0 do
  1577.     begin
  1578.       if Count > BufSize then N := BufSize else N := Count;
  1579.       Source.Read(Buffer^, N);
  1580.       Write(Buffer^, N);
  1581.       dec(Count, N);
  1582.     end;
  1584.     {Deallocates memory}
  1585.     FreeMem(Buffer, BufSize);
  1586.   end;
  1588. {Set current stream position}
  1589. procedure TStream.SetPosition(const Value: Longint);
  1590. begin
  1591.   Seek(Value, soFromBeginning);
  1592. end;
  1594. {Returns position}
  1595. function TStream.GetPosition: Longint;
  1596. begin
  1597.   Result := Seek(0, soFromCurrent);
  1598. end;
  1600.   {Returns stream size}
  1601. function TStream.GetSize: Longint;
  1602.   var
  1603.     Pos: Cardinal;
  1604.   begin
  1605.     Pos := Seek(0, soFromCurrent);
  1606.     Result := Seek(0, soFromEnd);
  1607.     Seek(Pos, soFromCurrent);
  1608.   end;
  1610.   {TFileStream implementation}
  1612.   {Filestream object being created}
  1613.   constructor TFileStream.Create(Filename: String; Mode: TFileStreamModeSet);
  1614.     {Makes file mode}
  1615.     function OpenMode: DWORD;
  1616.     begin
  1617.       Result := 0;
  1618.       if fsmRead in Mode then Result := GENERIC_READ;
  1619.       if (fsmWrite in Mode) or (fsmCreate in Mode) then
  1620.         Result := Result OR GENERIC_WRITE;
  1621.     end;
  1622.   const
  1623.     IsCreate: Array[Boolean] of Integer = (OPEN_ALWAYS, CREATE_ALWAYS);
  1624.   begin
  1625.     {Call ancestor}
  1626.     inherited Create;
  1628.     {Create handle}
  1629.     fHandle := CreateFile(PChar(Filename), OpenMode, FILE_SHARE_READ or
  1630.       FILE_SHARE_WRITE, nil, IsCreate[fsmCreate in Mode], 0, 0);
  1631.     {Store mode}
  1632.     FileMode := Mode;
  1633.   end;
  1635.   {Filestream object being destroyed}
  1636.   destructor TFileStream.Destroy;
  1637.   begin
  1638.     {Terminates file and close}
  1639.     if FileMode = [fsmWrite] then
  1640.       SetEndOfFile(fHandle);
  1641.     CloseHandle(fHandle);
  1643.     {Call ancestor}
  1644.     inherited Destroy;
  1645.   end;
  1647.   {Writes data to the file}
  1648.   function TFileStream.Write(const Buffer; Count: Longint): Cardinal;
  1649.   begin
  1650.     if not WriteFile(fHandle, Buffer, Count, Result, nil) then
  1651.       Result := 0;
  1652.   end;
  1654.   {Reads data from the file}
  1655.   function TFileStream.Read(var Buffer; Count: Longint): Cardinal;
  1656.   begin
  1657.     if not ReadFile(fHandle, Buffer, Count, Result, nil) then
  1658.       Result := 0;
  1659.   end;
  1661.   {Seeks the file position}
  1662.   function TFileStream.Seek(Offset: Integer; Origin: Word): Longint;
  1663.   begin
  1664.     Result := SetFilePointer(fHandle, Offset, nil, Origin);
  1665.   end;
  1667.   {Sets the size of the file}
  1668.   procedure TFileStream.SetSize(const Value: Longint);
  1669.   begin
  1670.     Seek(Value, soFromBeginning);
  1671.     SetEndOfFile(fHandle);
  1672.   end;
  1674.   {TResourceStream implementation}
  1676.   {Creates the resource stream}
  1677.   constructor TResourceStream.Create(Instance: HInst; const ResName: String;
  1678.     ResType: PChar);
  1679.   var
  1680.     ResID: HRSRC;
  1681.     ResGlobal: HGlobal;
  1682.   begin
  1683.     {Obtains the resource ID}
  1684.     ResID := FindResource(hInstance, PChar(ResName), RT_RCDATA);
  1685.     if ResID = 0 then raise EPNGError.Create('');
  1686.     {Obtains memory and size}
  1687.     ResGlobal := LoadResource(hInstance, ResID);
  1688.     Size := SizeOfResource(hInstance, ResID);
  1689.     Memory := LockResource(ResGlobal);
  1690.     if (ResGlobal = 0) or (Memory = nil) then EPNGError.Create('');
  1691.   end;
  1694.   {Setting resource stream size is not supported}
  1695.   procedure TResourceStream.SetSize(const Value: Integer);
  1696.   begin
  1697.   end;
  1699.   {Writing into a resource stream is not supported}
  1700.   function TResourceStream.Write(const Buffer; Count: Integer): Cardinal;
  1701.   begin
  1702.     Result := 0;
  1703.   end;
  1705.   {Reads data from the stream}
  1706.   function TResourceStream.Read(var Buffer; Count: Integer): Cardinal;
  1707.   begin
  1708.     //Returns data
  1709.     CopyMemory(@Buffer, Ptr(Longint(Memory) + Position), Count);
  1710.     //Update position
  1711.     inc(Position, Count);
  1712.     //Returns
  1713.     Result := Count;
  1714.   end;
  1716.   {Seeks data}
  1717.   function TResourceStream.Seek(Offset: Integer; Origin: Word): Longint;
  1718.   begin
  1719.     {Move depending on the origin}
  1720.     case Origin of
  1721.       soFromBeginning: Position := Offset;
  1722.       soFromCurrent: inc(Position, Offset);
  1723.       soFromEnd: Position := Size + Offset;
  1724.     end;
  1726.     {Returns the current position}
  1727.     Result := Position;
  1728.   end;
  1730. {$ENDIF}
  1732. {TChunk implementation}
  1734. {Resizes the data}
  1735. procedure TChunk.ResizeData(const NewSize: Cardinal);
  1736. begin
  1737.   fDataSize := NewSize;
  1738.   ReallocMem(fData, NewSize + 1);
  1739. end;
  1741. {Returns index from list}
  1742. function TChunk.GetIndex: Integer;
  1743. var
  1744.   i: Integer;
  1745. begin
  1746.   Result := -1; {Avoiding warnings}
  1747.   {Searches in the list}
  1748.   FOR i := 0 TO Owner.Chunks.Count - 1 DO
  1749.     if Owner.Chunks.Item[i] = Self then
  1750.     begin
  1751.       {Found match}
  1752.       Result := i;
  1753.       exit;
  1754.     end {for i}
  1755. end;
  1757. {Returns pointer to the TChunkIHDR}
  1758. function TChunk.GetHeader: TChunkIHDR;
  1759. begin
  1760.   Result := Owner.Chunks.Item[0] as TChunkIHDR;
  1761. end;
  1763. {Assigns from another TChunk}
  1764. procedure TChunk.Assign(Source: TChunk);
  1765. begin
  1766.   {Copy properties}
  1767.   fName := Source.fName;
  1768.   {Set data size and realloc}
  1769.   ResizeData(Source.fDataSize);
  1771.   {Copy data (if there's any)}
  1772.   if fDataSize > 0 then CopyMemory(fData, Source.fData, fDataSize);
  1773. end;
  1775. {Chunk being created}
  1776. constructor TChunk.Create(Owner: TPngObject);
  1777. var
  1778.   ChunkName: String;
  1779. begin
  1780.   {Ancestor create}
  1781.   inherited Create;
  1783.   {If it's a registered class, set the chunk name based on the class}
  1784.   {name. For instance, if the class name is TChunkgAMA, the GAMA part}
  1785.   {will become the chunk name}
  1786.   ChunkName := Copy(ClassName, Length('TChunk') + 1, Length(ClassName));
  1787.   if Length(ChunkName) = 4 then CopyMemory(@fName[0], @ChunkName[1], 4);
  1789.   {Initialize data holder}
  1790.   GetMem(fData, 1);
  1791.   fDataSize := 0;
  1792.   {Record owner}
  1793.   fOwner := Owner;
  1794. end;
  1796. {Chunk being destroyed}
  1797. destructor TChunk.Destroy;
  1798. begin
  1799.   {Free data holder}
  1800.   FreeMem(fData, fDataSize + 1);
  1801.   {Let ancestor destroy}
  1802.   inherited Destroy;
  1803. end;
  1805. {Returns the chunk name 1}
  1806. function TChunk.GetChunkName: String;
  1807. begin
  1808.   Result := fName
  1809. end;
  1811. {Returns the chunk name 2}
  1812. class function TChunk.GetName: String;
  1813. begin
  1814.   {For avoid writing GetName for each TChunk descendent, by default for}
  1815.   {classes which don't declare GetName, it will look for the class name}
  1816.   {to extract the chunk kind. Example, if the class name is TChunkIEND }
  1817.   {this method extracts and returns IEND}
  1818.   Result := Copy(ClassName, Length('TChunk') + 1, Length(ClassName));
  1819. end;
  1821. {Saves the data to the stream}
  1822. function TChunk.SaveData(Stream: TStream): Boolean;
  1823. var
  1824.   ChunkSize, ChunkCRC: Cardinal;
  1825. begin
  1826.   {First, write the size for the following data in the chunk}
  1827.   ChunkSize := ByteSwap(DataSize);
  1828.   Stream.Write(ChunkSize, 4);
  1829.   {The chunk name}
  1830.   Stream.Write(fName, 4);
  1831.   {If there is data for the chunk, write it}
  1832.   if DataSize > 0 then Stream.Write(Data^, DataSize);
  1833.   {Calculates and write CRC}
  1834.   ChunkCRC := update_crc($ffffffff, @fName[0], 4);
  1835.   ChunkCRC := Byteswap(update_crc(ChunkCRC, Data, DataSize) xor $ffffffff);
  1836.   Stream.Write(ChunkCRC, 4);
  1838.   {Returns that everything went ok}
  1839.   Result := TRUE;
  1840. end;
  1842. {Saves the chunk to the stream}
  1843. function TChunk.SaveToStream(Stream: TStream): Boolean;
  1844. begin
  1845.   Result := SaveData(Stream)
  1846. end;
  1849. {Loads the chunk from a stream}
  1850. function TChunk.LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
  1851.   Size: Integer): Boolean;
  1852. var
  1853.   CheckCRC: Cardinal;
  1854.   {$IFDEF CheckCRC}RightCRC: Cardinal;{$ENDIF}
  1855. begin
  1856.   {Copies data from source}
  1857.   ResizeData(Size);
  1858.   if Size > 0 then Stream.Read(fData^, Size);
  1859.   {Reads CRC}
  1860.   Stream.Read(CheckCRC, 4);
  1861.   CheckCrc := ByteSwap(CheckCRC);
  1863.   {Check if crc readed is valid}
  1864.   {$IFDEF CheckCRC}
  1865.     RightCRC := update_crc($ffffffff, @ChunkName[0], 4);
  1866.     RightCRC := update_crc(RightCRC, fData, Size) xor $ffffffff;
  1867.     Result := RightCRC = CheckCrc;
  1869.     {Handle CRC error}
  1870.     if not Result then
  1871.     begin
  1872.       {In case it coult not load chunk}
  1873.       Owner.RaiseError(EPngInvalidCRC, EPngInvalidCRCText);
  1874.       exit;
  1875.     end
  1876.   {$ELSE}Result := TRUE; {$ENDIF}
  1878. end;
  1880. {TChunktIME implementation}
  1882. {Chunk being loaded from a stream}
  1883. function TChunktIME.LoadFromStream(Stream: TStream;
  1884.   const ChunkName: TChunkName; Size: Integer): Boolean;
  1885. begin
  1886.   {Let ancestor load the data}
  1887.   Result := inherited LoadFromStream(Stream, ChunkName, Size);
  1888.   if not Result or (Size <> 7) then exit; {Size must be 7}
  1890.   {Reads data}
  1891.   fYear := ((pByte(Longint(Data) )^) * 256)+ (pByte(Longint(Data) + 1)^);
  1892.   fMonth := pByte(Longint(Data) + 2)^;
  1893.   fDay := pByte(Longint(Data) + 3)^;
  1894.   fHour := pByte(Longint(Data) + 4)^;
  1895.   fMinute := pByte(Longint(Data) + 5)^;
  1896.   fSecond := pByte(Longint(Data) + 6)^;
  1897. end;
  1899. {Saving the chunk to a stream}
  1900. function TChunktIME.SaveToStream(Stream: TStream): Boolean;
  1901. begin
  1902.   {Update data}
  1903.   ResizeData(7);  {Make sure the size is 7}
  1904.   pWord(Data)^ := Year;
  1905.   pByte(Longint(Data) + 2)^ := Month;
  1906.   pByte(Longint(Data) + 3)^ := Day;
  1907.   pByte(Longint(Data) + 4)^ := Hour;
  1908.   pByte(Longint(Data) + 5)^ := Minute;
  1909.   pByte(Longint(Data) + 6)^ := Second;
  1911.   {Let inherited save data}
  1912.   Result := inherited SaveToStream(Stream);
  1913. end;
  1915. {TChunkztXt implementation}
  1917. {Loading the chunk from a stream}
  1918. function TChunkzTXt.LoadFromStream(Stream: TStream;
  1919.   const ChunkName: TChunkName; Size: Integer): Boolean;
  1920. var
  1921.   ErrorOutput: String;
  1922.   CompressionMethod: Byte;
  1923.   Output: Pointer;
  1924.   OutputSize: Integer;
  1925. begin
  1926.   {Load data from stream and validate}
  1927.   Result := inherited LoadFromStream(Stream, ChunkName, Size);
  1928.   if not Result or (Size < 4) then exit;
  1929.   fKeyword := PChar(Data);  {Get keyword and compression method bellow}
  1930.   CompressionMethod := pByte(Longint(fKeyword) + Length(fKeyword))^;
  1931.   fText := '';
  1933.   {In case the compression is 0 (only one accepted by specs), reads it}
  1934.   if CompressionMethod = 0 then
  1935.   begin
  1936.     Output := nil;
  1937.     if DecompressZLIB(PChar(Longint(Data) + Length(fKeyword) + 2),
  1938.       Size - Length(fKeyword) - 2, Output, OutputSize, ErrorOutput) then
  1939.     begin
  1940.       SetLength(fText, OutputSize);
  1941.       CopyMemory(@fText[1], Output, OutputSize);
  1942.     end {if DecompressZLIB(...};
  1943.     FreeMem(Output);
  1944.   end {if CompressionMethod = 0}
  1946. end;
  1948. {Saving the chunk to a stream}
  1949. function TChunkztXt.SaveToStream(Stream: TStream): Boolean;
  1950. var
  1951.   Output: Pointer;
  1952.   OutputSize: Integer;
  1953.   ErrorOutput: String;
  1954. begin
  1955.   Output := nil; {Initializes output}
  1956.   if fText = '' then fText := ' ';
  1958.   {Compresses the data}
  1959.   if CompressZLIB(@fText[1], Length(fText), Owner.CompressionLevel, Output,
  1960.     OutputSize, ErrorOutput) then
  1961.   begin
  1962.     {Size is length from keyword, plus a null character to divide}
  1963.     {plus the compression method, plus the length of the text (zlib compressed)}
  1964.     ResizeData(Length(fKeyword) + 2 + OutputSize);
  1966.     Fillchar(Data^, DataSize, #0);
  1967.     {Copies the keyword data}
  1968.     if Keyword <> '' then
  1969.       CopyMemory(Data, @fKeyword[1], Length(Keyword));
  1970.     {Compression method 0 (inflate/deflate)}
  1971.     pByte(Ptr(Longint(Data) + Length(Keyword) + 1))^ := 0;
  1972.     if OutputSize > 0 then
  1973.       CopyMemory(Ptr(Longint(Data) + Length(Keyword) + 2), Output, OutputSize);
  1975.     {Let ancestor calculate crc and save}
  1976.     Result := SaveData(Stream);
  1977.   end {if CompressZLIB(...} else Result := False;
  1979.   {Frees output}
  1980.   if Output <> nil then FreeMem(Output)
  1981. end;
  1983. {TChunktEXt implementation}
  1985. {Assigns from another text chunk}
  1986. procedure TChunktEXt.Assign(Source: TChunk);
  1987. begin
  1988.   fKeyword := TChunktEXt(Source).fKeyword;
  1989.   fText := TChunktEXt(Source).fText;
  1990. end;
  1992. {Loading the chunk from a stream}
  1993. function TChunktEXt.LoadFromStream(Stream: TStream;
  1994.   const ChunkName: TChunkName; Size: Integer): Boolean;
  1995. begin
  1996.   {Load data from stream and validate}
  1997.   Result := inherited LoadFromStream(Stream, ChunkName, Size);
  1998.   if not Result or (Size < 3) then exit;
  1999.   {Get text}
  2000.   fKeyword := PChar(Data);
  2001.   SetLength(fText, Size - Length(fKeyword) - 1);
  2002.   CopyMemory(@fText[1], Ptr(Longint(Data) + Length(fKeyword) + 1),
  2003.     Length(fText));
  2004. end;
  2006. {Saving the chunk to a stream}
  2007. function TChunktEXt.SaveToStream(Stream: TStream): Boolean;
  2008. begin
  2009.   {Size is length from keyword, plus a null character to divide}
  2010.   {plus the length of the text}
  2011.   ResizeData(Length(fKeyword) + 1 + Length(fText));
  2012.   Fillchar(Data^, DataSize, #0);
  2013.   {Copy data}
  2014.   if Keyword <> '' then
  2015.     CopyMemory(Data, @fKeyword[1], Length(Keyword));
  2016.   if Text <> '' then
  2017.     CopyMemory(Ptr(Longint(Data) + Length(Keyword) + 1), @fText[1],
  2018.       Length(Text));
  2019.   {Let ancestor calculate crc and save}
  2020.   Result := inherited SaveToStream(Stream);
  2021. end;
  2024. {TChunkIHDR implementation}
  2026. {Chunk being created}
  2027. constructor TChunkIHDR.Create(Owner: TPngObject);
  2028. begin
  2029.   {Call inherited}
  2030.   inherited Create(Owner);
  2031.   {Prepare pointers}
  2032.   ImageHandle := 0;
  2033.   ImageDC := 0;
  2034. end;
  2036. {Chunk being destroyed}
  2037. destructor TChunkIHDR.Destroy;
  2038. begin
  2039.   {Free memory}
  2040.   FreeImageData();
  2042.   {Calls TChunk destroy}
  2043.   inherited Destroy;
  2044. end;
  2046. {Assigns from another IHDR chunk}
  2047. procedure TChunkIHDR.Assign(Source: TChunk);
  2048. begin
  2049.   {Copy the IHDR data}
  2050.   if Source is TChunkIHDR then
  2051.   begin
  2052.     {Copy IHDR values}
  2053.     IHDRData := TChunkIHDR(Source).IHDRData;
  2055.     {Prepare to hold data by filling BitmapInfo structure and}
  2056.     {resizing ImageData and ImageAlpha memory allocations}
  2057.     PrepareImageData();
  2059.     {Copy image data}
  2060.     CopyMemory(ImageData, TChunkIHDR(Source).ImageData,
  2061.       BytesPerRow * Integer(Height));
  2062.     CopyMemory(ImageAlpha, TChunkIHDR(Source).ImageAlpha,
  2063.       Integer(Width) * Integer(Height));
  2065.     {Copy palette colors}
  2066.     BitmapInfo.bmiColors := TChunkIHDR(Source).BitmapInfo.bmiColors;
  2067.   end
  2068.   else
  2069.     Owner.RaiseError(EPNGError, EPNGCannotAssignChunkText);
  2070. end;
  2072. {Release allocated image data}
  2073. procedure TChunkIHDR.FreeImageData;
  2074. begin
  2075.   {Free old image data}
  2076.   if ImageHandle <> 0  then DeleteObject(ImageHandle);
  2077.   if ImageDC     <> 0  then DeleteDC(ImageDC);
  2078.   if ImageAlpha <> nil then FreeMem(ImageAlpha);
  2079.   {$IFDEF Store16bits}
  2080.   if ExtraImageData <> nil then FreeMem(ExtraImageData);
  2081.   {$ENDIF}
  2082.   ImageHandle := 0; ImageDC := 0; ImageAlpha := nil; ImageData := nil;
  2083. end;
  2085. {Chunk being loaded from a stream}
  2086. function TChunkIHDR.LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
  2087.   Size: Integer): Boolean;
  2088. begin
  2089.   {Let TChunk load it}
  2090.   Result := inherited LoadFromStream(Stream, ChunkName, Size);
  2091.   if not Result then Exit;
  2093.   {Now check values}
  2094.   {Note: It's recommended by png specification to make sure that the size}
  2095.   {must be 13 bytes to be valid, but some images with 14 bytes were found}
  2096.   {which could be loaded by internet explorer and other tools}
  2097.   if (fDataSize < SIZEOF(TIHdrData)) then
  2098.   begin
  2099.     {Ihdr must always have at least 13 bytes}
  2100.     Result := False;
  2101.     Owner.RaiseError(EPNGInvalidIHDR, EPNGInvalidIHDRText);
  2102.     exit;
  2103.   end;
  2105.   {Everything ok, reads IHDR}
  2106.   IHDRData := pIHDRData(fData)^;
  2107.   IHDRData.Width := ByteSwap(IHDRData.Width);
  2108.   IHDRData.Height := ByteSwap(IHDRData.Height);
  2110.   {The width and height must not be larger than 65535 pixels}
  2111.   if (IHDRData.Width > High(Word)) or (IHDRData.Height > High(Word)) then
  2112.   begin
  2113.     Result := False;
  2114.     Owner.RaiseError(EPNGSizeExceeds, EPNGSizeExceedsText);
  2115.     exit;
  2116.   end {if IHDRData.Width > High(Word)};
  2117.   {Compression method must be 0 (inflate/deflate)}
  2118.   if (IHDRData.CompressionMethod <> 0) then
  2119.   begin
  2120.     Result := False;
  2121.     Owner.RaiseError(EPNGUnknownCompression, EPNGUnknownCompressionText);
  2122.     exit;
  2123.   end;
  2124.   {Interlace must be either 0 (none) or 7 (adam7)}
  2125.   if (IHDRData.InterlaceMethod <> 0) and (IHDRData.InterlaceMethod <> 1) then
  2126.   begin
  2127.     Result := False;
  2128.     Owner.RaiseError(EPNGUnknownInterlace, EPNGUnknownInterlaceText);
  2129.     exit;
  2130.   end;
  2132.   {Updates owner properties}
  2133.   Owner.InterlaceMethod := TInterlaceMethod(IHDRData.InterlaceMethod);
  2135.   {Prepares data to hold image}
  2136.   PrepareImageData();
  2137. end;
  2139. {Saving the IHDR chunk to a stream}
  2140. function TChunkIHDR.SaveToStream(Stream: TStream): Boolean;
  2141. begin
  2142.   {Ignore 2 bits images}
  2143.   if BitDepth = 2 then BitDepth := 4;
  2145.   {It needs to do is update the data with the IHDR data}
  2146.   {structure containing the write values}
  2147.   ResizeData(SizeOf(TIHDRData));
  2148.   pIHDRData(fData)^ := IHDRData;
  2149.   {..byteswap 4 byte types}
  2150.   pIHDRData(fData)^.Width := ByteSwap(pIHDRData(fData)^.Width);
  2151.   pIHDRData(fData)^.Height := ByteSwap(pIHDRData(fData)^.Height);
  2152.   {..update interlace method}
  2153.   pIHDRData(fData)^.InterlaceMethod := Byte(Owner.InterlaceMethod);
  2154.   {..and then let the ancestor SaveToStream do the hard work}
  2155.   Result := inherited SaveToStream(Stream);
  2156. end;
  2158. {Resizes the image data to fill the color type, bit depth, }
  2159. {width and height parameters}
  2160. procedure TChunkIHDR.PrepareImageData();
  2162.   {Set the bitmap info}
  2163.   procedure SetInfo(const Bitdepth: Integer; const Palette: Boolean);
  2164.   begin
  2166.     {Copy if the bitmap contain palette entries}
  2167.     HasPalette := Palette;
  2168.     {Initialize the structure with zeros}
  2169.     fillchar(BitmapInfo, sizeof(BitmapInfo), #0);
  2170.     {Fill the strucutre}
  2171.     with BitmapInfo.bmiHeader do
  2172.     begin
  2173.       biSize := sizeof(TBitmapInfoHeader);
  2174.       biHeight := Height;
  2175.       biWidth := Width;
  2176.       biPlanes := 1;
  2177.       biBitCount := BitDepth;
  2178.       biCompression := BI_RGB;
  2179.     end {with BitmapInfo.bmiHeader}
  2180.   end;
  2181. begin
  2182.   {Prepare bitmap info header}
  2183.   Fillchar(BitmapInfo, sizeof(TMaxBitmapInfo), #0);
  2184.   {Release old image data}
  2185.   FreeImageData();
  2187.   {Obtain number of bits for each pixel}
  2188.   case ColorType of
  2189.     COLOR_GRAYSCALE, COLOR_PALETTE, COLOR_GRAYSCALEALPHA:
  2190.       case BitDepth of
  2191.         {These are supported by windows}
  2192.         1, 4, 8: SetInfo(BitDepth, TRUE);
  2193.         {2 bits for each pixel is not supported by windows bitmap}
  2194.         2      : SetInfo(4, TRUE);
  2195.         {Also 16 bits (2 bytes) for each pixel is not supported}
  2196.         {and should be transormed into a 8 bit grayscale}
  2197.         16     : SetInfo(8, TRUE);
  2198.       end;
  2199.     {Only 1 byte (8 bits) is supported}
  2200.     COLOR_RGB, COLOR_RGBALPHA:  SetInfo(24, FALSE);
  2201.   end {case ColorType};
  2202.   {Number of bytes for each scanline}
  2203.   BytesPerRow := (((BitmapInfo.bmiHeader.biBitCount * Width) + 31)
  2204.     and not 31) div 8;
  2206.   {Build array for alpha information, if necessary}
  2207.   if (ColorType = COLOR_RGBALPHA) or (ColorType = COLOR_GRAYSCALEALPHA) then
  2208.   begin
  2209.     GetMem(ImageAlpha, Integer(Width) * Integer(Height));
  2210.     FillChar(ImageAlpha^, Integer(Width) * Integer(Height), #0);
  2211.   end;
  2213.   {Build array for extra byte information}
  2214.   {$IFDEF Store16bits}
  2215.   if (BitDepth = 16) then
  2216.   begin
  2217.     GetMem(ExtraImageData, BytesPerRow * Integer(Height));
  2218.     FillChar(ExtraImageData^, BytesPerRow * Integer(Height), #0);
  2219.   end;
  2220.   {$ENDIF}
  2222.   {Creates the image to hold the data, CreateDIBSection does a better}
  2223.   {work in allocating necessary memory}
  2224.   ImageDC := CreateCompatibleDC(0);
  2225.   ImageHandle := CreateDIBSection(ImageDC, pBitmapInfo(@BitmapInfo)^,
  2226.     DIB_RGB_COLORS, ImageData, 0, 0);
  2228.   {Clears the old palette (if any)}
  2229.   with Owner do
  2230.     if  TempPalette <> 0 then
  2231.     begin
  2232.       DeleteObject(TempPalette);
  2233.       TempPalette := 0;
  2234.     end {with Owner, if TempPalette <> 0};
  2236.   {Build array and allocate bytes for each row}
  2237.   zeromemory(ImageData, BytesPerRow * Integer(Height));
  2238. end;
  2240. {TChunktRNS implementation}
  2242. {$IFNDEF UseDelphi}
  2243. function CompareMem(P1, P2: pByte; const Size: Integer): Boolean;
  2244. var i: Integer;
  2245. begin
  2246.   Result := True;
  2247.   for i := 1 to Size do
  2248.   begin
  2249.     if P1^ <> P2^ then Result := False;
  2250.     inc(P1); inc(P2);
  2251.   end {for i}
  2252. end;
  2253. {$ENDIF}
  2255. {Sets the transpararent color}
  2256. procedure TChunktRNS.SetTransparentColor(const Value: ColorRef);
  2257. var
  2258.   i: Byte;
  2259.   LookColor: TRGBQuad;
  2260. begin
  2261.   {Clears the palette values}
  2262.   Fillchar(PaletteValues, SizeOf(PaletteValues), #0);
  2263.   {Sets that it uses bit transparency}
  2264.   fBitTransparency := True;
  2267.   {Depends on the color type}
  2268.   with Header do
  2269.     case ColorType of
  2270.       COLOR_GRAYSCALE:
  2271.       begin
  2272.         Self.ResizeData(2);
  2273.         pWord(@PaletteValues[0])^ := ByteSwap16(GetRValue(Value));
  2274.       end;
  2275.       COLOR_RGB:
  2276.       begin
  2277.         Self.ResizeData(6);
  2278.         pWord(@PaletteValues[0])^ := ByteSwap16(GetRValue(Value));
  2279.         pWord(@PaletteValues[2])^ := ByteSwap16(GetGValue(Value));
  2280.         pWord(@PaletteValues[4])^ := ByteSwap16(GetBValue(Value));
  2281.       end;
  2282.       COLOR_PALETTE:
  2283.       begin
  2284.         {Creates a RGBQuad to search for the color}
  2285.         LookColor.rgbRed := GetRValue(Value);
  2286.         LookColor.rgbGreen := GetGValue(Value);
  2287.         LookColor.rgbBlue := GetBValue(Value);
  2288.         {Look in the table for the entry}
  2289.         for i := 0 to 255 do
  2290.           if CompareMem(@BitmapInfo.bmiColors[i], @LookColor, 3) then
  2291.             Break;
  2292.         {Fill the transparency table}
  2293.         Fillchar(PaletteValues, i, 255);
  2294.         Self.ResizeData(i + 1)
  2296.       end
  2297.     end {case / with};
  2299. end;
  2301. {Returns the transparent color for the image}
  2302. function TChunktRNS.GetTransparentColor: ColorRef;
  2303. var
  2304.   PaletteChunk: TChunkPLTE;
  2305.   i: Integer;
  2306. begin
  2307.   Result := 0; {Default: Unknown transparent color}
  2309.   {Depends on the color type}
  2310.   with Header do
  2311.     case ColorType of
  2312.       COLOR_GRAYSCALE:
  2313.           Result := RGB(PaletteValues[0], PaletteValues[0],
  2314.         PaletteValues[0]);
  2315.       COLOR_RGB:
  2316.           Result := RGB(PaletteValues[1], PaletteValues[3], PaletteValues[5]);
  2317.       COLOR_PALETTE:
  2318.       begin
  2319.         {Obtains the palette chunk}
  2320.         PaletteChunk := Owner.Chunks.ItemFromClass(TChunkPLTE) as TChunkPLTE;
  2322.         {Looks for an entry with 0 transparency meaning that it is the}
  2323.         {full transparent entry}
  2324.         for i := 0 to Self.DataSize - 1 do
  2325.           if PaletteValues[i] = 0 then
  2326.             with PaletteChunk.GetPaletteItem(i) do
  2327.             begin
  2328.               Result := RGB(rgbRed, rgbGreen, rgbBlue);
  2329.               break
  2330.             end
  2331.       end {COLOR_PALETTE}
  2332.     end {case Header.ColorType};
  2333. end;
  2335. {Saving the chunk to a stream}
  2336. function TChunktRNS.SaveToStream(Stream: TStream): Boolean;
  2337. begin
  2338.   {Copy palette into data buffer}
  2339.   if DataSize <= 256 then
  2340.     CopyMemory(fData, @PaletteValues[0], DataSize);
  2342.   Result := inherited SaveToStream(Stream);
  2343. end;
  2345. {Assigns from another chunk}
  2346. procedure TChunktRNS.Assign(Source: TChunk);
  2347. begin
  2348.   CopyMemory(@PaletteValues[0], @TChunkTrns(Source).PaletteValues[0], 256);
  2349.   fBitTransparency := TChunkTrns(Source).fBitTransparency;
  2350.   inherited Assign(Source);
  2351. end;
  2353. {Loads the chunk from a stream}
  2354. function TChunktRNS.LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
  2355.   Size: Integer): Boolean;
  2356. var
  2357.   i, Differ255: Integer;
  2358. begin
  2359.   {Let inherited load}
  2360.   Result := inherited LoadFromStream(Stream, ChunkName, Size);
  2362.   if not Result then Exit;
  2364.   {Make sure size is correct}
  2365.   if Size > 256 then Owner.RaiseError(EPNGInvalidPalette,
  2366.     EPNGInvalidPaletteText);
  2368.   {The unset items should have value 255}
  2369.   Fillchar(PaletteValues[0], 256, 255);
  2370.   {Copy the other values}
  2371.   CopyMemory(@PaletteValues[0], fData, Size);
  2373.   {Create the mask if needed}
  2374.   case Header.ColorType of
  2375.     {Mask for grayscale and RGB}
  2376.     COLOR_RGB, COLOR_GRAYSCALE: fBitTransparency := True;
  2377.     COLOR_PALETTE:
  2378.     begin
  2379.       Differ255 := 0; {Count the entries with a value different from 255}
  2380.       {Tests if it uses bit transparency}
  2381.       for i := 0 to Size - 1 do
  2382.         if PaletteValues[i] <> 255 then inc(Differ255);
  2384.       {If it has one value different from 255 it is a bit transparency}
  2385.       fBitTransparency := (Differ255 = 1);
  2386.     end {COLOR_PALETTE}
  2387.   end {case Header.ColorType};
  2389. end;
  2391. {Prepares the image palette}
  2392. procedure TChunkIDAT.PreparePalette;
  2393. var
  2394.   Entries: Word;
  2395.   j      : Integer;
  2396. begin
  2397.   {In case the image uses grayscale, build a grayscale palette}
  2398.   with Header do
  2399.     if (ColorType = COLOR_GRAYSCALE) or (ColorType = COLOR_GRAYSCALEALPHA) then
  2400.     begin
  2401.       {Calculate total number of palette entries}
  2402.       Entries := (1 shl Byte(BitmapInfo.bmiHeader.biBitCount));
  2404.       FOR j := 0 TO Entries - 1 DO
  2405.         with BitmapInfo.bmiColors[j] do
  2406.         begin
  2408.           {Calculate each palette entry}
  2409.           rgbRed := fOwner.GammaTable[MulDiv(j, 255, Entries - 1)];
  2410.           rgbGreen := rgbRed;
  2411.           rgbBlue := rgbRed;
  2412.         end {with BitmapInfo.bmiColors[j]}
  2413.     end {if ColorType = COLOR_GRAYSCALE..., with Header}
  2414. end;
  2416. {Reads from ZLIB}
  2417. function TChunkIDAT.IDATZlibRead(var ZLIBStream: TZStreamRec2;
  2418.   Buffer: Pointer; Count: Integer; var EndPos: Integer;
  2419.   var crcfile: Cardinal): Integer;
  2420. var
  2421.   ProcResult : Integer;
  2422.   IDATHeader : Array[0..3] of char;
  2423.   IDATCRC    : Cardinal;
  2424. begin
  2425.   {Uses internal record pointed by ZLIBStream to gather information}
  2426.   with ZLIBStream, ZLIBStream.zlib do
  2427.   begin
  2428.     {Set the buffer the zlib will read into}
  2429.     next_out := Buffer;
  2430.     avail_out := Count;
  2432.     {Decode until it reach the Count variable}
  2433.     while avail_out > 0 do
  2434.     begin
  2435.       {In case it needs more data and it's in the end of a IDAT chunk,}
  2436.       {it means that there are more IDAT chunks}
  2437.       if (fStream.Position = EndPos) and (avail_out > 0) and
  2438.         (avail_in = 0) then
  2439.       begin
  2440.         {End this chunk by reading and testing the crc value}
  2441.         fStream.Read(IDATCRC, 4);
  2443.         {$IFDEF CheckCRC}
  2444.           if crcfile xor $ffffffff <> Cardinal(ByteSwap(IDATCRC)) then
  2445.           begin
  2446.             Result := -1;
  2447.             Owner.RaiseError(EPNGInvalidCRC, EPNGInvalidCRCText);
  2448.             exit;
  2449.           end;
  2450.         {$ENDIF}
  2452.         {Start reading the next chunk}
  2453.         fStream.Read(EndPos, 4);        {Reads next chunk size}
  2454.         fStream.Read(IDATHeader[0], 4); {Next chunk header}
  2455.         {It must be a IDAT chunk since image data is required and PNG}
  2456.         {specification says that multiple IDAT chunks must be consecutive}
  2457.         if IDATHeader <> 'IDAT' then
  2458.         begin
  2459.           Owner.RaiseError(EPNGMissingMultipleIDAT, EPNGMissingMultipleIDATText);
  2460.           result := -1;
  2461.           exit;
  2462.         end;
  2464.         {Calculate chunk name part of the crc}
  2465.         {$IFDEF CheckCRC}
  2466.           crcfile := update_crc($ffffffff, @IDATHeader[0], 4);
  2467.         {$ENDIF}
  2468.         EndPos := fStream.Position + ByteSwap(EndPos);
  2469.       end;
  2472.       {In case it needs compressed data to read from}
  2473.       if avail_in = 0 then
  2474.       begin
  2475.         {In case it's trying to read more than it is avaliable}
  2476.         if fStream.Position + ZLIBAllocate > EndPos then
  2477.           avail_in := fStream.Read(Data^, EndPos - fStream.Position)
  2478.          else
  2479.           avail_in := fStream.Read(Data^, ZLIBAllocate);
  2480.         {Update crc}
  2481.         {$IFDEF CheckCRC}
  2482.           crcfile := update_crc(crcfile, Data, avail_in);
  2483.         {$ENDIF}
  2485.         {In case there is no more compressed data to read from}
  2486.         if avail_in = 0 then
  2487.         begin
  2488.           Result := Count - avail_out;
  2489.           Exit;
  2490.         end;
  2492.         {Set next buffer to read and record current position}
  2493.         next_in := Data;
  2495.       end {if avail_in = 0};
  2497.       ProcResult := inflate(zlib, 0);
  2499.       {In case the result was not sucessfull}
  2500.       if (ProcResult < 0) then
  2501.       begin
  2502.         Result := -1;
  2503.         Owner.RaiseError(EPNGZLIBError,
  2504.           EPNGZLIBErrorText + zliberrors[procresult]);
  2505.         exit;
  2506.       end;
  2508.     end {while avail_out > 0};
  2510.   end {with};
  2512.   {If everything gone ok, it returns the count bytes}
  2513.   Result := Count;
  2514. end;
  2516. {TChunkIDAT implementation}
  2518. const
  2519.   {Adam 7 interlacing values}
  2520.   RowStart: array[0..6] of Integer = (0, 0, 4, 0, 2, 0, 1);
  2521.   ColumnStart: array[0..6] of Integer = (0, 4, 0, 2, 0, 1, 0);
  2522.   RowIncrement: array[0..6] of Integer = (8, 8, 8, 4, 4, 2, 2);
  2523.   ColumnIncrement: array[0..6] of Integer = (8, 8, 4, 4, 2, 2, 1);
  2525. {Copy interlaced images with 1 byte for R, G, B}
  2526. procedure TChunkIDAT.CopyInterlacedRGB8(const Pass: Byte;
  2527.   Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  2528. var
  2529.   Col: Integer;
  2530. begin
  2531.   {Get first column and enter in loop}
  2532.   Col := ColumnStart[Pass];
  2533.   Dest := pChar(Longint(Dest) + Col * 3);
  2534.   repeat
  2535.     {Copy this row}
  2536.     Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
  2537.     Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Dest);
  2538.     Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src)    )^]; inc(Dest);
  2540.     {Move to next column}
  2541.     inc(Src, 3);
  2542.     inc(Dest, ColumnIncrement[Pass] * 3 - 3);
  2543.     inc(Col, ColumnIncrement[Pass]);
  2544.   until Col >= ImageWidth;
  2545. end;
  2547. {Copy interlaced images with 2 bytes for R, G, B}
  2548. procedure TChunkIDAT.CopyInterlacedRGB16(const Pass: Byte;
  2549.   Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  2550. var
  2551.   Col: Integer;
  2552. begin
  2553.   {Get first column and enter in loop}
  2554.   Col := ColumnStart[Pass];
  2555.   Dest := pChar(Longint(Dest) + Col * 3);
  2556.   repeat
  2557.     {Copy this row}
  2558.     Byte(Dest^) := Owner.GammaTable[pByte(Longint(Src) + 4)^]; inc(Dest);
  2559.     Byte(Dest^) := Owner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
  2560.     Byte(Dest^) := Owner.GammaTable[pByte(Longint(Src)    )^]; inc(Dest);
  2561.     {$IFDEF Store16bits}
  2562.     {Copy extra pixel values}
  2563.     Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 5)^]; inc(Extra);
  2564.     Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 3)^]; inc(Extra);
  2565.     Byte(Extra^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Extra);
  2566.     {$ENDIF}
  2568.     {Move to next column}
  2569.     inc(Src, 6);
  2570.     inc(Dest, ColumnIncrement[Pass] * 3 - 3);
  2571.     inc(Col, ColumnIncrement[Pass]);
  2572.   until Col >= ImageWidth;
  2573. end;
  2575. {Copy 韒ages with palette using bit depths 1, 4 or 8}
  2576. procedure TChunkIDAT.CopyInterlacedPalette148(const Pass: Byte;
  2577.   Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  2578. const
  2579.   BitTable: Array[1..8] of Integer = ($1, $3, 0, $F, 0, 0, 0, $FF);
  2580.   StartBit: Array[1..8] of Integer = (7 , 0 , 0, 4,  0, 0, 0, 0);
  2581. var
  2582.   CurBit, Col: Integer;
  2583.   Dest2: PChar;
  2584. begin
  2585.   {Get first column and enter in loop}
  2586.   Col := ColumnStart[Pass];
  2587.   repeat
  2588.     {Copy data}
  2589.     CurBit := StartBit[Header.BitDepth];
  2590.     repeat
  2591.       {Adjust pointer to pixel byte bounds}
  2592.       Dest2 := pChar(Longint(Dest) + (Header.BitDepth * Col) div 8);
  2593.       {Copy data}
  2594.       Byte(Dest2^) := Byte(Dest2^) or
  2595.         ( ((Byte(Src^) shr CurBit) and BitTable[Header.BitDepth])
  2596.           shl (StartBit[Header.BitDepth] - (Col * Header.BitDepth mod 8)));
  2598.       {Move to next column}
  2599.       inc(Col, ColumnIncrement[Pass]);
  2600.       {Will read next bits}
  2601.       dec(CurBit, Header.BitDepth);
  2602.     until CurBit < 0;
  2604.     {Move to next byte in source}
  2605.     inc(Src);
  2606.   until Col >= ImageWidth;
  2607. end;
  2609. {Copy 韒ages with palette using bit depth 2}
  2610. procedure TChunkIDAT.CopyInterlacedPalette2(const Pass: Byte; Src, Dest,
  2611.   Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  2612. var
  2613.   CurBit, Col: Integer;
  2614.   Dest2: PChar;
  2615. begin
  2616.   {Get first column and enter in loop}
  2617.   Col := ColumnStart[Pass];
  2618.   repeat
  2619.     {Copy data}
  2620.     CurBit := 6;
  2621.     repeat
  2622.       {Adjust pointer to pixel byte bounds}
  2623.       Dest2 := pChar(Longint(Dest) + Col div 2);
  2624.       {Copy data}
  2625.       Byte(Dest2^) := Byte(Dest2^) or (((Byte(Src^) shr CurBit) and $3)
  2626.          shl (4 - (4 * Col) mod 8));
  2627.       {Move to next column}
  2628.       inc(Col, ColumnIncrement[Pass]);
  2629.       {Will read next bits}
  2630.       dec(CurBit, 2);
  2631.     until CurBit < 0;
  2633.     {Move to next byte in source}
  2634.     inc(Src);
  2635.   until Col >= ImageWidth;
  2636. end;
  2638. {Copy 韒ages with grayscale using bit depth 2}
  2639. procedure TChunkIDAT.CopyInterlacedGray2(const Pass: Byte;
  2640.   Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  2641. var
  2642.   CurBit, Col: Integer;
  2643.   Dest2: PChar;
  2644. begin
  2645.   {Get first column and enter in loop}
  2646.   Col := ColumnStart[Pass];
  2647.   repeat
  2648.     {Copy data}
  2649.     CurBit := 6;
  2650.     repeat
  2651.       {Adjust pointer to pixel byte bounds}