pngimage.pas

iocopm3.04源码,一套很好的工控开发工具

    {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
    {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}
    property AlphaScanline[const Index: Integer]: pByteArray read GetAlphaScanline;
    {Returns pointer to the header}
    property Header: TChunkIHDR read GetHeader;
    {Returns the transparency mode used by this png}
    property TransparencyMode: TPNGTransparencyMode read GetTransparencyMode;
    {Assigns from another object}
    procedure Assign(Source: TPersistent);{$IFDEF UseDelphi}override;{$ENDIF}
    {Assigns to another object}
    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: Cardinal 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}
    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;{$ENDIF}
  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;

    {Output windows bitmap}
    HasPalette: Boolean;
    BitmapInfo: TMaxBitmapInfo;
    BytesPerRow: Integer;
    {Stores the image bytes}
    {$IFDEF Store16bits}ExtraImageData: Pointer;{$ENDIF}
    ImageData: pointer;
    ImageAlpha: Pointer;

    {Contains all the ihdr data}
    IHDRData: TIHDRData;
  protected
    {Resizes the image data to fill the color type, bit depth, }
    {width and height parameters}
    procedure PrepareImageData;
    {Release allocated ImageData memory}
    procedure FreeImageData;
  public
    {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;

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

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

  {Actual image information}
  TChunkIDAT = class(TChunk)
  private
    {Holds another pointer to the TChunkIHDR}
    Header: TChunkIHDR;
    {Stores temporary image width and height}
    ImageWidth, ImageHeight: Integer;
    {Size in bytes of each line and offset}
    Row_Bytes, Offset : Cardinal;
    {Contains data for the lines}
    Encode_Buffer: Array[0..5] of pByteArray;
    Row_Buffer: Array[Boolean] of pByteArray;
    {Variable to invert the Row_Buffer used}
    RowUsed: Boolean;
    {Ending position for the current IDAT chunk}
    EndPos: Integer;
    {Filter the current line}
    procedure FilterRow;
    {Filter to encode and returns the best filter}
    function FilterToEncode: Byte;
    {Reads ZLIB compressed data}
    function IDATZlibRead(var ZLIBStream: TZStreamRec2; Buffer: Pointer;
      Count: Integer; var EndPos: Integer; var crcfile: Cardinal): Integer;
    {Compress and writes IDAT data}
    procedure IDATZlibWrite(var ZLIBStream: TZStreamRec2; Buffer: Pointer;
      const Length: Cardinal);
    procedure FinishIDATZlib(var ZLIBStream: TZStreamRec2);
    {Prepares the palette}
    procedure PreparePalette;
  protected
    {Decode interlaced image}
    procedure DecodeInterlacedAdam7(Stream: TStream;
      var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: Cardinal);
    {Decode non interlaced imaged}
    procedure DecodeNonInterlaced(Stream: TStream;
      var ZLIBStream: TZStreamRec2; const Size: Integer;
      var crcfile: Cardinal);
  protected
    {Encode non interlaced images}
    procedure EncodeNonInterlaced(Stream: TStream;
      var ZLIBStream: TZStreamRec2);
    {Encode interlaced images}
    procedure EncodeInterlacedAdam7(Stream: TStream;
      var ZLIBStream: TZStreamRec2);
  protected
    {Memory copy methods to decode}
    procedure CopyNonInterlacedRGB8(
      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
    procedure CopyNonInterlacedRGB16(
      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
    procedure CopyNonInterlacedPalette148(
      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
    procedure CopyNonInterlacedPalette2(
      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
    procedure CopyNonInterlacedGray2(
      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
    procedure CopyNonInterlacedGrayscale16(
      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
    procedure CopyNonInterlacedRGBAlpha8(
      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
    procedure CopyNonInterlacedRGBAlpha16(
      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
    procedure CopyNonInterlacedGrayscaleAlpha8(
      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
    procedure CopyNonInterlacedGrayscaleAlpha16(
      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
    procedure CopyInterlacedRGB8(const Pass: Byte;
      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
    procedure CopyInterlacedRGB16(const Pass: Byte;
      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
    procedure CopyInterlacedPalette148(const Pass: Byte;
      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
    procedure CopyInterlacedPalette2(const Pass: Byte;
      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
    procedure CopyInterlacedGray2(const Pass: Byte;
      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
    procedure CopyInterlacedGrayscale16(const Pass: Byte;
      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
    procedure CopyInterlacedRGBAlpha8(const Pass: Byte;
      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
    procedure CopyInterlacedRGBAlpha16(const Pass: Byte;
      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
    procedure CopyInterlacedGrayscaleAlpha8(const Pass: Byte;
      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
    procedure CopyInterlacedGrayscaleAlpha16(const Pass: Byte;
      Src, Dest, Trans{$IFDEF Store16bits}, Extra{$ENDIF}: pChar);
  protected
    {Memory copy methods to encode}
    procedure EncodeNonInterlacedRGB8(Src, Dest, Trans: pChar);
    procedure EncodeNonInterlacedRGB16(Src, Dest, Trans: pChar);
    procedure EncodeNonInterlacedGrayscale16(Src, Dest, Trans: pChar);
    procedure EncodeNonInterlacedPalette148(Src, Dest, Trans: pChar);
    procedure EncodeNonInterlacedRGBAlpha8(Src, Dest, Trans: pChar);
    procedure EncodeNonInterlacedRGBAlpha16(Src, Dest, Trans: pChar);
    procedure EncodeNonInterlacedGrayscaleAlpha8(Src, Dest, Trans: pChar);
    procedure EncodeNonInterlacedGrayscaleAlpha16(Src, Dest, Trans: pChar);
    procedure EncodeInterlacedRGB8(const Pass: Byte; Src, Dest, Trans: pChar);
    procedure EncodeInterlacedRGB16(const Pass: Byte; Src, Dest, Trans: pChar);
    procedure EncodeInterlacedPalette148(const Pass: Byte;
      Src, Dest, Trans: pChar);
    procedure EncodeInterlacedGrayscale16(const Pass: Byte;
      Src, Dest, Trans: pChar);
    procedure EncodeInterlacedRGBAlpha8(const Pass: Byte;
      Src, Dest, Trans: pChar);
    procedure EncodeInterlacedRGBAlpha16(const Pass: Byte;
      Src, Dest, Trans: pChar);
    procedure EncodeInterlacedGrayscaleAlpha8(const Pass: Byte;
      Src, Dest, Trans: pChar);
    procedure EncodeInterlacedGrayscaleAlpha16(const Pass: Byte;
      Src, Dest, Trans: pChar);
  public
    {Loads the chunk from a stream}
    function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
      Size: Integer): Boolean; override;
    {Saves the chunk to a stream}
    function SaveToStream(Stream: TStream): Boolean; override;
  end;

  {Image last modification chunk}
  TChunktIME = class(TChunk)
  private
    {Holds the variables}
    fYear: Word;
    fMonth, fDay, fHour, fMinute, fSecond: Byte;
  public
    {Returns/sets variables}
    property Year: Word read fYear write fYear;
    property Month: Byte read fMonth write fMonth;
    property Day: Byte read fDay write fDay;
    property Hour: Byte read fHour write fHour;
    property Minute: Byte read fMinute write fMinute;
    property Second: Byte read fSecond write fSecond;
    {Loads the chunk from a stream}
    function LoadFromStream(Stream: TStream; const ChunkName: TChunkName;
      Size: Integer): Boolean; override;
    {Saves the chunk to a stream}
    function SaveToStream(Stream: TStream): Boolean; override;
  end;

  {Textual data}
  TChunktEXt = class(TChunk)
  private
    fKeyword, fText: String;