sxpngutils.pas

skin components for design of your applicastions

unit SXPNGUtils;

////////////////////////////////////////////////////////////////////////////////
// SXSkinComponents: Skinnable Visual Controls for Delphi and C++Builder      //
//----------------------------------------------------------------------------//
// Version: 1.2.1                                                             //
// Author: Alexey Sadovnikov                                                  //
// Web Site: http://www.saarixx.info/sxskincomponents/                        //
// E-Mail: [e-mail]                                      //
//----------------------------------------------------------------------------//
// LICENSE:                                                                   //
// 1. You may freely distribute this file.                                    //
// 2. You may not make any changes to this file.                              //
// 3. The only person who may change this file is Alexey Sadovnikov.          //
// 4. You may use this file in your freeware projects.                        //
// 5. If you want to use this file in your shareware or commercial project,   //
//    you should purchase a project license or a personal license of          //
//    SXSkinComponents: http://saarixx.info/sxskincomponents/en/purchase.htm  //
// 6. You may freely use, distribute and modify skins for SXSkinComponents.   //
// 7. You may create skins for SXSkinComponents.                              //
//----------------------------------------------------------------------------//
// Copyright (C) 2006-2007, Alexey Sadovnikov. All Rights Reserved.           //
////////////////////////////////////////////////////////////////////////////////

interface

{$I Compilers.inc}

{$TYPEDADDRESS OFF}
{$RANGECHECKS OFF} {$J+}

uses Windows, Classes, Graphics, SysUtils, GR32;

resourcestring

  EPNGInvalidCRCText='This "Portable Network Graphics" image is not valid '+
      'because it contains invalid pieces of data (crc error)';
  EPNGInvalidIHDRText='The "Portable Network Graphics" image could not be '+
      'loaded because one of its main piece of data (ihdr) might be corrupted';
  EPNGMissingMultipleIDATText='This "Portable Network Graphics" image is '+
    'invalid because it has missing image parts.';
  EPNGZLIBErrorText='Could not decompress the image because it contains '+
    'invalid compressed data.'#13#10+' Description: ';
  EPNGInvalidPaletteText='The "Portable Network Graphics" image contains '+
    'an invalid palette.';
  EPNGInvalidFileHeaderText='The file being readed is not a valid '+
    '"Portable Network Graphics" image because it contains an invalid header.'+
    ' This file may be corruped, try obtaining it again.';
  EPNGIHDRNotFirstText='This "Portable Network Graphics" image is not '+
    'supported or it might be invalid.'#13#10+'(IHDR chunk is not the first)';
  EPNGNotExistsText='The PNG file could not be loaded because it does not '+
    'exists.';
  EPNGSizeExceedsText='This "Portable Network Graphics" image is not '+
    'supported because either it''s width or height exceeds the maximum '+
    'size, which is 65535 pixels length.';
  EPNGUnknownPalEntryText='There is no such palette entry.';
  EPNGMissingPaletteText='This "Portable Network Graphics" could not be '+
    'loaded because it uses a color table which is missing.';
  EPNGUnknownCriticalChunkText='This "Portable Network Graphics" image '+
    'contains an unknown critical part which could not be decoded.';
  EPNGUnknownCompressionText='This "Portable Network Graphics" image is '+
    'encoded with an unknown compression scheme which could not be decoded.';
  EPNGUnknownInterlaceText='This "Portable Network Graphics" image uses '+
    'an unknown interlace scheme which could not be decoded.';
  EPNGCannotAssignChunkText='The chunks must be compatible to be assigned.';
  EPNGUnexpectedEndText='This "Portable Network Graphics" image is invalid '+
    'because the decoder found an unexpected end of the file.';
  EPNGNoImageDataText='This "Portable Network Graphics" image contains no '+
    'data.';
  EPNGCannotChangeSizeText='The "Portable Network Graphics" image can not '+
    'be resize by changing width and height properties. Try assigning the '+
    'image from a bitmap.';
  EPNGCannotAddChunkText='The program tried to add a existent critical '+
    'chunk to the current image which is not allowed.';
  EPNGCannotAddInvalidImageText='It''s not allowed to add a new chunk '+
    'because the current image is invalid.';
  EPNGCouldNotLoadResourceText='The PNG image could not be loaded from the '+
    'resource ID.';
  EPNGOutMemoryText='Some operation could not be performed because the '+
    'system is out of resources. Close some windows and try again.';
  EPNGCannotChangeTransparentText='Setting bit transparency color is not '+
    'allowed for PNG images containing alpha value for each pixel '+
    '(COLOR_RGBALPHA and COLOR_GRAYSCALEALPHA)';
  EPNGHeaderNotPresentText='This operation is not valid because the '+
    'current image contains no valid header.';

