pngimage.pas

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

      Size: Integer;
      Memory: Pointer;
      Position: Integer;
    protected
      {Set the size of the file}
      procedure SetSize(const Value: Longint); override;
    public
      {Stream processing}
      function Read(var Buffer; Count: Integer): Cardinal; override;
      function Seek(Offset: Integer; Origin: Word): Longint; override;
      function Write(const Buffer; Count: Longint): Cardinal; override;
    end;
  {$ENDIF}

  {Forward}
  TChunkIHDR = class;
  TChunkpHYs = class;
  {Interlace method}
  TInterlaceMethod = (imNone, imAdam7);
  {Compression level type}
  TCompressionLevel = 0..9;
  {Filters type}
  TFilter = (pfNone, pfSub, pfUp, pfAverage, pfPaeth);
  TFilters = set of TFilter;

  {Png implementation object}
  TPngObject = class{$IFDEF UseDelphi}(TGraphic){$ENDIF}
  protected
    {Inverse gamma table values}
    InverseGamma: Array[Byte] of Byte;
    procedure InitializeGamma;
  private
    {Canvas}
    {$IFDEF UseDelphi}fCanvas: TCanvas;{$ENDIF}
    {Filters to test to encode}
    fFilters: TFilters;
    {Compression level for ZLIB}
    fCompressionLevel: TCompressionLevel;
    {Maximum size for IDAT chunks}
    fMaxIdatSize: Integer;
    {Returns if image is interlaced}
    fInterlaceMethod: TInterlaceMethod;
    {Chunks object}
    fChunkList: TPngList;
    {Clear all chunks in the list}
    procedure ClearChunks;
    {Returns if header is present}
    function HeaderPresent: Boolean;
    procedure GetPixelInfo(var LineSize, Offset: Cardinal);
    {Returns linesize and byte offset for pixels}
    procedure SetMaxIdatSize(const Value: Integer);
    function GetAlphaScanline(const LineIndex: Integer): pByteArray;
    function GetScanline(const LineIndex: Integer): Pointer;
    {$IFDEF Store16bits}
    function GetExtraScanline(const LineIndex: Integer): Pointer;
    {$ENDIF}
    function GetPixelInformation: TChunkpHYs;
    function GetTransparencyMode: TPNGTransparencyMode;
    function GetTransparentColor: TColor;
    procedure SetTransparentColor(const Value: TColor);
    {Returns the version}
    function GetLibraryVersion: String;
  protected
    {Being created}
    BeingCreated: Boolean;
    {Returns / set the image palette}
    function GetPalette: HPALETTE; {$IFDEF UseDelphi}override;{$ENDIF}
    procedure SetPalette(Value: HPALETTE); {$IFDEF UseDelphi}override;{$ENDIF}
    {Returns/sets image width and height}
    function GetWidth: Integer; {$IFDEF UseDelphi}override;{$ENDIF}
    function GetHeight: Integer; {$IFDEF UseDelphi}override; {$ENDIF}
    procedure SetWidth(Value: Integer);  {$IFDEF UseDelphi}override; {$ENDIF}
    procedure SetHeight(Value: Integer);  {$IFDEF UseDelphi}override;{$ENDIF}
    {Assigns from another TPNGObject}
    procedure AssignPNG(Source: TPNGObject);
    {Returns if the image is empty}
    function GetEmpty: Boolean; {$IFDEF UseDelphi}override; {$ENDIF}
    {Used with property Header}
    function GetHeader: TChunkIHDR;
    {Draws using partial transparency}
    procedure DrawPartialTrans(DC: HDC; Rect: TRect);
    {$IFDEF UseDelphi}
    {Returns if the image is transparent}
    function GetTransparent: Boolean; override;
    {$ENDIF}
    {Returns a pixel}
    function GetPixels(const X, Y: Integer): TColor; virtual;
    procedure SetPixels(const X, Y: Integer; const Value: TColor); virtual;
  public
    {Gamma table array}
    GammaTable: Array[Byte] of Byte;
    {Resizes the PNG image}
    procedure Resize(const CX, CY: Integer);
    {Generates alpha information}
    procedure CreateAlpha;
    {Removes the image transparency}
    procedure RemoveTransparency;
    {Transparent color}
    property TransparentColor: TColor read GetTransparentColor write
      SetTransparentColor;
    {Add text chunk, TChunkTEXT, TChunkzTXT}
    procedure AddtEXt(const Keyword, Text: String);
    procedure AddzTXt(const Keyword, Text: String);
    {$IFDEF UseDelphi}
    {Saves to clipboard format (thanks to Antoine Pottern)}
    procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
      var APalette: HPalette); override;
    procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
      APalette: HPalette); override;
    {$ENDIF}
    {Calling errors}
    procedure RaiseError(ExceptionClass: ExceptClass; Text: String);
    {Returns a scanline from png}
    property Scanline[const Index: Integer]: Pointer read GetScanline;
    {$IFDEF Store16bits}
    property ExtraScanline[const Index: Integer]: Pointer read GetExtraScanline;
    {$ENDIF}
    {Used to return pixel information}
    function HasPixelInformation: Boolean;
    property PixelInformation: TChunkpHYs read GetPixelInformation;
    property AlphaScanline[const Index: Integer]: pByteArray read
      GetAlphaScanline;
    procedure DrawUsingPixelInformation(Canvas: TCanvas; Point: TPoint);

    {Canvas}
    {$IFDEF UseDelphi}property Canvas: TCanvas read fCanvas;{$ENDIF}
    {Returns pointer to the header}
    property Header: TChunkIHDR read GetHeader;
    {Returns the transparency mode used by this png}
    property TransparencyMode: TPNGTransparencyMode read GetTransparencyMode;
    {Assigns from another object}
    procedure Assign(Source: TPersistent);{$IFDEF UseDelphi}override;{$ENDIF}
    {Assigns to another object}
    procedure AssignTo(Dest: TPersistent);{$IFDEF UseDelphi}override;{$ENDIF}
    {Assigns from a windows bitmap handle}
    procedure AssignHandle(Handle: HBitmap; Transparent: Boolean;
      TransparentColor: ColorRef);
    {Draws the image into a canvas}
    procedure Draw(ACanvas: TCanvas; const Rect: TRect);
      {$IFDEF UseDelphi}override;{$ENDIF}
    {Width and height properties}
    property Width: Integer read GetWidth;
    property Height: Integer read GetHeight;
    {Returns if the image is interlaced}
    property InterlaceMethod: TInterlaceMethod read fInterlaceMethod
      write fInterlaceMethod;
    {Filters to test to encode}
    property Filters: TFilters read fFilters write fFilters;
    {Maximum size for IDAT chunks, default and minimum is 65536}
    property MaxIdatSize: Integer read fMaxIdatSize write SetMaxIdatSize;
    {Property to return if the image is empty or not}
    property Empty: Boolean read GetEmpty;
    {Compression level}
    property CompressionLevel: TCompressionLevel read fCompressionLevel
      write fCompressionLevel;
    {Access to the chunk list}
    property Chunks: TPngList read fChunkList;
    {Object being created and destroyed}
    constructor Create; {$IFDEF UseDelphi}override;{$ENDIF}
    constructor CreateBlank(ColorType, Bitdepth: Cardinal; cx, cy: Integer);
    destructor Destroy; override;
    {$IFNDEF UseDelphi}procedure LoadFromFile(const Filename: String);{$ENDIF}
    {$IFNDEF UseDelphi}procedure SaveToFile(const Filename: String);{$ENDIF}
    procedure LoadFromStream(Stream: TStream);
      {$IFDEF UseDelphi}override;{$ENDIF}
    procedure SaveToStream(Stream: TStream); {$IFDEF UseDelphi}override;{$ENDIF}
    {Loading the image from resources}
    procedure LoadFromResourceName(Instance: HInst; const Name: String);
    procedure LoadFromResourceID(Instance: HInst; ResID: Integer);
    {Access to the png pixels}
    property Pixels[const X, Y: Integer]: TColor read GetPixels write SetPixels;
    {Palette property}
    {$IFNDEF UseDelphi}property Palette: HPalette read GetPalette write
      SetPalette;{$ENDIF}
    {Returns the version}
    property Version: String read GetLibraryVersion;
  end;

  {Chunk name object}
  TChunkName = Array[0..3] of Char;

  {Global chunk object}
  TChunk = class
  private
    {Contains data}
    fData: Pointer;
    fDataSize: Cardinal;
    {Stores owner}
    fOwner: TPngObject;
    {Stores the chunk name}
    fName: TChunkName;
    {Returns pointer to the TChunkIHDR}
    function GetHeader: TChunkIHDR;
    {Used with property index}
    function GetIndex: Integer;
    {Should return chunk class/name}
    class function GetName: String; virtual;
    {Returns the chunk name}
    function GetChunkName: String;
  public
    {Returns index from list}
    property Index: Integer read GetIndex;
    {Returns pointer to the TChunkIHDR}
    property Header: TChunkIHDR read GetHeader;
    {Resize the data}
    procedure ResizeData(const NewSize: Cardinal);
    {Returns data and size}
    property Data: Pointer read fData;
    property DataSize: Cardinal read fDataSize;
    {Assigns from another TChunk}
    procedure Assign(Source: TChunk); virtual;
    {Returns owner}
    property Owner: TPngObject read fOwner;
    {Being destroyed/created}
    constructor Create(Owner: TPngObject); virtual;
    destructor Destroy; override;
    {Returns chunk class/name}
    property Name: String read GetChunkName;
    {Loads the chunk from a stream}
    function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
      Size: Integer): Boolean; virtual;
    {Saves the chunk to a stream}
    function SaveData(Stream: TStream): Boolean;
    function SaveToStream(Stream: TStream): Boolean; virtual;
  end;

  {Chunk classes}
  TChunkIEND = class(TChunk);     {End chunk}

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

  {Information header chunk}
  TChunkIHDR = class(TChunk)
  private
    {Current image}
    ImageHandle: HBitmap;
    ImageDC: HDC;
    ImagePalette: HPalette;
    {Output windows bitmap}
    HasPalette: Boolean;
    BitmapInfo: TMaxBitmapInfo;
    {Stores the image bytes}
    {$IFDEF Store16bits}ExtraImageData: Pointer;{$ENDIF}
    ImageData: pointer;
    ImageAlpha: Pointer;

    {Contains all the ihdr data}
    IHDRData: TIHDRData;
  protected
    BytesPerRow: Integer;
    {Creates a grayscale palette}
    function CreateGrayscalePalette(Bitdepth: Integer): HPalette;
    {Copies the palette to the Device Independent bitmap header}
    procedure PaletteToDIB(Palette: HPalette);
    {Resizes the image data to fill the color type, bit depth, }
    {width and height parameters}
    procedure PrepareImageData;
    {Release allocated ImageData memory}
    procedure FreeImageData;
  public
    {Access to ImageHandle}
    property ImageHandleValue: HBitmap read ImageHandle;
    {Properties}
    property Width: Cardinal read IHDRData.Width write IHDRData.Width;
    property Height: Cardinal read IHDRData.Height write IHDRData.Height;
    property BitDepth: Byte read IHDRData.BitDepth write IHDRData.BitDepth;
    property ColorType: Byte read IHDRData.ColorType write IHDRData.ColorType;
    property CompressionMethod: Byte read IHDRData.CompressionMethod
      write IHDRData.CompressionMethod;
    property FilterMethod: Byte read IHDRData.FilterMethod
      write IHDRData.FilterMethod;
    property InterlaceMethod: Byte read IHDRData.InterlaceMethod
      write IHDRData.InterlaceMethod;
    {Loads the chunk from a stream}
    function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
      Size: Integer): Boolean; override;
    {Saves the chunk to a stream}
    function SaveToStream(Stream: TStream): Boolean; override;
    {Destructor/constructor}
    constructor Create(Owner: TPngObject); override;
    destructor Destroy; override;
    {Assigns from another TChunk}
    procedure Assign(Source: TChunk); override;
  end;

  {pHYs chunk}
  pUnitType = ^TUnitType;
  TUnitType = (utUnknown, utMeter);
  TChunkpHYs = class(TChunk)
  private
    fPPUnitX, fPPUnitY: Cardinal;
    fUnit: TUnitType;
  public
    {Returns the properties}
    property PPUnitX: Cardinal read fPPUnitX write fPPUnitX;
    property PPUnitY: Cardinal read fPPUnitY write fPPUnitY;
    property UnitType: TUnitType read fUnit write fUnit;
    {Loads the chunk from a stream}
    function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
      Size: Integer): Boolean; override;
    {Saves the chunk to a stream}
    function SaveToStream(Stream: TStream): Boolean; override;
    {Assigns from another TChunk}
    procedure Assign(Source: TChunk); override;
  end;

  {Gamma chunk}
  TChunkgAMA = class(TChunk)
  private
    {Returns/sets the value for the gamma chunk}
    function GetValue: Cardinal;
    procedure SetValue(const Value: Cardinal);
  public
    {Returns/sets gamma value}
    property Gamma: Cardinal read GetValue write SetValue;
    {Loading the chunk from a stream}
    function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
      Size: Integer): Boolean; override;
    {Being created}
    constructor Create(Owner: TPngObject); override;
    {Assigns from another TChunk}
    procedure Assign(Source: TChunk); override;
  end;

  {ZLIB Decompression extra information}
  TZStreamRec2 = packed record
    {From ZLIB}
    ZLIB: TZStreamRec;
    {Additional info}
    Data: Pointer;
    fStream   : TStream;
  end;

  {Palette chunk}
  TChunkPLTE = class(TChunk)
  protected
    {Number of items in the palette}
    fCount: Integer;
  private
    {Contains the palette handle}
    function GetPaletteItem(Index: Byte): TRGBQuad;
  public
    {Returns the color for each item in the palette}
    property Item[Index: Byte]: TRGBQuad read GetPaletteItem;
    {Returns the number of items in the palette}
    property Count: Integer read fCount;
    {Loads the chunk from a stream}
    function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
      Size: Integer): Boolean; override;
    {Saves the chunk to a stream}
    function SaveToStream(Stream: TStream): Boolean; override;
    {Assigns from another TChunk}
    procedure Assign(Source: TChunk); override;
  end;

  {Transparency information}
  TChunktRNS = class(TChunk)
  private
    fBitTransparency: Boolean;
    function GetTransparentColor: ColorRef;
    {Returns the transparent color}
    procedure SetTransparentColor(const Value: ColorRef);
  public
    {Palette values for transparency}
    PaletteValues: Array[Byte] of Byte;
    {Returns if it uses bit transparency}
    property BitTransparency: Boolean read fBitTransparency;
    {Returns the transparent color}
    property TransparentColor: ColorRef read GetTransparentColor write
      SetTransparentColor;
    {Loads/saves the chunk from/to a stream}
    function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
      Size: Integer): Boolean; override;
    function SaveToStream(Stream: TStream): Boolean; override;
    {Assigns from another TChunk}
    procedure Assign(Source: TChunk); override;
  end;

  {Actual image information}
  TChunkIDAT = class(TChunk)
  private
    {Holds another pointer to the TChunkIHDR}
    Header: TChunkIHDR;
    {Stores temporary image width and height}
    ImageWidth, ImageHeight: Integer;