const

  ZLIBErrors:array[-6..2]of String=('incompatible version (-6)',
    'buffer error (-5)', 'insufficient memory (-4)', 'data error (-3)',
    'stream error (-2)', 'file error (-1)', '(0)',   'stream end (1)',
    'need dictionary (2)');

  Z_NO_FLUSH   = 0;
  Z_FINISH     = 4;
  Z_STREAM_END = 1;

  FILTER_NONE    = 0;
  FILTER_SUB     = 1;
  FILTER_UP      = 2;
  FILTER_AVERAGE = 3;
  FILTER_PAETH   = 4;

  COLOR_GRAYSCALE      = 0;
  COLOR_RGB            = 2;
  COLOR_PALETTE        = 3;
  COLOR_GRAYSCALEALPHA = 4;
  COLOR_RGBALPHA       = 6;

type

  EPNGOutMemory=class(Exception);
  EPNGError=class(Exception);
  EPNGUnexpectedEnd=class(Exception);
  EPNGInvalidCRC=class(Exception);
  EPNGInvalidIHDR=class(Exception);
  EPNGMissingMultipleIDAT=class(Exception);
  EPNGZLIBError=class(Exception);
  EPNGInvalidPalette=class(Exception);
  EPNGInvalidFileHeader=class(Exception);
  EPNGIHDRNotFirst=class(Exception);
  EPNGNotExists=class(Exception);
  EPNGSizeExceeds=class(Exception);
  EPNGMissingPalette=class(Exception);
  EPNGUnknownCriticalChunk=class(Exception);
  EPNGUnknownCompression=class(Exception);
  EPNGUnknownInterlace=class(Exception);
  EPNGNoImageData=class(Exception);
  EPNGCouldNotLoadResource=class(Exception);
  EPNGCannotChangeTransparent=class(Exception);
  EPNGHeaderNotPresent=class(Exception);

type

  TAlloc=function(AppData:Pointer;Items,Size:Integer):Pointer;
  TFree=procedure(AppData,Block:Pointer);

  TZStreamRec=packed record
   next_in:PChar;
   avail_in:Integer;
   total_in:Integer;
   next_out:PChar;
   avail_out:Integer;
   total_out:Integer;
   msg:PChar;
   internal:Pointer;
   zalloc:TAlloc;
   zfree:TFree;
   AppData:Pointer;
   data_type:Integer;
   adler:Integer;
   reserved:Integer;
  end;

  TRGBLine=array[Word]of TRGBTriple;
  PRGBLine=^TRGBLine;

  TMAXBITMAPINFO=packed record
   bmiHeader:TBitmapInfoHeader;
   bmiColors:packed array[0..255]of TRGBQuad;
  end;

  TPNGTransparencyMode=(ptmNone, ptmBit, ptmPartial);
  PCardinal=^Cardinal;
  PRGBPixel=^TRGBPixel;
  TRGBPixel=packed record
   B,G,R:Byte;
  end;

  TByteArray=array[Word]of Byte;
  PByteArray=^TByteArray;

  TPNGObject=class;
  PPointerArray=^TPointerArray;
  TPointerArray=array[Word]of Pointer;

  TPNGPointerList=class
   private
    fOwner:TPNGObject;
    fCount:Cardinal;
    fMemory:PPointerArray;
    function GetItem(Index:Cardinal):Pointer;
    procedure SetItem(Index:Cardinal;const Value:Pointer);
   protected
    function Remove(Value:Pointer):Pointer; virtual;
    procedure Insert(Value:Pointer;Position:Cardinal);
    procedure Add(Value:Pointer);
    property Item[Index:Cardinal]:Pointer read GetItem write SetItem;
    procedure SetSize(const Size:Cardinal);
    property Owner:TPNGObject read fOwner;
   public
    property Count:Cardinal read fCount write SetSize;
    constructor Create(AOwner:TPNGObject);
    destructor Destroy; override;
  end;

  TChunk=class;
  TChunkClass=class of TChunk;

  TPNGList=class(TPNGPointerList)
   private
    function GetItem(Index:Cardinal):TChunk;
   public
    procedure RemoveChunk(Chunk:TChunk); overload;
    function Add(ChunkClass:TChunkClass):TChunk;
    function ItemFromClass(ChunkClass:TChunkClass):TChunk;
    property Item[Index:Cardinal]:TChunk read GetItem;
  end;

  TChunkIHDR=class;
  TInterlaceMethod=(imNone, imAdam7);
  TCompressionLevel=0..9;
  TFilter=(pfNone, pfSub, pfUp, pfAverage, pfPaeth);
  TFilters=set of TFilter;

  TPNGObject=class(TGraphic)
   protected
    InverseGamma:array[Byte]of Byte;
    procedure InitializeGamma;
   private
    TempPalette:HPalette;
    fFilters:TFilters;
    fCompressionLevel:TCompressionLevel;
    fMaxIdatSize:Integer;
    fInterlaceMethod:TInterlaceMethod;
    fChunkList:TPNGList;
    procedure ClearChunks;
    function HeaderPresent:Boolean;
    procedure GetPixelInfo(var LineSize,Offset:Cardinal);
    procedure SetMaxIdatSize(const Value:Integer);
    function GetAlphaScanline(const LineIndex:Integer):PByteArray;
    function GetScanline(const LineIndex:Integer):Pointer;
    function GetTransparencyMode:TPNGTransparencyMode;
    function GetTransparentColor:TColor;
    procedure SetTransparentColor(const Value:TColor);
   protected
    function GetPalette:HPalette; override;
    function GetWidth:Integer; override;
    function GetHeight:Integer; override;
    procedure SetWidth(Value:Integer); override;
    procedure SetHeight(Value:Integer); override;
    procedure AssignPNG(Source:TPNGObject);
    function GetEmpty:Boolean; override;
    function GetHeader:TChunkIHDR;
    procedure DrawPartialTrans(DC:HDC;Rect:TRect);
    function GetTransparent:Boolean; override;
    function GetPixels(const X,Y:Integer):TColor; virtual;
    procedure SetPixels(const X,Y:Integer;const Value:TColor); virtual;
   public
    GammaTable:array[Byte]of Byte;
    procedure CreateAlpha;
    procedure RemoveTransparency;
    property TransparentColor:TColor read GetTransparentColor write SetTransparentColor;
    procedure AddtEXt(const Keyword,Text:String);
    procedure AddzTXt(const Keyword,Text:String);
    procedure SaveToClipboardFormat(var AFormat:Word;var AData:THandle;var APalette:HPalette); override;
    procedure LoadFromClipboardFormat(AFormat:Word;AData:THandle;APalette:HPalette); override;
    procedure RaiseError(ExceptionClass:ExceptClass;Text:String);
    property Scanline[const Index:Integer]:Pointer read GetScanline;
    property AlphaScanline[const Index:Integer]:PByteArray read GetAlphaScanline;
    property Header:TChunkIHDR read GetHeader;
    property TransparencyMode:TPNGTransparencyMode read GetTransparencyMode;
    procedure Assign(Source:TPersistent); override;
    procedure AssignTo(Dest:TPersistent); override;
    procedure AssignHandle(Handle:HBitmap;Transparent:Boolean;TransparentColor:ColorRef);
    procedure Draw(ACanvas:TCanvas; const Rect:TRect); override;
    property Width:Integer read GetWidth;
    property Height:Integer read GetHeight;
    property InterlaceMethod:TInterlaceMethod read FInterlaceMethod write FInterlaceMethod;
    property Filters:TFilters read fFilters write fFilters;
    property MaxIdatSize:Integer read fMaxIdatSize write SetMaxIdatSize;
    property Empty:Boolean read GetEmpty;
    property CompressionLevel:TCompressionLevel read FCompressionLevel write FCompressionLevel;
    property Chunks:TPNGList read fChunkList;
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(Stream:TStream); override;
    procedure SaveToStream(Stream:TStream); override;
    procedure LoadFromResourceName(Instance:HInst; const Name:String);
    procedure LoadFromResourceID(Instance:HInst; ResID:Integer);
    property Pixels[const X,Y:Integer]:TColor read GetPixels write SetPixels;
  end;

  TChunkName=Array[0..3]of Char;

  TChunk=class
   private
    fData:Pointer;
    fDataSize:Cardinal;
    fOwner:TPNGObject;
    fName:TChunkName;
    function GetHeader:TChunkIHDR;
    function GetIndex:Integer;
    class function GetName:String; virtual;
    function GetChunkName:String;
   public
    property Index:Integer read GetIndex;
    property Header:TChunkIHDR read GetHeader;
    procedure ResizeData(const NewSize:Cardinal);
    property Data:Pointer read fData;
    property DataSize:Cardinal read fDataSize;
    procedure Assign(Source:TChunk); virtual;
    property Owner:TPNGObject read fOwner;
    constructor Create(Owner:TPNGObject); virtual;
    destructor Destroy; override;
    property Name:String read GetChunkName;
    function LoadFromStream(Stream:TStream; const ChunkName:TChunkName;
      Size:Integer):Boolean; virtual;
    function SaveData(Stream:TStream):Boolean;
    function SaveToStream(Stream:TStream):Boolean; virtual;
  end;

  TChunkIEND=class(TChunk);

  PIHDRData=^TIHDRData;
  TIHDRData=packed record
   Width,Height:Cardinal;
   BitDepth,
   ColorType,
   CompressionMethod,
   FilterMethod,
   InterlaceMethod:Byte;
  end;

  TChunkIHDR=class(TChunk)
   private
    ImageHandle:HBitmap;
    ImageDC:HDC;
    HasPalette:Boolean;
    BytesPerRow:Integer;
    ImageData:Pointer;
    ImageAlpha:Pointer;
    IHDRData:TIHDRData;
   protected
    procedure PrepareImageData;
    procedure FreeImageData;
   public
    BitmapInfo:TMaxBitmapInfo;
    property Alpha:Pointer read ImageAlpha;
    property Data:Pointer read ImageData;
    property ImageHandleValue:HBitmap read ImageHandle;
    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;
    function LoadFromStream(Stream:TStream; const ChunkName:TChunkName;Size:Integer):Boolean; override;
    function SaveToStream(Stream:TStream):Boolean; override;
    constructor Create(Owner:TPNGObject); override;
    destructor Destroy; override;
    procedure Assign(Source:TChunk); override;
  end;

  TChunkgAMA=class(TChunk)
   private
    function GetValue:Cardinal;
    procedure SetValue(const Value:Cardinal);
   public
    property Gamma:Cardinal read GetValue write SetValue;
    function LoadFromStream(Stream:TStream;const ChunkName:TChunkName;Size:Integer):Boolean; override;
    constructor Create(Owner:TPNGObject); override;
    procedure Assign(Source:TChunk); override;
  end;

  TZStreamRec2=packed record
    ZLIB:TZStreamRec;
    Data:Pointer;
    fStream:TStream;
  end;

  TChunkPLTE=class(TChunk)
   private
    fCount:Integer;
    function GetPaletteItem(Index:Byte):TRGBQuad;
   public
    property Item[Index:Byte]:TRGBQuad read GetPaletteItem;
    property Count:Integer read fCount;
    function LoadFromStream(Stream:TStream;const ChunkName:TChunkName;Size:Integer):Boolean; override;
    function SaveToStream(Stream:TStream):Boolean; override;
    procedure Assign(Source:TChunk); override;
  end;

  TChunktRNS=class(TChunk)
   private
    fBitTransparency:Boolean;
    function GetTransparentColor:ColorRef;
    procedure SetTransparentColor(const Value:ColorRef);
   public
    PaletteValues:array[Byte]of Byte;
    property BitTransparency:Boolean read fBitTransparency;
    property TransparentColor:ColorRef read GetTransparentColor write SetTransparentColor;
    function LoadFromStream(Stream:TStream;const ChunkName:TChunkName;Size:Integer):Boolean; override;
    function SaveToStream(Stream:TStream):Boolean; override;
    procedure Assign(Source:TChunk); override;
  end;

  TChunkIDAT=class(TChunk)
   private
    Header:TChunkIHDR;
    ImageWidth,ImageHeight:Integer;
    Row_Bytes,Offset:Cardinal;
    Encode_Buffer:array[0..5]of PByteArray;