5038 lines
148 KiB
ObjectPascal
5038 lines
148 KiB
ObjectPascal
{Portable Network Graphics for Key Objects Library adaptation
|
|
by Kladov Vladimir 29-Sep-2002 ( bonanzas@xcl.cjb.net, http://xcl.cjb.net )
|
|
from source of TPngImage
|
|
by Gustavo Huffenbacher Daud ( gubadaud@terra.com.br, pngdelphi.sourceforge.net ) }
|
|
|
|
unit KOLPng;
|
|
{* PNG - Portable Network Graphics format support for KOL.
|
|
version from 31-May-2003 }
|
|
|
|
{$I KOLDEF.INC}
|
|
{$IFDEF EXTERNAL_DEFINES}
|
|
{$INCLUDE EXTERNAL_DEFINES.INC}
|
|
{$ENDIF EXTERNAL_DEFINES}
|
|
|
|
interface
|
|
|
|
{Triggers avaliable}
|
|
|
|
{.$DEFINE CheckCRC} //Enables CRC checking
|
|
{.$DEFINE PartialTransparentDraw} //Draws partial transparent images
|
|
|
|
{$RANGECHECKS OFF} {$J+}
|
|
|
|
{$IFNDEF PAS_VERSION}
|
|
{$IFNDEF PAS_PNG}
|
|
{$DEFINE ASM_VERSION}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF ASM_VERSION}
|
|
{$IFNDEF PNG_NOMMX}
|
|
{$DEFINE PNG_MMX}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
uses
|
|
Windows, KOL, KolZLibBzip {$IFDEF PNG_MMX}, Mmx {$ENDIF};
|
|
|
|
const
|
|
{Avaliable PNG filters for mode 0}
|
|
FILTER_NONE = 0;
|
|
FILTER_SUB = 1;
|
|
FILTER_UP = 2;
|
|
FILTER_AVERAGE = 3;
|
|
FILTER_PAETH = 4;
|
|
|
|
{Avaliable color modes for PNG}
|
|
COLOR_GRAYSCALE = 0;
|
|
COLOR_RGB = 2;
|
|
COLOR_PALETTE = 3;
|
|
COLOR_GRAYSCALEALPHA = 4;
|
|
COLOR_RGBALPHA = 6;
|
|
|
|
|
|
{Error types}
|
|
type
|
|
TPngError = ( ErrOK, ErrInvalidCRC, ErrInvalidIHDR, ErrSizeExceeds, ErrUnknownCompression,
|
|
ErrUnknownInterlace, ErrInvalidPalette, ErrMissingMultipleIDAT,
|
|
ErrZLibError, ErrInvalidHeader, ErrUnexpectedEnd, ErrIHDRNotFirst,
|
|
ErrUnknownCriticalChunk, ErrNoImageData );
|
|
|
|
TOnPngProgress = function( Sender: PObj; Pass, MaxPass: Integer; Progress: Integer ): Boolean of object;
|
|
TOnGetRow = procedure( Sender: PObj; Row: Integer; var W, H: Integer; var Dta, Trans: PByte;
|
|
var Stop: Boolean ) of object;
|
|
|
|
TPngScale = ( psFullImage, psHalfSize, psQuarterSize, psEightsSize );
|
|
|
|
type
|
|
{Same as TBitmapInfo but with allocated space for}
|
|
{palette entries}
|
|
TMAXBITMAPINFO = packed record
|
|
bmiHeader: TBitmapInfoHeader;
|
|
bmiColors: packed array[0..255] of TRGBQuad;
|
|
end;
|
|
|
|
{Transparency mode for pngs}
|
|
TPNGTransparencyMode = (ptmNone, ptmBit, ptmPartial);
|
|
{Access to a rgb pixel}
|
|
pRGBPixel = ^TRGBPixel;
|
|
TRGBPixel = packed record
|
|
B, G, R: Byte;
|
|
end;
|
|
|
|
{Pointer to an array of bytes type}
|
|
TByteArray = Array[Word] of Byte;
|
|
pByteArray = ^TByteArray;
|
|
|
|
{Forward}
|
|
PPngObject = ^TPngObject;
|
|
//TPNGObject = object;
|
|
pPointerArray = ^TPointerArray;
|
|
TPointerArray = Array[Word] of Pointer;
|
|
|
|
{Chunk name object}
|
|
TChunkName = Array[0..3] of Char;
|
|
|
|
{Forward declaration}
|
|
PChunk = ^TChunk;
|
|
PChunkIEND = PChunk;
|
|
|
|
{Forward}
|
|
PChunkIHDR = ^TChunkIHDR;
|
|
|
|
{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 = object( TObj )
|
|
private
|
|
fOnProgress: TOnPngProgress;
|
|
fScale: TPngScale;
|
|
fOnGetRow: TOnGetRow;
|
|
function GetScaledHeight: Integer;
|
|
function GetScaledWidth: Integer;
|
|
protected
|
|
FError: TPngError;
|
|
FErrorOnInvalidCRC: Boolean;
|
|
{Gamma table values}
|
|
GammaTable, InverseGamma: Array[Byte] of Byte;
|
|
procedure InitializeGamma;
|
|
protected
|
|
{Filters to test to encode}
|
|
fFilters: TFilters;
|
|
{Compression level for ZLIB}
|
|
fCompressionLevel: TCompressionLevel;
|
|
{Maximum size for IDAT chunks}
|
|
fMaxIdatSize: DWORD;
|
|
{Returns if image is interlaced}
|
|
fInterlaceMethod: TInterlaceMethod;
|
|
{Chunks object}
|
|
fChunkList: PList;
|
|
{Clear all chunks in the list}
|
|
procedure ClearChunks;
|
|
{Returns if header is present}
|
|
function HeaderPresent: Boolean;
|
|
{Returns linesize and byte offset for pixels}
|
|
procedure GetPixelInfo(var LineSize, Offset: DWORD);
|
|
procedure SetMaxIdatSize(const Value: DWORD);
|
|
function GetAlphaScanline(const LineIndex: Integer): pByteArray;
|
|
function GetScanline(const LineIndex: Integer): Pointer;
|
|
function GetTransparencyMode: TPNGTransparencyMode;
|
|
function GetTransparentColor: TColor;
|
|
procedure SetTransparentColor(const Value: TColor);
|
|
protected
|
|
{Returns image as Bitmap}
|
|
fBitmap: PBitmap;
|
|
function GetBitmap: PBitmap;
|
|
{Returns image width and height}
|
|
function GetWidth: Integer;
|
|
function GetHeight: Integer;
|
|
{Assigns from another TPNGObject}
|
|
procedure AssignPNG(Source: PPNGObject);
|
|
{Returns if the image is empty}
|
|
function GetEmpty: Boolean;
|
|
{Used with property Header}
|
|
function GetHeader: PChunkIHDR;
|
|
{Mainly internal}
|
|
function ChunkByName( const AName: TChunkName ): Pointer;
|
|
function CreateChunkByName( const AName: TChunkName ): Pointer;
|
|
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}
|
|
procedure AddtEXt(const Keyword, Text: String);
|
|
{Saves to clipboard}
|
|
function CopyToClipboard: Boolean;
|
|
function PasteFromClipboard: Boolean;
|
|
{Returns a scanline from png}
|
|
property Scanline[const Index: Integer]: Pointer read GetScanline;
|
|
property AlphaScanline[const Index: Integer]: pByteArray read GetAlphaScanline;
|
|
{Returns pointer to the header}
|
|
property Header: PChunkIHDR read GetHeader;
|
|
{Returns the transparency mode used by this png}
|
|
property TransparencyMode: TPNGTransparencyMode read GetTransparencyMode;
|
|
{Assigns from a windows bitmap handle}
|
|
procedure AssignHandle(Handle: HBitmap; Transparent: Boolean;
|
|
TranColor: ColorRef);
|
|
procedure AssignDib( DibHeader: pBitmapInfo; DibData: Pointer; Transparent: Boolean;
|
|
TranColor: ColorRef );
|
|
{Returns image as bitmap}
|
|
property Bitmap: PBitmap read GetBitmap;
|
|
{Draws the image into a canvas}
|
|
function Draw(DC: HDC; X, Y: Integer): Boolean;
|
|
procedure DrawTransparent( DC: HDC; X, Y, maxX, maxY: Integer; TranColor: TColor );
|
|
function StretchDraw( DC: HDC; const Rect: TRect ): Boolean;
|
|
{--not use, incorrectly defined--}
|
|
procedure StretchDrawTransparent( DC: HDC; const Rect: TRect; TranColor: TColor );
|
|
{Draws using partial transparency}
|
|
procedure DrawPartialTrans(DC: HDC; Rect: TRect);
|
|
{Width and height properties}
|
|
property Width: Integer read GetWidth;
|
|
property Height: Integer read GetHeight;
|
|
{Scaling down while loading}
|
|
property Scale: TPngScale read fScale write fScale;
|
|
property ScaledWidth: Integer read GetScaledWidth;
|
|
property ScaledHeight: Integer read GetScaledHeight;
|
|
{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: DWORD 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: PList read fChunkList;
|
|
{Object being created and destroyed}
|
|
destructor Destroy; virtual;
|
|
function LoadFromFile(const Filename: String): Boolean;
|
|
procedure SaveToFile(const Filename: String);
|
|
function LoadFromStream(Stream: PStream): Boolean;
|
|
procedure SaveToStream(Stream: PStream);
|
|
{Loading the image from resources}
|
|
procedure LoadFromResourceName(Instance: HInst; const AName: String);
|
|
procedure LoadFromResourceID(Instance: HInst; ResID: Integer);
|
|
{Error handling}
|
|
Property Error: TPngError read FError;
|
|
Property ErrorOnInvalidCRC: Boolean read FErrorOnInvalidCRC write FErrorOnInvalidCRC;
|
|
{Progress}
|
|
property OnProgress: TOnPngProgress read fOnProgress write fOnProgress;
|
|
property OnGetRow: TOnGetRow read fOnGetRow write fOnGetRow;
|
|
end;
|
|
|
|
{Base chunk object}
|
|
TChunk = object(TObj)
|
|
protected
|
|
{Contains data}
|
|
fData: Pointer;
|
|
fDataSize: DWORD;
|
|
{Stores owner}
|
|
fOwner: PPngObject;
|
|
{Returns pointer to the TChunkIHDR}
|
|
function GetHeader: PChunkIHDR;
|
|
{Used with property index}
|
|
function GetIndex: Integer;
|
|
protected
|
|
fChnkName: String;
|
|
{Should return chunk name}
|
|
public
|
|
{Returns index from list}
|
|
property Index: Integer read GetIndex;
|
|
{Returns pointer to the TChunkIHDR}
|
|
property Header: PChunkIHDR read GetHeader;
|
|
{Resize the data}
|
|
procedure ResizeData(const NewSize: DWORD);
|
|
{Returns data and size}
|
|
property Data: Pointer read fData;
|
|
property DataSize: DWORD read fDataSize;
|
|
{Returns owner}
|
|
property Owner: PPngObject read fOwner;
|
|
{Being destroyed/created}
|
|
constructor Create(AOwner: PPngObject);
|
|
destructor Destroy; virtual;
|
|
{Returns chunk class/name}
|
|
property ChnkName: String read fChnkName;
|
|
{Loads the chunk from a stream}
|
|
function LoadFromStream(Stream: PStream; const ChunkName: TChunkName;
|
|
Size: Integer): Boolean;
|
|
{Saves the chunk to a stream}
|
|
function SaveToStream(Stream: PStream): Boolean;
|
|
end;
|
|
|
|
{IHDR data}
|
|
pIHDRData = ^TIHDRData;
|
|
TIHDRData = packed record
|
|
Width, Height: Integer;
|
|
BitDepth,
|
|
ColorType,
|
|
CompressionMethod,
|
|
FilterMethod,
|
|
InterlaceMethod: Byte;
|
|
end;
|
|
|
|
{Information header chunk}
|
|
TChunkIHDR = object(TChunk)
|
|
protected
|
|
{Current image}
|
|
ImageHandle: HBitmap;
|
|
ImageDC: HDC;
|
|
|
|
{Output windows bitmap}
|
|
HasPalette: Boolean;
|
|
public
|
|
BitmapInfo: TMaxBitmapInfo;
|
|
protected
|
|
BytesPerRow: Integer;
|
|
{Stores the image bytes}
|
|
ImageData: pointer;
|
|
ImageAlpha: Pointer;
|
|
|
|
{Contains all the ihdr data}
|
|
IHDRData: TIHDRData;
|
|
{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: Integer read IHDRData.Width write IHDRData.Width;
|
|
property Height: Integer 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;
|
|
{Destructor/constructor}
|
|
constructor Create(AOwner: PPngObject);
|
|
destructor Destroy; virtual;
|
|
end;
|
|
|
|
{Gamma chunk}
|
|
PChunkGAMA = ^TChunkGAMA;
|
|
TChunkgAMA = object(TChunk)
|
|
protected
|
|
{Returns/sets the value for the gamma chunk}
|
|
function GetValue: DWORD;
|
|
procedure SetValue(const Value: DWORD);
|
|
public
|
|
{Returns/sets gamma value}
|
|
property Gamma: DWORD read GetValue write SetValue;
|
|
{Being created}
|
|
constructor Create(AOwner: PPngObject);
|
|
end;
|
|
|
|
{ZLIB Decompression extra information}
|
|
TZStreamRec2 = packed record
|
|
{From ZLIB}
|
|
ZLIB: TZStreamRec;
|
|
{Additional info}
|
|
Data: Pointer;
|
|
fStream: PStream;
|
|
end;
|
|
|
|
{Palette chunk}
|
|
PChunkPLTE = ^TChunkPLTE;
|
|
TChunkPLTE = object(TChunk)
|
|
protected
|
|
{Number of items in the palette}
|
|
fCount: Integer;
|
|
{Contains the palette handle}
|
|
function GetPaletteItem(Idx: 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;
|
|
end;
|
|
|
|
{Transparency information}
|
|
PChunktRNS = ^TChunktRNS;
|
|
TChunktRNS = object(TChunk)
|
|
protected
|
|
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;
|
|
end;
|
|
|
|
{Actual image information}
|
|
PChunkIDAT = ^TChunkIDAT;
|
|
TChunkIDAT = object(TChunk)
|
|
protected
|
|
{Holds another pointer to the TChunkIHDR}
|
|
//Header: PChunkIHDR;
|
|
{Stores temporary image width and height}
|
|
ImageWidth, ImageHeight: Integer;
|
|
ShiftScale: Integer;
|
|
{Size in bytes of each line and offset}
|
|
Row_Bytes, Offset : DWORD;
|
|
{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 AEndPos: Integer; var crcfile: DWORD): Integer;
|
|
{Compress and writes IDAT data}
|
|
procedure IDATZlibWrite(var ZLIBStream: TZStreamRec2; Buffer: Pointer;
|
|
const Length: DWORD);
|
|
procedure FinishIDATZlib(var ZLIBStream: TZStreamRec2);
|
|
{Prepares the palette}
|
|
procedure PreparePalette;
|
|
protected
|
|
{Decode interlaced image}
|
|
procedure DecodeInterlacedAdam7(Stream: PStream;
|
|
var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: DWORD);
|
|
{Decode non interlaced imaged}
|
|
procedure DecodeNonInterlaced(Stream: PStream;
|
|
var ZLIBStream: TZStreamRec2; const Size: Integer;
|
|
var crcfile: DWORD);
|
|
protected
|
|
{Encode non interlaced images}
|
|
procedure EncodeNonInterlaced(Stream: PStream;
|
|
var ZLIBStream: TZStreamRec2);
|
|
{Encode interlaced images}
|
|
procedure EncodeInterlacedAdam7(Stream: PStream;
|
|
var ZLIBStream: TZStreamRec2);
|
|
protected
|
|
{Memory copy methods to decode}
|
|
procedure CopyNonInterlacedRGB8(Src, Dest, Trans: pChar);
|
|
procedure CopyNonInterlacedRGB16(Src, Dest, Trans: pChar);
|
|
procedure CopyNonInterlacedPalette148(Src, Dest, Trans: pChar);
|
|
procedure CopyNonInterlacedPalette2(Src, Dest, Trans: pChar);
|
|
procedure CopyNonInterlacedGray2(Src, Dest, Trans: pChar);
|
|
procedure CopyNonInterlacedGrayscale16(Src, Dest, Trans: pChar);
|
|
procedure CopyNonInterlacedRGBAlpha8(Src, Dest, Trans: pChar);
|
|
procedure CopyNonInterlacedRGBAlpha16(Src, Dest, Trans: pChar);
|
|
procedure CopyNonInterlacedGrayscaleAlpha8(Src, Dest, Trans: PChar);
|
|
procedure CopyNonInterlacedGrayscaleAlpha16(Src, Dest, Trans: PChar);
|
|
procedure CopyInterlacedRGB8(const Pass: Byte; Src, Dest, Trans: pChar);
|
|
procedure CopyInterlacedRGB16(const Pass: Byte; Src, Dest, Trans: pChar);
|
|
procedure CopyInterlacedPalette148(const Pass: Byte; Src,Dest,Trans: pChar);
|
|
procedure CopyInterlacedPalette2(const Pass: Byte; Src, Dest, Trans: pChar);
|
|
procedure CopyInterlacedGray2(const Pass: Byte; Src, Dest, Trans: pChar);
|
|
procedure CopyInterlacedGrayscale16(const Pass: Byte;Src,Dest,Trans: pChar);
|
|
procedure CopyInterlacedRGBAlpha8(const Pass: Byte; Src,Dest,Trans: pChar);
|
|
procedure CopyInterlacedRGBAlpha16(const Pass: Byte; Src,Dest,Trans: pChar);
|
|
procedure CopyInterlacedGrayscaleAlpha8(const Pass: Byte;
|
|
Src, Dest, Trans: pChar);
|
|
procedure CopyInterlacedGrayscaleAlpha16(const Pass: Byte;
|
|
Src, Dest, Trans: 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);
|
|
end;
|
|
|
|
{Image last modification chunk}
|
|
PChunkTIME = ^TChunktIME;
|
|
TChunktIME = object(TChunk)
|
|
protected
|
|
{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;
|
|
end;
|
|
|
|
{Textual data}
|
|
PChunkTEXT = ^TChunkTEXT;
|
|
TChunktEXt = object(TChunk)
|
|
protected
|
|
fKeyword, fText: String;
|
|
public
|
|
destructor Destroy; virtual;
|
|
{Keyword and text}
|
|
property Keyword: String read fKeyword write fKeyword;
|
|
property Text: String read fText write fText;
|
|
end;
|
|
|
|
{Registers a new chunk class}
|
|
//procedure RegisterChunk(ChunkClass: TChunkClass);
|
|
|
|
{Calculates crc}
|
|
function update_crc(crc: DWORD; buf: pByteArray; len: Integer): DWORD;
|
|
{Invert bytes using assembly}
|
|
function ByteSwap(const a: integer): integer;
|
|
|
|
function NewPngObject: PPngObject;
|
|
|
|
function BytesForPixels(const Pixels: Integer; const ColorType,
|
|
BitDepth: Byte): Integer;
|
|
|
|
var CountFilters: array[ TFilter ] of Integer;
|
|
|
|
implementation
|
|
|
|
var
|
|
//ChunkClasses: TPngPointerList;
|
|
{Table of CRCs of all 8-bit messages}
|
|
crc_table: Array[0..255] of DWORD;
|
|
{Flag: has the table been computed? Initially false}
|
|
crc_table_computed: Boolean;
|
|
{$IFDEF PNG_MMX}
|
|
mmxSupported: Boolean;
|
|
{$ENDIF}
|
|
|
|
type
|
|
TChunkType = ( ctCommon, ctIHDR, ctIEND, ctIDAT, ctPLTE,
|
|
ctgAMA, ctTRNS, cttEXt, cttIME );
|
|
TLoadProc = function( Chunk: Pointer; Strm: PStream; const ChunkName: TChunkName;
|
|
Size: Integer): Boolean;
|
|
TSaveProc = function( Chunk: Pointer; Strm: PStream ): Boolean;
|
|
TLoadArray = array[ TChunkType ] of TLoadProc;
|
|
TSaveArray = array[ TChunkType ] of TSaveProc;
|
|
|
|
function IHDR_Load( Chunk: Pointer; Stream: PStream; const ChunkName: TChunkName;
|
|
Size: Integer ): Boolean; forward;
|
|
function IDAT_Load( Chunk: Pointer; Stream: PStream; const ChunkName: TChunkName;
|
|
Size: Integer ): Boolean; forward;
|
|
function PLTE_Load( Chunk: Pointer; Stream: PStream; const ChunkName: TChunkName;
|
|
Size: Integer ): Boolean; forward;
|
|
function gAMA_Load( Chunk: Pointer; Stream: PStream; const ChunkName: TChunkName;
|
|
Size: Integer ): Boolean; forward;
|
|
function TRNS_Load( Chunk: Pointer; Stream: PStream; const ChunkName: TChunkName;
|
|
Size: Integer ): Boolean; forward;
|
|
function tEXt_Load( Chunk: Pointer; Stream: PStream; const ChunkName: TChunkName;
|
|
Size: Integer ): Boolean; forward;
|
|
function tIME_Load( Chunk: Pointer; Stream: PStream; const ChunkName: TChunkName;
|
|
Size: Integer ): Boolean; forward;
|
|
function IHDR_Save( Chunk: Pointer; Stream: PStream ): Boolean; forward;
|
|
function IDAT_Save( Chunk: Pointer; Stream: PStream ): Boolean; forward;
|
|
function PLTE_Save( Chunk: Pointer; Stream: PStream ): Boolean; forward;
|
|
function TRNS_Save( Chunk: Pointer; Stream: PStream ): Boolean; forward;
|
|
function tEXt_Save( Chunk: Pointer; Stream: PStream ): Boolean; forward;
|
|
function tIME_Save( Chunk: Pointer; Stream: PStream ): Boolean; forward;
|
|
|
|
function ChunkTypeByName( const Name: String ): TChunkType;
|
|
const ChunkNames: array[ TChunkType ] of String = ( '', 'IHDR', 'IEND', 'IDAT',
|
|
'PLTE', 'gAMA', 'TRNS', 'tEXt', 'tIME' );
|
|
var I: TChunkType;
|
|
begin
|
|
for I := High( TChunkType ) downto Succ( Low( TChunkType ) ) do
|
|
if Name = ChunkNames[ I ] then
|
|
begin
|
|
Result := I; Exit;
|
|
end;
|
|
Result := ctCommon;
|
|
end;
|
|
|
|
{Draw transparent image using transparent color}
|
|
procedure DrawTransparentBitmap(dc: HDC; srcBits: Pointer;
|
|
var srcHeader: TBitmapInfoHeader;
|
|
srcBitmapInfo: pBitmapInfo; Rect: TRect; cTransparentColor: COLORREF);
|
|
var
|
|
cColor: COLORREF;
|
|
bmAndBack, bmAndObject, bmAndMem: HBITMAP;
|
|
bmBackOld, bmObjectOld, bmMemOld: HBITMAP;
|
|
hdcMem, hdcBack, hdcObject, hdcTemp: HDC;
|
|
ptSize, orgSize: TPOINT;
|
|
OldBitmap, DrawBitmap: HBITMAP;
|
|
begin
|
|
hdcTemp := CreateCompatibleDC(dc);
|
|
// Select the bitmap
|
|
DrawBitmap := CreateDIBitmap(dc, srcHeader, CBM_INIT, srcBits, srcBitmapInfo^,
|
|
DIB_RGB_COLORS);
|
|
OldBitmap := SelectObject(hdcTemp, DrawBitmap);
|
|
|
|
// Sizes
|
|
OrgSize.x := abs(srcHeader.biWidth);
|
|
OrgSize.y := abs(srcHeader.biHeight);
|
|
ptSize.x := Rect.Right - Rect.Left; // Get width of bitmap
|
|
ptSize.y := Rect.Bottom - Rect.Top; // Get height of bitmap
|
|
|
|
// Create some DCs to hold temporary data.
|
|
hdcBack := CreateCompatibleDC(dc);
|
|
hdcObject := CreateCompatibleDC(dc);
|
|
hdcMem := CreateCompatibleDC(dc);
|
|
|
|
// Create a bitmap for each DC. DCs are required for a number of
|
|
// GDI functions.
|
|
|
|
// Monochrome DCs
|
|
bmAndBack := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil);
|
|
bmAndObject := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil);
|
|
|
|
bmAndMem := CreateCompatibleBitmap(dc, ptSize.x, ptSize.y);
|
|
|
|
// Each DC must select a bitmap object to store pixel data.
|
|
bmBackOld := SelectObject(hdcBack, bmAndBack);
|
|
bmObjectOld := SelectObject(hdcObject, bmAndObject);
|
|
bmMemOld := SelectObject(hdcMem, bmAndMem);
|
|
|
|
// Set the background color of the source DC to the color.
|
|
// contained in the parts of the bitmap that should be transparent
|
|
cColor := SetBkColor(hdcTemp, cTransparentColor);
|
|
|
|
// Create the object mask for the bitmap by performing a BitBlt
|
|
// from the source bitmap to a monochrome bitmap.
|
|
StretchBlt(hdcObject, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0,
|
|
orgSize.x, orgSize.y, SRCCOPY);
|
|
|
|
// Set the background color of the source DC back to the original
|
|
// color.
|
|
SetBkColor(hdcTemp, cColor);
|
|
|
|
// Create the inverse of the object mask.
|
|
BitBlt(hdcBack, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0,
|
|
NOTSRCCOPY);
|
|
|
|
// Copy the background of the main DC to the destination.
|
|
BitBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, dc, Rect.Left, Rect.Top,
|
|
SRCCOPY);
|
|
|
|
// Mask out the places where the bitmap will be placed.
|
|
BitBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0, SRCAND);
|
|
|
|
// Mask out the transparent colored pixels on the bitmap.
|
|
// BitBlt(hdcTemp, 0, 0, ptSize.x, ptSize.y, hdcBack, 0, 0, SRCAND);
|
|
StretchBlt(hdcTemp, 0, 0, OrgSize.x, OrgSize.y, hdcBack, 0, 0,
|
|
PtSize.x, PtSize.y, SRCAND);
|
|
|
|
// XOR the bitmap with the background on the destination DC.
|
|
StretchBlt(hdcMem, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0,
|
|
OrgSize.x, OrgSize.y, SRCPAINT);
|
|
|
|
// Copy the destination to the screen.
|
|
BitBlt(dc, Rect.Left, Rect.Top, ptSize.x, ptSize.y, hdcMem, 0, 0,
|
|
SRCCOPY);
|
|
|
|
// Delete the memory bitmaps.
|
|
DeleteObject(SelectObject(hdcBack, bmBackOld));
|
|
DeleteObject(SelectObject(hdcObject, bmObjectOld));
|
|
DeleteObject(SelectObject(hdcMem, bmMemOld));
|
|
DeleteObject(SelectObject(hdcTemp, OldBitmap));
|
|
|
|
// Delete the memory DCs.
|
|
DeleteDC(hdcMem);
|
|
DeleteDC(hdcBack);
|
|
DeleteDC(hdcObject);
|
|
DeleteDC(hdcTemp);
|
|
end;
|
|
|
|
{Make the table for a fast CRC.}
|
|
procedure make_crc_table;
|
|
var
|
|
c: DWORD;
|
|
n, k: Integer;
|
|
begin
|
|
|
|
{fill the crc table}
|
|
for n := 0 to 255 do
|
|
begin
|
|
c := DWORD(n);
|
|
for k := 0 to 7 do
|
|
begin
|
|
if Boolean(c and 1) then
|
|
c := $edb88320 xor (c shr 1)
|
|
else
|
|
c := c shr 1;
|
|
end;
|
|
crc_table[n] := c;
|
|
end;
|
|
|
|
{The table has already being computated}
|
|
crc_table_computed := true;
|
|
end;
|
|
|
|
{Update a running CRC with the bytes buf[0..len-1]--the CRC
|
|
should be initialized to all 1's, and the transmitted value
|
|
is the 1's complement of the final running CRC (see the
|
|
crc() routine below)).}
|
|
function update_crc(crc: DWORD; buf: pByteArray; len: Integer): DWORD;
|
|
var
|
|
c: DWORD;
|
|
n: Integer;
|
|
begin
|
|
c := crc;
|
|
|
|
{Create the crc table in case it has not being computed yet}
|
|
if not crc_table_computed then make_crc_table;
|
|
|
|
{Update}
|
|
for n := 0 to len - 1 do
|
|
c := crc_table[(c XOR buf^[n]) and $FF] XOR (c shr 8);
|
|
|
|
{Returns}
|
|
Result := c;
|
|
end;
|
|
|
|
{Calculates the paeth predictor}
|
|
function PaethPredictor(a, b, c: Byte): Byte;
|
|
var
|
|
pa, pb, pc: Integer;
|
|
begin
|
|
{ a = left, b = above, c = upper left }
|
|
pa := abs(Integer( b ) - Integer( c )); { distances to a, b, c }
|
|
pb := abs(Integer( a ) - Integer( c )); { distances to a, b, c }
|
|
pc := abs(Integer( a + b ) - Integer( c ) * 2);
|
|
|
|
{ return nearest of a, b, c, breaking ties in order a, b, c }
|
|
if (pa <= pb) and (pa <= pc) then
|
|
Result := a
|
|
else
|
|
if pb <= pc then
|
|
Result := b
|
|
else
|
|
Result := c;
|
|
end;
|
|
|
|
{Invert bytes using assembly}
|
|
function ByteSwap(const a: integer): integer;
|
|
asm
|
|
bswap eax
|
|
end;
|
|
|
|
{Calculates number of bytes for the number of pixels using the}
|
|
{color mode in the paramenter}
|
|
function BytesForPixels(const Pixels: Integer; const ColorType,
|
|
BitDepth: Byte): Integer;
|
|
begin
|
|
case ColorType of
|
|
{Palette and grayscale contains a single value, for palette}
|
|
{an value of size 2^bitdepth pointing to the palette index}
|
|
{and grayscale the value from 0 to 2^bitdepth with color intesity}
|
|
COLOR_GRAYSCALE, COLOR_PALETTE:
|
|
Result := (Pixels * BitDepth + 7) div 8;
|
|
{RGB contains 3 values R, G, B with size 2^bitdepth each}
|
|
COLOR_RGB:
|
|
Result := (Pixels * BitDepth * 3) div 8;
|
|
{Contains one value followed by alpha value booth size 2^bitdepth}
|
|
COLOR_GRAYSCALEALPHA:
|
|
Result := (Pixels * BitDepth * 2) div 8;
|
|
{Contains four values size 2^bitdepth, Red, Green, Blue and alpha}
|
|
COLOR_RGBALPHA:
|
|
Result := (Pixels * BitDepth * 4) div 8;
|
|
else
|
|
Result := 0;
|
|
end {case ColorType}
|
|
end;
|
|
|
|
{TChunk implementation}
|
|
|
|
{Resizes the data}
|
|
procedure TChunk.ResizeData(const NewSize: DWORD);
|
|
begin
|
|
fDataSize := NewSize;
|
|
ReallocMem(fData, NewSize + 1);
|
|
end;
|
|
|
|
{Returns index from list}
|
|
function TChunk.GetIndex: Integer;
|
|
begin
|
|
Result := Owner.Chunks.IndexOf( @Self );
|
|
end;
|
|
|
|
{Returns pointer to the TChunkIHDR}
|
|
function TChunk.GetHeader: PChunkIHDR;
|
|
begin
|
|
Result := Owner.Chunks.Items[0];
|
|
end;
|
|
|
|
{Chunk being created}
|
|
constructor TChunk.Create(AOwner: PPngObject);
|
|
begin
|
|
{Ancestor create}
|
|
inherited Create;
|
|
|
|
{Initialize data holder}
|
|
GetMem(fData, 1);
|
|
fDataSize := 0;
|
|
{Record owner}
|
|
fOwner := AOwner;
|
|
end;
|
|
|
|
{Chunk being destroyed}
|
|
destructor TChunk.Destroy;
|
|
begin
|
|
fChnkName := '';
|
|
{Free data holder}
|
|
FreeMem(fData); //, fDataSize + 1);
|
|
{Let ancestor destroy}
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{Returns the chunk name}
|
|
{Saves the chunk to the stream}
|
|
function TChunk.SaveToStream(Stream: PStream): Boolean;
|
|
var
|
|
ChunkSize, ChunkCRC: DWORD;
|
|
NameBuf: TChunkName;
|
|
begin
|
|
{First, write the size for the following data in the chunk}
|
|
ChunkSize := ByteSwap(DataSize);
|
|
Stream.Write(ChunkSize, 4);
|
|
{The chunk name}
|
|
Move( ChnkName[ 1 ], NameBuf[ 0 ], 4 );
|
|
Stream.Write( NameBuf[ 0 ], 4 );
|
|
{If there is data for the chunk, write it}
|
|
if DataSize > 0 then Stream.Write(Data^, DataSize);
|
|
{Calculates and write CRC}
|
|
ChunkCRC := update_crc($ffffffff, @NameBuf[0], 4);
|
|
ChunkCRC := Byteswap(update_crc(ChunkCRC, Data, DataSize) xor $ffffffff);
|
|
Stream.Write(ChunkCRC, 4);
|
|
|
|
{Returns that everything went ok}
|
|
Result := TRUE;
|
|
end;
|
|
|
|
|
|
{Loads the chunk from a stream}
|
|
function TChunk.LoadFromStream(Stream: PStream; const ChunkName: TChunkName;
|
|
Size: Integer): Boolean;
|
|
var
|
|
CheckCRC: DWORD;
|
|
RightCRC: DWORD;
|
|
begin
|
|
{Copies data from source}
|
|
ResizeData(Size);
|
|
if Size > 0 then Stream.Read(fData^, Size);
|
|
{Reads CRC}
|
|
Stream.Read(CheckCRC, 4);
|
|
CheckCrc := ByteSwap(CheckCRC);
|
|
|
|
{Check if crc readed is valid}
|
|
RightCRC := update_crc($ffffffff, @ChunkName[0], 4);
|
|
RightCRC := update_crc(RightCRC, fData, Size) xor $ffffffff;
|
|
Result := RightCRC = CheckCrc;
|
|
|
|
{Handle CRC error}
|
|
if not Result and Owner.FErrorOnInvalidCRC then
|
|
begin
|
|
{In case it coult not load chunk}
|
|
Owner.FError := ErrInvalidCRC;
|
|
exit;
|
|
end
|
|
else
|
|
Result := TRUE;
|
|
|
|
end;
|
|
|
|
{TChunktIME implementation}
|
|
|
|
{Chunk being loaded from a stream}
|
|
function tIME_Load(Chunk: Pointer; Stream: PStream;
|
|
const ChunkName: TChunkName; Size: Integer): Boolean;
|
|
begin
|
|
{Let ancestor load the data}
|
|
Result := PChunk( Chunk ).LoadFromStream(Stream, ChunkName, Size);
|
|
if not Result or (Size <> 7) then exit; {Size must be 7}
|
|
|
|
{Reads data}
|
|
with PChunkTIME( Chunk )^ do
|
|
begin
|
|
fYear := pWord(Data)^;
|
|
fMonth := pByte(Longint(Data) + 2)^;
|
|
fDay := pByte(Longint(Data) + 3)^;
|
|
fHour := pByte(Longint(Data) + 4)^;
|
|
fMinute := pByte(Longint(Data) + 5)^;
|
|
fSecond := pByte(Longint(Data) + 6)^;
|
|
end;
|
|
end;
|
|
|
|
{Saving the chunk to a stream}
|
|
function tIME_Save(Chunk: Pointer; Stream: PStream): Boolean;
|
|
begin
|
|
with PChunkTIME( Chunk )^ do
|
|
begin
|
|
{Update data}
|
|
ResizeData(7); {Make sure the size is 7}
|
|
pWord(Data)^ := Year;
|
|
pByte(Longint(Data) + 2)^ := Month;
|
|
pByte(Longint(Data) + 3)^ := Day;
|
|
pByte(Longint(Data) + 4)^ := Hour;
|
|
pByte(Longint(Data) + 5)^ := Minute;
|
|
pByte(Longint(Data) + 6)^ := Second;
|
|
|
|
{Let inherited save data}
|
|
Result := SaveToStream(Stream);
|
|
end;
|
|
end;
|
|
|
|
{TChunktEXt implementation}
|
|
|
|
{Loading the chunk from a stream}
|
|
function tEXt_Load(Chunk: Pointer; Stream: PStream;
|
|
const ChunkName: TChunkName; Size: Integer): Boolean;
|
|
begin
|
|
{Load data from stream and validate}
|
|
Result := PChunk( Chunk ).LoadFromStream(Stream, ChunkName, Size);
|
|
if not Result or (Size < 3) then exit;
|
|
{Get text}
|
|
with PChunkTEXT( Chunk )^ do
|
|
begin
|
|
fKeyword := PChar(Data);
|
|
SetLength(fText, Size - Length(fKeyword) - 1);
|
|
CopyMemory(@fText[1], Ptr(Longint(Data) + Length(fKeyword) + 1),
|
|
Length(fText));
|
|
end;
|
|
end;
|
|
|
|
{Saving the chunk to a stream}
|
|
function tEXt_Save(Chunk: Pointer; Stream: PStream): Boolean;
|
|
begin
|
|
with PChunkTEXT( Chunk )^ do
|
|
begin
|
|
{Size is length from keyword, plus a null character to divide}
|
|
{plus the length of the text}
|
|
ResizeData(Length(fKeyword) + 1 + Length(fText));
|
|
Fillchar(Data^, DataSize, #0);
|
|
{Copy data}
|
|
if Keyword <> '' then
|
|
CopyMemory(Data, @fKeyword[1], Length(Keyword));
|
|
if Text <> '' then
|
|
CopyMemory(Ptr(Longint(Data) + Length(Keyword) + 1), @fText[1],
|
|
Length(Text));
|
|
{Let ancestor calculate crc and save}
|
|
Result := SaveToStream(Stream);
|
|
end;
|
|
end;
|
|
|
|
|
|
{TChunkIHDR implementation}
|
|
|
|
{Chunk being created}
|
|
constructor TChunkIHDR.Create(AOwner: PPngObject);
|
|
begin
|
|
{Call inherited}
|
|
inherited Create(AOwner);
|
|
{Prepare pointers}
|
|
ImageHandle := 0;
|
|
ImageDC := 0;
|
|
end;
|
|
|
|
{Chunk being destroyed}
|
|
destructor TChunkIHDR.Destroy;
|
|
begin
|
|
{Free memory}
|
|
FreeImageData();
|
|
|
|
{Calls TChunk destroy}
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{Release allocated image data}
|
|
procedure TChunkIHDR.FreeImageData;
|
|
begin
|
|
{Free old image data}
|
|
if ImageHandle <> 0 then DeleteObject(ImageHandle);
|
|
if ImageDC <> 0 then DeleteDC(ImageDC);
|
|
if ImageAlpha <> nil then FreeMem(ImageAlpha);
|
|
ImageHandle := 0; ImageDC := 0; ImageAlpha := nil; ImageData := nil;
|
|
end;
|
|
|
|
{Chunk being loaded from a stream}
|
|
function IHDR_Load(Chunk: Pointer; Stream: PStream; const ChunkName: TChunkName;
|
|
Size: Integer): Boolean;
|
|
begin
|
|
{Let TChunk load it}
|
|
Result := PChunk( Chunk ).LoadFromStream(Stream, ChunkName, Size);
|
|
if not Result then Exit;
|
|
|
|
with PChunkIHDR( Chunk )^ do
|
|
begin
|
|
{Now check values}
|
|
{Note: It's recommended by png specification to make sure that the size}
|
|
{must be 13 bytes to be valid, but some images with 14 bytes were found}
|
|
{which could be loaded by internet explorer and other tools}
|
|
if (fDataSize < SIZEOF(TIHdrData)) then
|
|
begin
|
|
{Ihdr must always have at least 13 bytes}
|
|
Result := False;
|
|
Owner.FError := ErrInvalidIHDR;
|
|
exit;
|
|
end;
|
|
|
|
{Everything ok, reads IHDR}
|
|
IHDRData := pIHDRData(fData)^;
|
|
IHDRData.Width := ByteSwap(IHDRData.Width);
|
|
IHDRData.Height := ByteSwap(IHDRData.Height);
|
|
|
|
{The width and height must not be larger than 65535 pixels}
|
|
if (IHDRData.Width > High(Word)) or (IHDRData.Height > High(Word)) then
|
|
begin
|
|
Result := False;
|
|
Owner.FError := ErrSizeExceeds;
|
|
exit;
|
|
end {if IHDRData.Width > High(Word)};
|
|
{Compression method must be 0 (inflate/deflate)}
|
|
if (IHDRData.CompressionMethod <> 0) then
|
|
begin
|
|
Result := False;
|
|
Owner.FError := ErrUnknownCompression;
|
|
exit;
|
|
end;
|
|
{Interlace must be either 0 (none) or 7 (adam7)}
|
|
if (IHDRData.InterlaceMethod <> 0) and (IHDRData.InterlaceMethod <> 1) then
|
|
begin
|
|
Result := False;
|
|
Owner.FError := ErrUnknownInterlace;
|
|
exit;
|
|
end;
|
|
|
|
{Updates owner properties}
|
|
Owner.InterlaceMethod := TInterlaceMethod(IHDRData.InterlaceMethod);
|
|
|
|
{Prepares data to hold image}
|
|
PrepareImageData();
|
|
end;
|
|
end;
|
|
|
|
{Saving the IHDR chunk to a stream}
|
|
function IHDR_Save(Chunk: Pointer; Stream: PStream): Boolean;
|
|
begin
|
|
with PChunkIHDR( Chunk )^ do
|
|
begin
|
|
{Ignore 2 bits images}
|
|
if BitDepth = 2 then BitDepth := 4;
|
|
|
|
{It needs to do is update the data with the IHDR data}
|
|
{structure containing the write values}
|
|
ResizeData(SizeOf(TIHDRData));
|
|
pIHDRData(fData)^ := IHDRData;
|
|
{..byteswap 4 byte types}
|
|
pIHDRData(fData)^.Width := ByteSwap(pIHDRData(fData)^.Width);
|
|
pIHDRData(fData)^.Height := ByteSwap(pIHDRData(fData)^.Height);
|
|
{..update interlace method}
|
|
pIHDRData(fData)^.InterlaceMethod := Byte(Owner.InterlaceMethod);
|
|
{..and then let the ancestor SaveToStream do the hard work}
|
|
Result := SaveToStream(Stream);
|
|
end;
|
|
end;
|
|
|
|
{Resizes the image data to fill the color type, bit depth, }
|
|
{width and height parameters}
|
|
procedure TChunkIHDR.PrepareImageData();
|
|
|
|
{Set the bitmap info}
|
|
procedure SetInfo(const Bitdepth: Integer; const Palette: Boolean);
|
|
begin
|
|
|
|
{Copy if the bitmap contain palette entries}
|
|
HasPalette := Palette;
|
|
{Initialize the structure with zeros}
|
|
fillchar(BitmapInfo, sizeof(BitmapInfo), #0);
|
|
{Fill the strucutre}
|
|
with BitmapInfo.bmiHeader do
|
|
begin
|
|
biSize := sizeof(TBitmapInfoHeader);
|
|
biHeight := Height;
|
|
biWidth := Width;
|
|
if Owner.Scale <> psFullImage then
|
|
begin
|
|
biHeight := Owner.ScaledHeight;
|
|
biWidth := Owner.ScaledWidth;
|
|
end;
|
|
biPlanes := 1;
|
|
biBitCount := BitDepth;
|
|
biCompression := BI_RGB;
|
|
end {with BitmapInfo.bmiHeader}
|
|
end;
|
|
begin
|
|
{Prepare bitmap info header}
|
|
Fillchar(BitmapInfo, sizeof(TMaxBitmapInfo), #0);
|
|
{Release old image data}
|
|
FreeImageData();
|
|
|
|
{Obtain number of bits for each pixel}
|
|
case ColorType of
|
|
COLOR_GRAYSCALE, COLOR_PALETTE, COLOR_GRAYSCALEALPHA:
|
|
case BitDepth of
|
|
{These are supported by windows}
|
|
1, 4, 8: SetInfo(BitDepth, TRUE);
|
|
{2 bits for each pixel is not supported by windows bitmap}
|
|
2 : SetInfo(4, TRUE);
|
|
{Also 16 bits (2 bytes) for each pixel is not supported}
|
|
{and should be transormed into a 8 bit grayscale}
|
|
16 : SetInfo(8, TRUE);
|
|
end;
|
|
{Only 1 byte (8 bits) is supported}
|
|
COLOR_RGB, COLOR_RGBALPHA: SetInfo(24, FALSE);
|
|
end {case ColorType};
|
|
{Number of bytes for each scanline}
|
|
BytesPerRow := (((BitmapInfo.bmiHeader.biBitCount * Owner.ScaledWidth) + 31)
|
|
and not 31) div 8;
|
|
|
|
if not Assigned( Owner.OnGetRow ) then
|
|
begin
|
|
{Build array for alpha information, if necessary}
|
|
if (ColorType = COLOR_RGBALPHA) or (ColorType = COLOR_GRAYSCALEALPHA) then
|
|
begin
|
|
ImageAlpha := AllocMem( Integer(Owner.ScaledWidth) * Integer(Owner.ScaledHeight) );
|
|
// (with zero memory)
|
|
end;
|
|
|
|
{Creates the image to hold the data, CreateDIBSection does a better}
|
|
{work in allocating necessary memory}
|
|
ImageDC := CreateCompatibleDC(0);
|
|
ImageHandle := CreateDIBSection(ImageDC, pBitmapInfo(@BitmapInfo)^,
|
|
DIB_RGB_COLORS, ImageData, 0, 0);
|
|
|
|
{Build array and allocate bytes for each row}
|
|
zeromemory(ImageData, BytesPerRow * Integer(Owner.ScaledHeight));
|
|
end;
|
|
end;
|
|
|
|
{TChunktRNS implementation}
|
|
|
|
{Sets the transpararent color}
|
|
procedure TChunktRNS.SetTransparentColor(const Value: ColorRef);
|
|
var
|
|
i: Byte;
|
|
LookColor: TRGBQuad;
|
|
begin
|
|
{Clears the palette values}
|
|
Fillchar(PaletteValues, SizeOf(PaletteValues), #0);
|
|
{Sets that it uses bit transparency}
|
|
fBitTransparency := True;
|
|
|
|
|
|
{Depends on the color type}
|
|
with Header^ do
|
|
case ColorType of
|
|
COLOR_GRAYSCALE:
|
|
begin
|
|
Self.ResizeData(BitDepth div 8);
|
|
PaletteValues[0] := GetRValue(Value);
|
|
end;
|
|
COLOR_RGB:
|
|
begin
|
|
Self.ResizeData((BitDepth div 8) * 3);
|
|
PaletteValues[0] := GetRValue(Value);
|
|
PaletteValues[1*(BitDepth div 8)] := GetGValue(Value);
|
|
PaletteValues[2*(BitDepth div 8)] := GetBValue(Value);
|
|
end;
|
|
COLOR_PALETTE:
|
|
begin
|
|
{Creates a RGBQuad to search for the color}
|
|
LookColor.rgbRed := GetRValue(Value);
|
|
LookColor.rgbGreen := GetGValue(Value);
|
|
LookColor.rgbBlue := GetBValue(Value);
|
|
{Look in the table for the entry}
|
|
for i := 0 to 255 do
|
|
if CompareMem(@BitmapInfo.bmiColors[i], @LookColor, 3) then
|
|
Break;
|
|
{Fill the transparency table}
|
|
Fillchar(PaletteValues, i, #255);
|
|
Self.ResizeData(i + 1)
|
|
|
|
end
|
|
end {case / with};
|
|
|
|
end;
|
|
|
|
{Returns the transparent color for the image}
|
|
function TChunktRNS.GetTransparentColor: ColorRef;
|
|
var
|
|
PaletteChunk: PChunkPLTE;
|
|
i: Integer;
|
|
begin
|
|
Result := 0; {Default: Unknown transparent color}
|
|
|
|
{Depends on the color type}
|
|
with Header^ do
|
|
case ColorType of
|
|
COLOR_GRAYSCALE: Result := RGB(PaletteValues[0], PaletteValues[0],
|
|
PaletteValues[0]);
|
|
COLOR_RGB:
|
|
if BitDepth = 8 then
|
|
Result := RGB(PaletteValues[0], PaletteValues[1], PaletteValues[2])
|
|
else
|
|
Result := RGB(PaletteValues[0], PaletteValues[2], PaletteValues[4]);
|
|
COLOR_PALETTE:
|
|
begin
|
|
{Obtains the palette chunk}
|
|
PaletteChunk := Pointer( Owner.ChunkByName('PLTE') );
|
|
|
|
{Looks for an entry with 0 transparency meaning that it is the}
|
|
{full transparent entry}
|
|
for i := 0 to Self.DataSize - 1 do
|
|
if PaletteValues[i] = 0 then
|
|
with PaletteChunk.GetPaletteItem(i) do
|
|
begin
|
|
Result := RGB(rgbRed, rgbGreen, rgbBlue);
|
|
break
|
|
end
|
|
end {COLOR_PALETTE}
|
|
end {case Header.ColorType};
|
|
end;
|
|
|
|
{Saving the chunk to a stream}
|
|
function tRNS_Save(Chunk: Pointer; Stream: PStream): Boolean;
|
|
begin
|
|
with PChunktRNS( Chunk )^ do
|
|
begin
|
|
{Copy palette into data buffer}
|
|
if DataSize <= 256 then
|
|
CopyMemory(fData, @PaletteValues[0], DataSize);
|
|
|
|
Result := SaveToStream(Stream);
|
|
end;
|
|
end;
|
|
|
|
{Loads the chunk from a stream}
|
|
function tRNS_Load(Chunk: Pointer; Stream: PStream; const ChunkName: TChunkName;
|
|
Size: Integer): Boolean;
|
|
var
|
|
i, Differ255: Integer;
|
|
begin
|
|
{Let inherited load}
|
|
Result := PChunk( Chunk ).LoadFromStream(Stream, ChunkName, Size);
|
|
|
|
if not Result then Exit;
|
|
|
|
with PChunktRNS( Chunk )^ do
|
|
begin
|
|
{Make sure size is correct}
|
|
if Size > 256 then
|
|
begin
|
|
Result := FALSE;
|
|
Owner.FError := ErrInvalidPalette;
|
|
exit;
|
|
end;
|
|
|
|
{The unset items should have value 255}
|
|
Fillchar(PaletteValues[0], 256, #255);
|
|
{Copy the other values}
|
|
CopyMemory(@PaletteValues[0], fData, Size);
|
|
|
|
{Create the mask if needed}
|
|
case Header.ColorType of
|
|
{Mask for grayscale and RGB}
|
|
COLOR_RGB, COLOR_GRAYSCALE: fBitTransparency := True;
|
|
COLOR_PALETTE:
|
|
begin
|
|
Differ255 := 0; {Count the entries with a value different from 255}
|
|
{Tests if it uses bit transparency}
|
|
for i := 0 to Size - 1 do
|
|
if PaletteValues[i] <> 255 then inc(Differ255);
|
|
|
|
{If it has one value different from 255 it is a bit transparency}
|
|
fBitTransparency := (Differ255 = 1);
|
|
end {COLOR_PALETTE}
|
|
end {case Header.ColorType};
|
|
end;
|
|
end;
|
|
|
|
{ZLIB support}
|
|
|
|
const
|
|
ZLIBAllocate = High(Word);
|
|
|
|
{Initializes ZLIB for decompression}
|
|
function ZLIBInitInflate(Stream: PStream): TZStreamRec2;
|
|
begin
|
|
{Fill record}
|
|
Fillchar(Result, SIZEOF(TZStreamRec2), #0);
|
|
|
|
{Set internal record information}
|
|
with Result do
|
|
begin
|
|
GetMem(Data, ZLIBAllocate);
|
|
fStream := Stream;
|
|
end;
|
|
|
|
{Init decompression}
|
|
InflateInit_(Result.zlib, zlib_version, SIZEOF(TZStreamRec));
|
|
end;
|
|
|
|
{Initializes ZLIB for compression}
|
|
function ZLIBInitDeflate(Stream: PStream;
|
|
Level: TCompressionlevel; Size: DWORD): TZStreamRec2;
|
|
begin
|
|
{Fill record}
|
|
Fillchar(Result, SIZEOF(TZStreamRec2), #0);
|
|
|
|
{Set internal record information}
|
|
with Result, ZLIB do
|
|
begin
|
|
GetMem(Data, Size);
|
|
fStream := Stream;
|
|
next_out := Data;
|
|
avail_out := Size;
|
|
end;
|
|
|
|
{Inits compression}
|
|
deflateInit_(Result.zlib, Level, zlib_version, sizeof(TZStreamRec));
|
|
end;
|
|
|
|
{Terminates ZLIB for compression}
|
|
procedure ZLIBTerminateDeflate(var ZLIBStream: TZStreamRec2);
|
|
begin
|
|
{Terminates decompression}
|
|
DeflateEnd(ZLIBStream.zlib);
|
|
{Free internal record}
|
|
FreeMem(ZLIBStream.Data); //, ZLIBAllocate);
|
|
end;
|
|
|
|
{Terminates ZLIB for decompression}
|
|
procedure ZLIBTerminateInflate(var ZLIBStream: TZStreamRec2);
|
|
begin
|
|
{Terminates decompression}
|
|
InflateEnd(ZLIBStream.zlib);
|
|
{Free internal record}
|
|
FreeMem(ZLIBStream.Data); //, ZLIBAllocate);
|
|
end;
|
|
|
|
{Prepares the image palette}
|
|
procedure TChunkIDAT.PreparePalette;
|
|
var
|
|
Entries: Word;
|
|
j : Integer;
|
|
begin
|
|
{In case the image uses grayscale, build a grayscale palette}
|
|
with Header^ do
|
|
if (ColorType = COLOR_GRAYSCALE) or (ColorType = COLOR_GRAYSCALEALPHA) then
|
|
begin
|
|
{Calculate total number of palette entries}
|
|
Entries := (1 shl Byte(BitmapInfo.bmiHeader.biBitCount));
|
|
|
|
FOR j := 0 TO Entries - 1 DO
|
|
with BitmapInfo.bmiColors[j] do
|
|
begin
|
|
|
|
{Calculate each palette entry}
|
|
rgbRed := fOwner.GammaTable[MulDiv(j, 255, Entries - 1)];
|
|
rgbGreen := rgbRed;
|
|
rgbBlue := rgbRed;
|
|
end {with BitmapInfo.bmiColors[j]}
|
|
end {if ColorType = COLOR_GRAYSCALE..., with Header}
|
|
end;
|
|
|
|
{Reads from ZLIB}
|
|
function TChunkIDAT.IDATZlibRead(var ZLIBStream: TZStreamRec2;
|
|
Buffer: Pointer; Count: Integer; var AEndPos: Integer;
|
|
var crcfile: DWORD): Integer;
|
|
var
|
|
ProcResult : Integer;
|
|
IDATHeader : Array[0..3] of char;
|
|
IDATCRC : DWORD;
|
|
begin
|
|
{Uses internal record pointed by ZLIBStream to gather information}
|
|
with ZLIBStream, ZLIBStream.zlib do
|
|
begin
|
|
{Set the buffer the zlib will read into}
|
|
next_out := Buffer;
|
|
avail_out := Count;
|
|
|
|
{Decode until it reach the Count variable}
|
|
while avail_out > 0 do
|
|
begin
|
|
{In case it needs more data and it's in the end of a IDAT chunk,}
|
|
{it means that there are more IDAT chunks}
|
|
if (fStream.Position = DWORD( AEndPos )) and (avail_out > 0) and
|
|
(avail_in = 0) then
|
|
begin
|
|
{End this chunk by reading and testing the crc value}
|
|
fStream.Read(IDATCRC, 4);
|
|
|
|
if Owner.FErrorOnInvalidCRC then
|
|
if crcfile xor $ffffffff <> DWORD(ByteSwap(IDATCRC)) then
|
|
begin
|
|
Result := -1;
|
|
Owner.FError := ErrInvalidCRC;
|
|
exit;
|
|
end;
|
|
|
|
{Start reading the next chunk}
|
|
fStream.Read(AEndPos, 4); {Reads next chunk size}
|
|
fStream.Read(IDATHeader[0], 4); {Next chunk header}
|
|
{It must be a IDAT chunk since image data is required and PNG}
|
|
{specification says that multiple IDAT chunks must be consecutive}
|
|
if IDATHeader <> 'IDAT' then
|
|
begin
|
|
Owner.FError := ErrMissingMultipleIDAT;
|
|
result := -1;
|
|
exit;
|
|
end;
|
|
|
|
{Calculate chunk name part of the crc}
|
|
crcfile := update_crc($ffffffff, @IDATHeader[0], 4);
|
|
|
|
AEndPos := fStream.Position + DWORD( ByteSwap(EndPos) );
|
|
end;
|
|
|
|
|
|
{In case it needs compressed data to read from}
|
|
if avail_in = 0 then
|
|
begin
|
|
{In case it's trying to read more than it is avaliable}
|
|
if fStream.Position + DWORD( ZLIBAllocate ) > DWORD( AEndPos ) then
|
|
avail_in := fStream.Read(Data^, DWORD( AEndPos ) - fStream.Position)
|
|
else
|
|
avail_in := fStream.Read(Data^, ZLIBAllocate);
|
|
{Update crc}
|
|
crcfile := update_crc(crcfile, Data, avail_in);
|
|
|
|
{In case there is no more compressed data to read from}
|
|
if avail_in = 0 then
|
|
begin
|
|
Result := Count - avail_out;
|
|
Exit;
|
|
end;
|
|
|
|
{Set next buffer to read and record current position}
|
|
next_in := Data;
|
|
|
|
end {if avail_in = 0};
|
|
|
|
ProcResult := inflate(zlib, 0);
|
|
|
|
{In case the result was not sucessfull}
|
|
if (ProcResult < 0) then
|
|
begin
|
|
Result := -1;
|
|
Owner.FError := ErrZLibError;
|
|
exit;
|
|
end;
|
|
|
|
end {while avail_out > 0};
|
|
|
|
end {with};
|
|
|
|
{If everything gone ok, it returns the count bytes}
|
|
Result := Count;
|
|
end;
|
|
|
|
{TChunkIDAT implementation}
|
|
|
|
const
|
|
{Adam 7 interlacing values}
|
|
RowStart: array[0..6] of Integer = (0, 0, 4, 0, 2, 0, 1);
|
|
ColumnStart: array[0..6] of Integer = (0, 4, 0, 2, 0, 1, 0);
|
|
RowIncrement: array[0..6] of Integer = (8, 8, 8, 4, 4, 2, 2);
|
|
ColumnIncrement: array[0..6] of Integer = (8, 8, 4, 4, 2, 2, 1);
|
|
MaxPass: array[TPngScale] of Integer = (6,4,2,0);
|
|
|
|
{Copy interlaced images with 1 byte for R, G, B}
|
|
procedure TChunkIDAT.CopyInterlacedRGB8(const Pass: Byte; Src,Dest,Trans: pChar);
|
|
var Col, incDest, incCol: Integer;
|
|
{$IFDEF ASM_VERSION}
|
|
iW: Integer;
|
|
GTable: Pointer;
|
|
{$ENDIF}
|
|
begin
|
|
Col := ColumnStart[Pass] shr ShiftScale;
|
|
Dest := pChar(Longint(Dest) + Col * 3);
|
|
incDest := (ColumnIncrement[Pass] shr ShiftScale) * 3 - 3;
|
|
incCol := ColumnIncrement[Pass] shr ShiftScale;
|
|
{$IFDEF ASM_VERSION}
|
|
iW := ImageWidth - Col;
|
|
GTable := @ fOwner.GammaTable[ 0 ];
|
|
asm
|
|
PUSH ESI
|
|
PUSH EDI
|
|
PUSH EBX
|
|
MOV ESI, [Src]
|
|
MOV EDI, [Dest]
|
|
MOV EBX, [GTable]
|
|
MOV ECX, [iW]
|
|
@@loop:
|
|
XOR EAX, EAX
|
|
LODSB
|
|
MOV DH, [EBX+EAX]
|
|
BSWAP EDX
|
|
LODSB
|
|
MOV DH, [EBX+EAX]
|
|
LODSB
|
|
MOV DL, [EBX+EAX]
|
|
XCHG EAX, EDX
|
|
STOSW
|
|
SHR EAX, 16
|
|
STOSB
|
|
ADD EDI, [incDest]
|
|
SUB ECX, [incCol]
|
|
JG @@loop
|
|
POP EBX
|
|
POP EDI
|
|
POP ESI
|
|
end;
|
|
{$ELSE}
|
|
{Get first column and enter in loop}
|
|
repeat
|
|
{Copy this row}
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Dest);
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; inc(Dest);
|
|
|
|
{Move to next column}
|
|
inc(Src, 3);
|
|
inc(Dest, incDest);
|
|
inc(Col, incCol);
|
|
until Col >= ImageWidth;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{Copy interlaced images with 2 bytes for R, G, B}
|
|
procedure TChunkIDAT.CopyInterlacedRGB16(const Pass: Byte; Src,Dest,Trans: pChar);
|
|
var Col, incDest, incCol: Integer;
|
|
{$IFDEF ASM_VERSION}
|
|
iW: Integer;
|
|
GTable: Pointer;
|
|
{$ENDIF}
|
|
begin
|
|
{Get first column and enter in loop}
|
|
Col := ColumnStart[Pass] shr ShiftScale;
|
|
Dest := pChar(Longint(Dest) + Col * 3);
|
|
incDest := (ColumnIncrement[Pass] shr ShiftScale) * 3 - 3;
|
|
incCol := ColumnIncrement[Pass] shr ShiftScale;
|
|
{$IFDEF ASM_VERSION}
|
|
iW := ImageWidth - Col;
|
|
GTable := @ fOwner.GammaTable[ 0 ];
|
|
asm
|
|
PUSH ESI
|
|
PUSH EDI
|
|
PUSH EBX
|
|
MOV ESI, [Src]
|
|
MOV EDI, [Dest]
|
|
MOV EBX, [GTable]
|
|
MOV ECX, [iW]
|
|
@@loop:
|
|
XOR EAX, EAX
|
|
LODSB
|
|
MOV DH, [EBX+EAX]
|
|
INC ESI
|
|
BSWAP EDX
|
|
LODSB
|
|
MOV DH, [EBX+EAX]
|
|
INC ESI
|
|
LODSB
|
|
MOV DL, [EBX+EAX]
|
|
INC ESI
|
|
XCHG EAX, EDX
|
|
STOSW
|
|
SHR EAX, 16
|
|
STOSB
|
|
ADD EDI, [incDest]
|
|
SUB ECX, [incCol]
|
|
JG @@loop
|
|
POP EBX
|
|
POP EDI
|
|
POP ESI
|
|
end;
|
|
{$ELSE}
|
|
repeat
|
|
{Copy this row}
|
|
Byte(Dest^) := Owner.GammaTable[pByte(Longint(Src) + 4)^]; inc(Dest);
|
|
Byte(Dest^) := Owner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
|
|
Byte(Dest^) := Owner.GammaTable[pByte(Longint(Src) )^]; inc(Dest);
|
|
|
|
{Move to next column}
|
|
inc(Src, 6);
|
|
inc(Dest, incDest);
|
|
inc(Col, incCol);
|
|
until Col >= ImageWidth;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{Copy �mages with palette using bit depths 1, 4 or 8}
|
|
procedure TChunkIDAT.CopyInterlacedPalette148(const Pass: Byte; Src,
|
|
Dest, Trans: pChar);
|
|
const
|
|
BitTable: Array[1..8] of Integer = ($1, $3, 0, $F, 0, 0, 0, $FF);
|
|
StartBit: Array[1..8] of Integer = (7 , 0 , 0, 4, 0, 0, 0, 0);
|
|
ShiftBitDepthTable: array[1..8] of Integer = (0, 1, 0, 2, 0, 0, 0, 3);
|
|
var
|
|
CurBit, Col: Integer;
|
|
Dest2: PChar;
|
|
BitMask, BitStart, BitDepth, incCol, ShiftBitDepth: Integer;
|
|
begin
|
|
{Get first column and enter in loop}
|
|
Col := ColumnStart[Pass] shr ShiftScale;
|
|
//Dest := pChar(Longint(Dest) + Col);
|
|
incCol := ColumnIncrement[Pass] shr ShiftScale;
|
|
BitDepth := Header.BitDepth;
|
|
BitMask := BitTable[BitDepth];
|
|
BitStart := StartBit[BitDepth];
|
|
ShiftBitDepth := ShiftBitDepthTable[ BitDepth ];
|
|
repeat
|
|
{Copy data}
|
|
CurBit := BitStart;
|
|
repeat
|
|
{Adjust pointer to pixel byte bounds}
|
|
Dest2 := pChar(Longint(Dest) + (Col shl ShiftBitDepth) shr 3);
|
|
{Copy data}
|
|
Byte(Dest2^) := Byte(Dest2^) or
|
|
( ((Byte(Src^) shr CurBit) and BitMask)
|
|
shl (BitStart - ((Col shl ShiftBitDepth) and 7)));
|
|
|
|
{Move to next column}
|
|
inc(Col, incCol);
|
|
{Will read next bits}
|
|
dec(CurBit, BitDepth);
|
|
until CurBit < 0;
|
|
|
|
{Move to next byte in source}
|
|
inc(Src);
|
|
until Col >= ImageWidth;
|
|
end;
|
|
|
|
{Copy �mages with palette using bit depth 2}
|
|
procedure TChunkIDAT.CopyInterlacedPalette2(const Pass: Byte; Src,
|
|
Dest, Trans: pChar);
|
|
var
|
|
CurBit, Col: Integer;
|
|
Dest2: PChar;
|
|
incCol: Integer;
|
|
begin
|
|
{Get first column and enter in loop}
|
|
Col := ColumnStart[Pass] shr ShiftScale;
|
|
incCol := ColumnIncrement[Pass] shr ShiftScale;
|
|
repeat
|
|
{Copy data}
|
|
CurBit := 6;
|
|
repeat
|
|
{Adjust pointer to pixel byte bounds}
|
|
Dest2 := pChar(Longint(Dest) + (Col shr 1));
|
|
{Copy data}
|
|
Byte(Dest2^) := Byte(Dest2^) or (((Byte(Src^) shr CurBit) and $3)
|
|
shl (4 - (Col shl 2) mod 8));
|
|
{Move to next column}
|
|
inc(Col, incCol);
|
|
{Will read next bits}
|
|
dec(CurBit, 2);
|
|
until CurBit < 0;
|
|
|
|
{Move to next byte in source}
|
|
inc(Src);
|
|
until Col >= ImageWidth;
|
|
end;
|
|
|
|
{Copy �mages with grayscale using bit depth 2}
|
|
procedure TChunkIDAT.CopyInterlacedGray2(const Pass: Byte; Src,
|
|
Dest, Trans: pChar);
|
|
var
|
|
CurBit, Col, incCol: Integer;
|
|
Dest2: PChar;
|
|
begin
|
|
{Get first column and enter in loop}
|
|
Col := ColumnStart[Pass] shr ShiftScale;
|
|
incCol := ColumnIncrement[Pass] shr ShiftScale;
|
|
repeat
|
|
{Copy data}
|
|
CurBit := 6;
|
|
repeat
|
|
{Adjust pointer to pixel byte bounds}
|
|
Dest2 := pChar(Longint(Dest) + Col div 2);
|
|
{Copy data}
|
|
Byte(Dest2^) := Byte(Dest2^) or ((((Byte(Src^) shr CurBit) shl 2) and $F)
|
|
shl (4 - (Col shl 2) mod 8));
|
|
{Move to next column}
|
|
inc(Col, incCol);
|
|
{Will read next bits}
|
|
dec(CurBit, 2);
|
|
until CurBit < 0;
|
|
|
|
{Move to next byte in source}
|
|
inc(Src);
|
|
until Col >= ImageWidth;
|
|
end;
|
|
|
|
{Copy �mages with palette using 2 bytes for each pixel}
|
|
procedure TChunkIDAT.CopyInterlacedGrayscale16(const Pass: Byte; Src,
|
|
Dest, Trans: pChar);
|
|
var
|
|
Col, incColDest: Integer;
|
|
begin
|
|
{Get first column and enter in loop}
|
|
Col := ColumnStart[Pass] shr ShiftScale;
|
|
Dest := pChar(Longint(Dest) + Col);
|
|
incColDest := ColumnIncrement[Pass] shr ShiftScale;
|
|
repeat
|
|
{Copy this row}
|
|
Dest^ := Src^; //inc(Dest);
|
|
|
|
{Move to next column}
|
|
inc(Src, 2);
|
|
inc(Dest, incColDest);
|
|
inc(Col, incColDest);
|
|
until Col >= ImageWidth;
|
|
end;
|
|
|
|
{Decodes interlaced RGB alpha with 1 byte for each sample}
|
|
procedure TChunkIDAT.CopyInterlacedRGBAlpha8(const Pass: Byte;
|
|
Src, Dest, Trans: pChar);
|
|
var
|
|
Col, incDest, incTrans, incCol: Integer;
|
|
begin
|
|
{Get first column and enter in loop}
|
|
Col := ColumnStart[Pass] shr ShiftScale;
|
|
Dest := pChar(Longint(Dest) + Col * 3);
|
|
Trans := pChar(Longint(Trans) + Col);
|
|
incDest := (ColumnIncrement[Pass] shr ShiftScale) * 3 - 2;
|
|
incTrans := ColumnIncrement[Pass] shr ShiftScale;
|
|
incCol := ColumnIncrement[Pass] shr ShiftScale;
|
|
repeat
|
|
{Copy this row and alpha value}
|
|
Trans^ := pChar(Longint(Src) + 3)^;
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Dest);
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; //inc(Dest);
|
|
|
|
{Move to next column}
|
|
inc(Src, 4);
|
|
inc(Dest, incDest);
|
|
inc(Trans, incTrans);
|
|
inc(Col, incCol);
|
|
until Col >= ImageWidth;
|
|
end;
|
|
|
|
{Decodes interlaced RGB alpha with 2 bytes for each sample}
|
|
procedure TChunkIDAT.CopyInterlacedRGBAlpha16(const Pass: Byte;
|
|
Src, Dest, Trans: pChar);
|
|
var
|
|
Col, incDest, incTrans, incCol: Integer;
|
|
begin
|
|
{Get first column and enter in loop}
|
|
Col := ColumnStart[Pass] shr ShiftScale;
|
|
Dest := pChar(Longint(Dest) + Col * 3);
|
|
Trans := pChar(Longint(Trans) + Col);
|
|
incDest := (ColumnIncrement[Pass] shr ShiftScale) * 3 - 2;
|
|
incTrans := ColumnIncrement[Pass] shr ShiftScale;
|
|
incCol := ColumnIncrement[Pass] shr ShiftScale;
|
|
repeat
|
|
{Copy this row and alpha value}
|
|
Trans^ := pChar(Longint(Src) + 6)^;
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 4)^]; inc(Dest);
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; //inc(Dest);
|
|
|
|
{Move to next column}
|
|
inc(Src, 8);
|
|
inc(Dest, incDest);
|
|
inc(Trans, incTrans);
|
|
inc(Col, incCol);
|
|
until Col >= ImageWidth;
|
|
end;
|
|
|
|
{Decodes 8 bit grayscale image followed by an alpha sample}
|
|
procedure TChunkIDAT.CopyInterlacedGrayscaleAlpha8(const Pass: Byte;
|
|
Src, Dest, Trans: pChar);
|
|
var
|
|
Col, incDest, incTrans, incCol: Integer;
|
|
begin
|
|
{Get first column, pointers to the data and enter in loop}
|
|
Col := ColumnStart[Pass] shr ShiftScale;
|
|
Dest := pChar(Longint(Dest) + Col);
|
|
Trans := pChar(Longint(Trans) + Col);
|
|
incDest := ColumnIncrement[Pass] shr ShiftScale;
|
|
incTrans := ColumnIncrement[Pass] shr ShiftScale;
|
|
incCol := ColumnIncrement[Pass] shr ShiftScale;
|
|
|
|
repeat
|
|
{Copy this grayscale value and alpha}
|
|
Dest^ := Src^; inc(Src);
|
|
Trans^ := Src^; inc(Src);
|
|
|
|
{Move to next column}
|
|
inc(Dest, incDest);
|
|
inc(Trans, incTrans);
|
|
inc(Col, incCol);
|
|
until Col >= ImageWidth;
|
|
end;
|
|
|
|
{Decodes 16 bit grayscale image followed by an alpha sample}
|
|
procedure TChunkIDAT.CopyInterlacedGrayscaleAlpha16(const Pass: Byte;
|
|
Src, Dest, Trans: pChar);
|
|
var
|
|
Col, incDest, incTrans, incCol: Integer;
|
|
begin
|
|
{Get first column, pointers to the data and enter in loop}
|
|
Col := ColumnStart[Pass] shr ShiftScale;
|
|
Dest := pChar(Longint(Dest) + Col);
|
|
Trans := pChar(Longint(Trans) + Col);
|
|
incDest := ColumnIncrement[Pass] shr ShiftScale;
|
|
incTrans := ColumnIncrement[Pass] shr ShiftScale;
|
|
incCol := ColumnIncrement[Pass] shr ShiftScale;
|
|
|
|
repeat
|
|
{Copy this grayscale value and alpha, transforming 16 bits into 8}
|
|
Dest^ := Src^; inc(Src, 2);
|
|
Trans^ := Src^; inc(Src, 2);
|
|
|
|
{Move to next column}
|
|
inc(Dest, incDest);
|
|
inc(Trans, incTrans);
|
|
inc(Col, incCol);
|
|
until Col >= ImageWidth;
|
|
end;
|
|
|
|
{Decodes an interlaced image}
|
|
procedure TChunkIDAT.DecodeInterlacedAdam7(Stream: PStream;
|
|
var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: DWORD);
|
|
var
|
|
CurrentPass: Byte;
|
|
PixelsThisRow: Integer;
|
|
CurrentRow, CurOutRow: Integer;
|
|
Trans, Dta: pChar;
|
|
CopyProc: procedure(const Pass: Byte; Src, Dest, Trans: pChar) of object;
|
|
progress: Integer;
|
|
W, H: Integer;
|
|
Stop: Boolean;
|
|
begin
|
|
|
|
CopyProc := nil; {Initialize}
|
|
{Determine method to copy the image data}
|
|
case Header.ColorType of
|
|
{R, G, B values for each pixel}
|
|
COLOR_RGB:
|
|
case Header.BitDepth of
|
|
8: CopyProc := CopyInterlacedRGB8;
|
|
16: CopyProc := CopyInterlacedRGB16;
|
|
end {case Header.BitDepth};
|
|
{Palette}
|
|
COLOR_PALETTE, COLOR_GRAYSCALE:
|
|
case Header.BitDepth of
|
|
1, 4, 8: CopyProc := CopyInterlacedPalette148;
|
|
2 : if Header.ColorType = COLOR_PALETTE then
|
|
CopyProc := CopyInterlacedPalette2
|
|
else
|
|
CopyProc := CopyInterlacedGray2;
|
|
16 : CopyProc := CopyInterlacedGrayscale16;
|
|
end;
|
|
{RGB followed by alpha}
|
|
COLOR_RGBALPHA:
|
|
case Header.BitDepth of
|
|
8: CopyProc := CopyInterlacedRGBAlpha8;
|
|
16: CopyProc := CopyInterlacedRGBAlpha16;
|
|
end;
|
|
{Grayscale followed by alpha}
|
|
COLOR_GRAYSCALEALPHA:
|
|
case Header.BitDepth of
|
|
8: CopyProc := CopyInterlacedGrayscaleAlpha8;
|
|
16: CopyProc := CopyInterlacedGrayscaleAlpha16;
|
|
end;
|
|
end {case Header.ColorType};
|
|
|
|
{Prepare ShiftScale}
|
|
CASE Owner.Scale OF
|
|
psHalfSize : ShiftScale := 1;
|
|
psQuarterSize: ShiftScale := 2;
|
|
psEightsSize : ShiftScale := 3;
|
|
else ShiftScale := 0;
|
|
END;
|
|
|
|
{Adam7 method has 7 passes to make the final image}
|
|
FOR CurrentPass := 0 TO MaxPass[fOwner.fScale] DO
|
|
begin
|
|
if Assigned( Owner.fOnProgress ) then
|
|
begin
|
|
progress := CurrentPass * 100 div (MaxPass[fOwner.fScale]+1);
|
|
if not Owner.fOnProgress( Owner, CurrentPass, MaxPass[fOwner.fScale], progress ) then
|
|
break;
|
|
end;
|
|
{Calculates the number of pixels and bytes for this pass row}
|
|
PixelsThisRow := (Owner.Width - (ColumnStart[CurrentPass]) +
|
|
(ColumnIncrement[CurrentPass]) - 1)
|
|
div (ColumnIncrement[CurrentPass]);
|
|
Row_Bytes := BytesForPixels(PixelsThisRow, Header.ColorType,
|
|
Header.BitDepth);
|
|
{Clear buffer for this pass}
|
|
ZeroMemory(Row_Buffer[not RowUsed], Row_Bytes);
|
|
|
|
{Get current row index}
|
|
CurrentRow := RowStart[CurrentPass];
|
|
CurOutRow := CurrentRow shr ShiftScale;
|
|
{Get a pointer to the current row image data}
|
|
if not Assigned( Owner.OnGetRow ) then
|
|
begin
|
|
Dta := Ptr(Longint(Header.ImageData) + Header.BytesPerRow *
|
|
(ImageHeight - 1 - CurOutRow));
|
|
Trans := Ptr(Longint(Header.ImageAlpha) + ImageWidth * CurOutRow);
|
|
end;
|
|
|
|
if Row_Bytes > 0 then {There must have bytes for this interlaced pass}
|
|
while CurrentRow < Owner.Height do
|
|
begin
|
|
if Assigned( Owner.fOnProgress ) then
|
|
begin
|
|
if MaxPass[fOwner.fScale] > 0 then
|
|
progress := Round( CurrentPass * 100 / (MaxPass[fOwner.fScale]+1) +
|
|
CurrentRow * 100 / ImageHeight / (MaxPass[fOwner.fScale]+1) )
|
|
else progress := CurrentRow * 100 div (ImageHeight-1);
|
|
if not Owner.fOnProgress( Owner, CurrentPass, MaxPass[fOwner.fScale], progress ) then
|
|
break;
|
|
end;
|
|
{Reads this line and filter}
|
|
if IDATZlibRead(ZLIBStream, @Row_Buffer[RowUsed][0], Row_Bytes + 1,
|
|
EndPos, CRCFile) = 0 then break;
|
|
|
|
FilterRow;
|
|
{Copy image data}
|
|
if CurOutRow < ImageHeight then
|
|
begin
|
|
if Assigned( Owner.OnGetRow ) then
|
|
begin
|
|
W := Owner.Width;
|
|
H := Owner.Height;
|
|
Stop := FALSE;
|
|
Owner.OnGetRow( Owner, CurrentRow, W, H, PByte( Dta ), PByte( Trans ), Stop );
|
|
if Stop then Exit;
|
|
end;
|
|
CopyProc(CurrentPass, @Row_Buffer[RowUsed][1], Dta, Trans);
|
|
if Assigned( Owner.OnGetRow ) then
|
|
begin
|
|
W := -Owner.Width;
|
|
H := Owner.Height;
|
|
Stop := FALSE;
|
|
Owner.OnGetRow( Owner, CurrentRow, W, H, PByte( Dta ), PByte( Trans ), Stop );
|
|
if Stop then Exit;
|
|
end;
|
|
end;
|
|
|
|
{Use the other RowBuffer item}
|
|
RowUsed := not RowUsed;
|
|
|
|
{Move to the next row}
|
|
inc(CurrentRow, RowIncrement[CurrentPass]);
|
|
inc(CurOutRow, RowIncrement[CurrentPass] shr ShiftScale);
|
|
{Move pointer to the next line}
|
|
dec(Dta, (RowIncrement[CurrentPass] shr ShiftScale) * Header.BytesPerRow);
|
|
inc(Trans, (RowIncrement[CurrentPass] shr ShiftScale) * ImageWidth);
|
|
end {while CurrentRow < ImageHeight};
|
|
|
|
end {FOR CurrentPass};
|
|
|
|
end;
|
|
|
|
{Copy 8 bits RGB image}
|
|
procedure TChunkIDAT.CopyNonInterlacedRGB8(Src, Dest, Trans: pChar);
|
|
var I {$IFDEF ASM_VERSION} , incSrc {$ENDIF}: Integer;
|
|
begin
|
|
{$IFDEF ASM_VERSION}
|
|
I := ImageWidth;
|
|
incSrc := 3 shl ShiftScale - 4;
|
|
asm
|
|
PUSH ESI
|
|
PUSH EDI
|
|
PUSH EBP
|
|
MOV ESI, [Src]
|
|
MOV EDI, [Dest]
|
|
MOV ECX, [I]
|
|
MOV EBP, [incSrc]
|
|
@@loop:
|
|
LODSD
|
|
BSWAP EAX
|
|
ADD ESI, EBP
|
|
SHR EAX, 8
|
|
STOSW
|
|
SHR EAX, 16
|
|
STOSB
|
|
LOOP @@loop
|
|
POP EBP
|
|
POP EDI
|
|
POP ESI
|
|
end;
|
|
{$ELSE}
|
|
FOR I := 1 TO ImageWidth DO
|
|
begin
|
|
{Copy pixel values}
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Dest);
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; inc(Dest);
|
|
{Move to next pixel}
|
|
inc(Src, 3 shl ShiftScale);
|
|
end {for I}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{Copy 16 bits RGB image}
|
|
procedure TChunkIDAT.CopyNonInterlacedRGB16(Src, Dest, Trans: pChar);
|
|
var I, incSrc: Integer;
|
|
{$IFDEF ASM_VERSION}
|
|
GTable: Pointer;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF ASM_VERSION}
|
|
I := ImageWidth;
|
|
GTable := @ fOwner.GammaTable[0];
|
|
incSrc := 6 shl ShiftScale - 5;
|
|
asm
|
|
PUSH ESI
|
|
PUSH EDI
|
|
PUSH EBX
|
|
PUSH EBP
|
|
MOV ESI, [Src]
|
|
MOV EDI, [Dest]
|
|
MOV EBX, [GTable]
|
|
MOV ECX, [I]
|
|
MOV EBP, [incSrc]
|
|
XOR EAX, EAX
|
|
@@loop:
|
|
LODSB
|
|
MOV DH, [EBX+EAX]
|
|
INC ESI
|
|
BSWAP EDX
|
|
LODSB
|
|
MOV DH, [EBX+EAX]
|
|
INC ESI
|
|
LODSB
|
|
MOV DL, [EBX+EAX ]
|
|
ADD ESI, EBP
|
|
XCHG EAX, EDX
|
|
STOSW
|
|
SHR EAX, 16
|
|
STOSB
|
|
XCHG EAX, EDX
|
|
LOOP @@loop
|
|
POP EBP
|
|
POP EBX
|
|
POP EDI
|
|
POP ESI
|
|
end;
|
|
{$ELSE}
|
|
incSrc := 6 shl ShiftScale;
|
|
FOR I := 1 TO ImageWidth DO
|
|
begin
|
|
//Since windows does not supports (perhaps it does ?) 2 bytes for
|
|
//each R, G, B value, the method will read only 1 byte from it
|
|
{Copy pixel values}
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 4)^]; inc(Dest);
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; inc(Dest);
|
|
{Move to next pixel}
|
|
inc(Src, incSrc);
|
|
end {for I}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{Copy types using palettes (1, 4 or 8 bits per pixel)}
|
|
procedure TChunkIDAT.CopyNonInterlacedPalette148(Src, Dest, Trans: pChar);
|
|
var I, incSrc: Integer;
|
|
begin
|
|
{It's simple as copying the data}
|
|
if ShiftScale = 0 then
|
|
//CopyMemory(Dest, Src, Row_Bytes)
|
|
Move( Src^, Dest^, Row_Bytes )
|
|
else
|
|
{$IFDEF ASM_VERSION}
|
|
begin
|
|
I := ImageWidth * (Header.BitDepth div 8);
|
|
incSrc := 1 shl ShiftScale - 1;
|
|
asm
|
|
PUSH ESI
|
|
PUSH EDI
|
|
PUSH EBP
|
|
MOV ESI, [Src]
|
|
MOV EDI, [Dest]
|
|
MOV ECX, [I]
|
|
MOV EBP, [incSrc]
|
|
@@loop:
|
|
MOVSB
|
|
ADD ESI, EBP
|
|
LOOP @@loop
|
|
POP EBP
|
|
POP EDI
|
|
POP ESI
|
|
end;
|
|
end
|
|
{$ELSE}
|
|
begin
|
|
incSrc := 1 shl ShiftScale;
|
|
FOR I := 1 TO ImageWidth * (Header.BitDepth div 8) DO
|
|
begin
|
|
Byte(Dest^) := pByte(Longint(Src))^; inc(Dest);
|
|
{Move to next pixel}
|
|
inc(Src, incSrc);
|
|
end {for I}
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{Copy grayscale types using 2 bits for each pixel}
|
|
procedure TChunkIDAT.CopyNonInterlacedGray2(Src, Dest, Trans: pChar);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
{2 bits is not supported, this routine will converted into 4 bits}
|
|
FOR i := 1 TO Row_Bytes do
|
|
begin
|
|
Byte(Dest^) := ((Byte(Src^) shr 2) and $F) or ((Byte(Src^)) and $F0); inc(Dest);
|
|
Byte(Dest^) := ((Byte(Src^) shl 2) and $F) or ((Byte(Src^) shl 4) and $F0); inc(Dest);
|
|
inc(Src, 1 shl ShiftScale);
|
|
end {FOR i}
|
|
end;
|
|
|
|
{Copy types using palette with 2 bits for each pixel}
|
|
var Palette2_To_Palette4_Initialized: Boolean;
|
|
Palette2_To_Palette4: array[ 0..255 ] of Word;
|
|
|
|
procedure Init_Palette2_To_Palette4;
|
|
var i: Integer;
|
|
begin
|
|
Palette2_To_Palette4_Initialized := TRUE;
|
|
for i := 0 to 255 do
|
|
begin
|
|
Palette2_To_Palette4[ i ] := (i shr 4) and 3 or (i shr 2) and $30 or
|
|
( ( (i and 3) or (i shl 2) and $30 ) shl 8);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TChunkIDAT.CopyNonInterlacedPalette2(Src, Dest, Trans: pChar);
|
|
var I {$IFDEF ASM_VERSION}, incSrc {$ENDIF}: Integer;
|
|
begin
|
|
{$IFDEF ASM_VERSION}
|
|
if not Palette2_To_Palette4_Initialized then
|
|
Init_Palette2_To_Palette4;
|
|
I := Row_Bytes;
|
|
incSrc := 1 shl ShiftScale - 1;
|
|
asm
|
|
PUSH ESI
|
|
PUSH EDI
|
|
PUSH EBX
|
|
PUSH EBP
|
|
MOV ESI, [Src]
|
|
MOV EDI, [Dest]
|
|
MOV ECX, [I]
|
|
LEA EBX, [Palette2_To_Palette4]
|
|
MOV EBP, [incSrc]
|
|
@@loop:
|
|
XOR EAX, EAX
|
|
LODSB
|
|
MOV AX, word ptr [EBX+EAX*2]
|
|
STOSW
|
|
ADD ESI, EBP
|
|
LOOP @@loop
|
|
POP EBP
|
|
POP EDI
|
|
POP EBX
|
|
POP ESI
|
|
end;
|
|
{$ELSE}
|
|
{2 bits is not supported, this routine will converted into 4 bits}
|
|
FOR i := 1 TO Row_Bytes do
|
|
begin
|
|
Byte(Dest^) := ((Byte(Src^) shr 4) and $3) or ((Byte(Src^) shr 2) and $30); inc(Dest);
|
|
Byte(Dest^) := (Byte(Src^) and $3) or ((Byte(Src^) shl 2) and $30); inc(Dest);
|
|
inc(Src, 1 shl ShiftScale);
|
|
end {FOR i}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{Copy grayscale images with 16 bits}
|
|
procedure TChunkIDAT.CopyNonInterlacedGrayscale16(Src, Dest, Trans: pChar);
|
|
var I {$IFDEF ASM_VERSION}, incSrc{$ENDIF}: Integer;
|
|
begin
|
|
{$IFDEF ASM_VERSION}
|
|
I := ImageWidth;
|
|
incSrc := 2 shl ShiftScale - 1;
|
|
asm
|
|
PUSH ESI
|
|
PUSH EDI
|
|
PUSH EBP
|
|
MOV ESI, [Src]
|
|
MOV EDI, [Dest]
|
|
MOV ECX, [I]
|
|
MOV EBP, [incSrc]
|
|
@@loop:
|
|
MOVSB
|
|
ADD ESI, EBP
|
|
LOOP @@loop
|
|
POP EBP
|
|
POP EDI
|
|
POP ESI
|
|
end;
|
|
{$ELSE}
|
|
FOR I := 1 TO ImageWidth DO
|
|
begin
|
|
{Windows does not supports 16 bits for each pixel in grayscale}
|
|
{mode, so reduce to 8}
|
|
Dest^ := Src^; inc(Dest);
|
|
{Move to next pixel}
|
|
inc(Src, 2 shl ShiftScale);
|
|
end {for I}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{Copy 8 bits per sample RGB images followed by an alpha byte}
|
|
procedure TChunkIDAT.CopyNonInterlacedRGBAlpha8(Src, Dest, Trans: pChar);
|
|
var I: Integer;
|
|
{$IFDEF ASM_VERSION}
|
|
incSrc: Integer;
|
|
GTable: Pointer;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF ASM_VERSION}
|
|
if not Palette2_To_Palette4_Initialized then
|
|
Init_Palette2_To_Palette4;
|
|
I := ImageWidth;
|
|
GTable := @ fOwner.GammaTable[0];
|
|
incSrc := (4 shl ShiftScale) - 4;
|
|
asm
|
|
PUSH ESI
|
|
PUSH EDI
|
|
PUSH EBX
|
|
PUSH EBP
|
|
MOV ESI, [Src]
|
|
MOV EDI, [Dest]
|
|
MOV ECX, [I]
|
|
SHL ECX, 8
|
|
MOV EBX, [GTable]
|
|
MOV CL, byte ptr [incSrc]
|
|
MOV EBP, [Trans]
|
|
@@loop:
|
|
XOR EAX, EAX
|
|
LODSB
|
|
MOV DH, [EBX+EAX]
|
|
BSWAP EDX
|
|
LODSB
|
|
MOV DH, [EBX+EAX]
|
|
LODSB
|
|
MOV DL, [EBX+EAX]
|
|
MOV EAX, EDX
|
|
STOSW
|
|
SHR EAX, 16
|
|
STOSB
|
|
LODSB
|
|
MOV [EBP], AL
|
|
INC EBP
|
|
MOVZX EAX, CL
|
|
ADD ESI, EAX
|
|
SUB ECX, 256
|
|
MOV EAX, ECX
|
|
SHR EAX, 8
|
|
JNZ @@loop
|
|
POP EBP
|
|
POP EBX
|
|
POP EDI
|
|
POP ESI
|
|
end;
|
|
{$ELSE}
|
|
FOR I := 1 TO ImageWidth DO
|
|
begin
|
|
{Copy pixel values and transparency}
|
|
Trans^ := pChar(Longint(Src) + 3)^; inc(Trans);
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 1)^]; inc(Dest);
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; inc(Dest);
|
|
{Move to next pixel}
|
|
inc(Src, 4 shl ShiftScale);
|
|
end {for I}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{Copy 16 bits RGB image with alpha using 2 bytes for each sample}
|
|
procedure TChunkIDAT.CopyNonInterlacedRGBAlpha16(Src, Dest, Trans: pChar);
|
|
var I: Integer;
|
|
{$IFDEF ASM_VERSION}
|
|
incSrc: Integer;
|
|
GTable: Pointer;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF ASM_VERSION}
|
|
if not Palette2_To_Palette4_Initialized then
|
|
Init_Palette2_To_Palette4;
|
|
I := ImageWidth;
|
|
GTable := @ fOwner.GammaTable[0];
|
|
incSrc := 8 shl ShiftScale + 1;
|
|
asm
|
|
PUSH ESI
|
|
PUSH EDI
|
|
PUSH EBX
|
|
PUSH EBP
|
|
MOV ESI, [Src]
|
|
MOV EDI, [Dest]
|
|
MOV ECX, [I]
|
|
SHL ECX, 8
|
|
LEA EBX, [GTable]
|
|
MOV CL, byte ptr [incSrc]
|
|
MOV EBP, [Trans]
|
|
@@loop:
|
|
XOR EAX, EAX
|
|
LODSB
|
|
MOV DH, [EBX+EAX]
|
|
INC ESI
|
|
BSWAP EDX
|
|
LODSB
|
|
MOV DH, [EBX+EAX]
|
|
INC ESI
|
|
LODSB
|
|
MOV DL, [EBX+EAX]
|
|
INC ESI
|
|
MOV EAX, EDX
|
|
STOSW
|
|
SHR EAX, 16
|
|
STOSB
|
|
LODSB
|
|
MOV [EBP], AL
|
|
INC EBP
|
|
MOVZX EAX, CL
|
|
ADD ESI, EAX
|
|
SUB ECX, 256
|
|
MOV EAX, ECX
|
|
SHR EAX, 8
|
|
JNZ @@loop
|
|
POP EBP
|
|
POP EDI
|
|
POP EBX
|
|
POP ESI
|
|
end;
|
|
{$ELSE}
|
|
FOR I := 1 TO ImageWidth DO
|
|
begin
|
|
//Copy rgb and alpha values (transforming from 16 bits to 8 bits)
|
|
{Copy pixel values}
|
|
Trans^ := pChar(Longint(Src) + 6)^; inc(Trans);
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 4)^]; inc(Dest);
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) + 2)^]; inc(Dest);
|
|
Byte(Dest^) := fOwner.GammaTable[pByte(Longint(Src) )^]; inc(Dest);
|
|
{Move to next pixel}
|
|
inc(Src, 8 shl ShiftScale);
|
|
end {for I}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{Copy 8 bits per sample grayscale followed by alpha}
|
|
procedure TChunkIDAT.CopyNonInterlacedGrayscaleAlpha8(Src, Dest, Trans: PChar);
|
|
var I{$IFDEF ASM_VERSION}, incSrc{$ENDIF}: Integer;
|
|
begin
|
|
{$IFDEF ASM_VERSION}
|
|
I := ImageWidth;
|
|
incSrc := 2 shl ShiftScale - 1;
|
|
asm
|
|
PUSH ESI
|
|
PUSH EDI
|
|
PUSH EBX
|
|
PUSH EBP
|
|
MOV ESI, [Src]
|
|
MOV EDI, [Dest]
|
|
MOV EBX, [Trans]
|
|
MOV ECX, [I]
|
|
MOV EBP, [incSrc]
|
|
@@loop:
|
|
LODSW
|
|
STOSB
|
|
MOV [EBX], AH
|
|
ADD ESI, EBP
|
|
INC EBX
|
|
LOOP @@loop
|
|
POP EBP
|
|
POP EBX
|
|
POP EDI
|
|
POP ESI
|
|
end;
|
|
{$ELSE}
|
|
FOR I := 1 TO ImageWidth DO
|
|
begin
|
|
{Copy alpha value and then gray value}
|
|
Dest^ := Src^; inc(Src);
|
|
Trans^ := Src^; inc(Src, (2 shl ShiftScale) - 1);
|
|
inc(Dest); inc(Trans);
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{Copy 16 bits per sample grayscale followed by alpha}
|
|
procedure TChunkIDAT.CopyNonInterlacedGrayscaleAlpha16(Src, Dest, Trans: PChar);
|
|
var I {$IFDEF ASM_VERSION}, incSrc{$ENDIF}: Integer;
|
|
begin
|
|
{$IFDEF ASM_VERSION}
|
|
I := ImageWidth;
|
|
incSrc := 4 shl ShiftScale - 4;
|
|
asm
|
|
PUSH ESI
|
|
PUSH EDI
|
|
PUSH EBX
|
|
PUSH EBP
|
|
MOV ESI, [Src]
|
|
MOV EDI, [Dest]
|
|
MOV EBX, [Trans]
|
|
MOV ECX, [I]
|
|
MOV EBP, [incSrc]
|
|
@@loop:
|
|
LODSD
|
|
STOSB
|
|
SHR EAX, 16
|
|
MOV [EBX], AL
|
|
ADD ESI, EBP
|
|
INC EBX
|
|
LOOP @@loop
|
|
POP EBP
|
|
POP EBX
|
|
POP EDI
|
|
POP ESI
|
|
end;
|
|
{$ELSE}
|
|
FOR I := 1 TO ImageWidth DO
|
|
begin
|
|
{Copy alpha value and then gray value}
|
|
Dest^ := Src^; inc(Src, 2);
|
|
Trans^ := Src^; inc(Src, (4 shl ShiftScale) - 2);
|
|
inc(Dest); inc(Trans);
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{Decode non interlaced image}
|
|
procedure TChunkIDAT.DecodeNonInterlaced(Stream: PStream;
|
|
var ZLIBStream: TZStreamRec2; const Size: Integer; var crcfile: DWORD);
|
|
var
|
|
j, y: Integer;
|
|
Trans, Dta: pChar;
|
|
CopyProc: procedure(Src, Dest, Trans: pChar) of object;
|
|
W, H: Integer;
|
|
Stop: Boolean;
|
|
begin
|
|
CopyProc := nil; {Initialize}
|
|
{Determines the method to copy the image data}
|
|
case Header.ColorType of
|
|
{R, G, B values}
|
|
COLOR_RGB:
|
|
case Header.BitDepth of
|
|
8: CopyProc := CopyNonInterlacedRGB8;
|
|
16: CopyProc := CopyNonInterlacedRGB16;
|
|
end;
|
|
{Types using palettes}
|
|
COLOR_PALETTE, COLOR_GRAYSCALE:
|
|
case Header.BitDepth of
|
|
1, 4, 8: CopyProc := CopyNonInterlacedPalette148;
|
|
2 : if Header.ColorType = COLOR_PALETTE then
|
|
CopyProc := CopyNonInterlacedPalette2
|
|
else
|
|
CopyProc := CopyNonInterlacedGray2;
|
|
16 : CopyProc := CopyNonInterlacedGrayscale16;
|
|
end;
|
|
{R, G, B followed by alpha}
|
|
COLOR_RGBALPHA:
|
|
case Header.BitDepth of
|
|
8 : CopyProc := CopyNonInterlacedRGBAlpha8;
|
|
16 : CopyProc := CopyNonInterlacedRGBAlpha16;
|
|
end;
|
|
{Grayscale followed by alpha}
|
|
COLOR_GRAYSCALEALPHA:
|
|
case Header.BitDepth of
|
|
8 : CopyProc := CopyNonInterlacedGrayscaleAlpha8;
|
|
16 : CopyProc := CopyNonInterlacedGrayscaleAlpha16;
|
|
end;
|
|
end;
|
|
|
|
{Prepare ShiftScale}
|
|
CASE Owner.Scale OF
|
|
psHalfSize : ShiftScale := 1;
|
|
psQuarterSize: ShiftScale := 2;
|
|
psEightsSize : ShiftScale := 3;
|
|
else ShiftScale := 0;
|
|
END;
|
|
|
|
{Get the image data pointer}
|
|
if not Assigned( Owner.OnGetRow ) then
|
|
begin
|
|
Longint(Dta) := Longint(Header.ImageData) +
|
|
Header.BytesPerRow * (ImageHeight - 1);
|
|
Trans := Header.ImageAlpha;
|
|
end;
|
|
{Reads each line}
|
|
j := 0;
|
|
FOR y := 0 to Owner.Height - 1 do
|
|
begin
|
|
if Assigned( Owner.fOnProgress ) then
|
|
begin
|
|
if not Owner.fOnProgress( Owner, 0, 0, j * 100 div Integer( Max( 1, Owner.Height-1 ) ) ) then
|
|
break;
|
|
end;
|
|
{Read this line Row_Buffer[RowUsed][0] if the filter type for this line}
|
|
if IDATZlibRead(ZLIBStream, @Row_Buffer[RowUsed][0], Row_Bytes + 1, EndPos,
|
|
CRCFile) = 0 then break;
|
|
|
|
{Filter the current row}
|
|
FilterRow;
|
|
if y and ((1 shl ShiftScale)-1) = 0 then
|
|
begin
|
|
{Copies non interlaced row to image}
|
|
if j < ImageHeight then
|
|
begin
|
|
if Assigned( Owner.OnGetRow ) then
|
|
begin
|
|
W := Owner.Width;
|
|
H := Owner.Height;
|
|
Stop := FALSE;
|
|
Owner.OnGetRow( Owner, y, W, H, PByte( Dta ), PByte( Trans ), Stop );
|
|
if Stop then Exit;
|
|
end;
|
|
CopyProc(@Row_Buffer[RowUsed][1], Dta, Trans);
|
|
if Assigned( Owner.OnGetRow ) then
|
|
begin
|
|
W := -Owner.Width;
|
|
H := Owner.Height;
|
|
Stop := FALSE;
|
|
Owner.OnGetRow( Owner, y, W, H, PByte( Dta ), PByte( Trans ), Stop );
|
|
if Stop then Exit;
|
|
end;
|
|
end;
|
|
inc( j );
|
|
|
|
{Invert line used}
|
|
dec(Dta, Header.BytesPerRow);
|
|
inc(Trans, ImageWidth);
|
|
end;
|
|
RowUsed := not RowUsed;
|
|
end {for I};
|
|
end;
|
|
|
|
procedure LogPaeth1( pp, a, b, c: Integer ); stdcall;
|
|
begin
|
|
LogFileOutput( GetStartDir + 'log_paet_asm.txt', Int2Str( pp ) + '<-' +
|
|
Int2Str( a ) + ',' + Int2Str( b ) + ',' + Int2Str( c ) );
|
|
end;
|
|
|
|
procedure LogPaethAsm;
|
|
asm
|
|
PUSH EAX
|
|
PUSH EDX
|
|
MOVZX EAX, AL
|
|
MOV EDX, EBX
|
|
MOVZX EDX, BL
|
|
PUSH EDX
|
|
MOV EDX, EBX
|
|
SHR EDX, 16
|
|
MOVZX EDX, DL
|
|
PUSH EDX
|
|
MOVZX EDX, BH
|
|
PUSH EDX
|
|
PUSH EAX
|
|
CALL LogPaeth1
|
|
POP EDX
|
|
POP EAX
|
|
end;
|
|
|
|
{$IFDEF PAETH_TABLE} // Don't use it! Just to test performance
|
|
// and it is proved WORSTER then direct calculation!
|
|
var PaethTableInitialized: Boolean;
|
|
PaethTable: PByte;
|
|
|
|
procedure InitPaethTable;
|
|
var P: PByte;
|
|
a, b: Byte;
|
|
V: Byte;
|
|
i, c: Integer;
|
|
pa, pb, pc: Integer;
|
|
begin
|
|
PaethTableInitialized := TRUE;
|
|
GetMem( PaethTable, 256 * 256 * 256 div 4 );
|
|
P := PaethTable;
|
|
for a := 0 to 255 do
|
|
for b := 0 to 255 do
|
|
begin
|
|
c := 0;
|
|
while c <= 255-3 do
|
|
begin
|
|
V := 0;
|
|
for i := 0 to 3 do
|
|
begin
|
|
pa := abs( b - c );
|
|
pb := abs( a - c );
|
|
pc := abs( a + b - 2*c );
|
|
V := V shr 2;
|
|
if (pa <= pb) and (pa <= pc) then
|
|
V := V or $C0
|
|
else
|
|
if (pb <= pc) then V := V or $80
|
|
else V := V or $40;
|
|
inc( c );
|
|
end;
|
|
P^ := V; inc( P );
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{Filter the current line}
|
|
procedure TChunkIDAT.FilterRow;
|
|
var
|
|
Col: DWORD;
|
|
Offs : Integer;
|
|
p1, p2 : PByteArray;
|
|
{$IFDEF ASM_VERSION}
|
|
Src, Dst: PByte;
|
|
CntBytes: Integer;
|
|
{$IFDEF SMALLEST_CODE}
|
|
Src2: PByte;
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
{$IFDEF PAS_PNG}
|
|
{$ELSE}
|
|
vv, aboveleft: Integer;
|
|
above, left: Integer;
|
|
{$ENDIF}
|
|
pp: Byte;
|
|
{$ENDIF}
|
|
begin
|
|
{Test the filter}
|
|
case Row_Buffer[RowUsed]^[0] of
|
|
{No filtering for this line}
|
|
FILTER_NONE: begin
|
|
{$IFDEF COUNT_FILTER}
|
|
inc( CountFilters[ pfNone ] );
|
|
{$ENDIF}
|
|
end;
|
|
{AND 255 serves only to never let the result be larger than one byte}
|
|
{Sub filter}
|
|
FILTER_SUB:
|
|
begin
|
|
{$IFDEF COUNT_FILTER}
|
|
inc( CountFilters[ pfSub ] );
|
|
{$ENDIF}
|
|
p1 := @Row_Buffer[RowUsed][Offset + 1];
|
|
Offs := -Offset;
|
|
FOR Col := Offset + 1 to Row_Bytes DO
|
|
begin
|
|
p1[0] := (p1[0] + p1[Offs]); // and 255;
|
|
Inc(PByte(p1));
|
|
end;
|
|
end;
|
|
{Up filter}
|
|
FILTER_UP:
|
|
begin
|
|
{$IFDEF COUNT_FILTER}
|
|
inc( CountFilters[ pfUp ] );
|
|
{$ENDIF}
|
|
{$IFDEF PNG_MMX}
|
|
if mmxSupported then
|
|
begin
|
|
Src := @Row_Buffer[not RowUsed][0];
|
|
Dst := @Row_Buffer[RowUsed][0];
|
|
CntBytes := (Row_Bytes + 8) shr 3;
|
|
asm
|
|
MOV EDX, [Dst]
|
|
MOV EAX, [Src]
|
|
SUB EAX, EDX
|
|
MOV ECX, [CntBytes]
|
|
movq mm0, qword ptr [EDX+EAX]
|
|
psrlq mm0, 8
|
|
psllq mm0, 8
|
|
jmp @@1
|
|
@@loop:
|
|
movq mm0, qword ptr [EDX+EAX]
|
|
@@1:
|
|
movq mm1, qword ptr [EDX]
|
|
paddb mm0, mm1
|
|
movq qword ptr [EDX], mm0
|
|
ADD EDX, 8
|
|
LOOP @@loop
|
|
emms
|
|
end;
|
|
end
|
|
else
|
|
{$ENDIF}
|
|
begin
|
|
p1 := @Row_Buffer[RowUsed][1];
|
|
p2 := @Row_Buffer[not RowUsed][1];
|
|
FOR Col := 1 to Row_Bytes DO
|
|
begin
|
|
p1[0] := (p1[0] + p2[0]) and 255;
|
|
Inc(PByte(p1)); Inc(PByte(p2));
|
|
end;
|
|
end;
|
|
end;
|
|
{Average filter}
|
|
FILTER_AVERAGE:
|
|
begin
|
|
{$IFDEF COUNT_FILTER}
|
|
inc( CountFilters[ pfAverage ] );
|
|
{$ENDIF}
|
|
begin
|
|
p1 := @Row_Buffer[RowUsed][1];
|
|
p2 := @Row_Buffer[not RowUsed][1];
|
|
For Col := 0 to Offset-1 do begin
|
|
p1[0] := (p1[0] + p2[0] div 2); // and 255;
|
|
Inc(PByte(p1)); Inc(PByte(p2));
|
|
end;
|
|
Offs := -Offset;
|
|
For Col := Offset to Row_Bytes-1 do
|
|
begin
|
|
p1[0] := (p1[0] + ( p1[Offs] + p2[0] ) div 2); // and 255;
|
|
//cur = (cur + ( left + above) div 2) and 255;
|
|
Inc(PByte(p1)); Inc(PByte(p2));
|
|
end;
|
|
end;
|
|
end;
|
|
{Paeth filter}
|
|
FILTER_PAETH:
|
|
begin
|
|
{$IFDEF COUNT_FILTER}
|
|
inc( CountFilters[ pfPaeth ] );
|
|
{$ENDIF}
|
|
{$IFDEF ASM_VERSION}
|
|
{$IFDEF PAETH_TABLE}
|
|
if not PaethTableInitialized then
|
|
InitPaethTable;
|
|
{$ENDIF}
|
|
Offs := Offset;
|
|
CntBytes := Offs;
|
|
Dst := @Row_Buffer[RowUsed][1];
|
|
Src := @Row_Buffer[not RowUsed][1]; // above
|
|
//Src1 := @row_buffer[RowUsed][1]; // left
|
|
//Src2 := @row_buffer[not RowUsed][0]; //aboveleft
|
|
Col := Row_Bytes - DWORD( Offs );
|
|
asm
|
|
PUSH ESI
|
|
PUSH EDI
|
|
PUSH EBX
|
|
MOV ESI, [Src]
|
|
MOV EDI, [Dst]
|
|
MOV ECX, [CntBytes]
|
|
JECXZ @@Do_loop2
|
|
@@loop1:
|
|
LODSB
|
|
ADD AL, [EDI]
|
|
STOSB
|
|
LOOP @@loop1
|
|
@@Do_loop2:
|
|
PUSH EBP
|
|
//XOR EBX, EBX
|
|
MOV EBX, [Offs]
|
|
NEG EBX
|
|
MOV EBP, [Col]
|
|
{$IFDEF PAETH_TABLE}
|
|
MOV EDX, [PaethTable]
|
|
nop
|
|
{$ELSE}
|
|
nop
|
|
nop
|
|
nop
|
|
{$ENDIF}
|
|
@@loop2:
|
|
{$IFDEF PAETH_TABLE}
|
|
XOR EAX, EAX
|
|
MOV AH, [EDI+EBX]
|
|
LODSB
|
|
SHL EAX, 8
|
|
MOV AL, [ESI+EBX-1]
|
|
|
|
{MOV DL, AH
|
|
MOV CL, AL
|
|
SHR EAX, 16
|
|
CALL PaethPredictor
|
|
MOV CL, AL}
|
|
|
|
MOV ECX, EAX
|
|
SHL ECX, 8
|
|
MOV CL, CH
|
|
SHR EAX, 2
|
|
MOV AL, byte ptr [EDX+EAX]
|
|
AND CL, 3
|
|
ADD CL, CL
|
|
SHR AL, CL
|
|
AND AL, 3
|
|
SHL AL, 3
|
|
MOV CL, AL
|
|
SHR ECX, CL
|
|
|
|
{$ELSE}
|
|
MOV DH, [EDI+EBX]
|
|
XOR EAX, EAX
|
|
MOV DL, [ESI+EBX]
|
|
LODSB
|
|
|
|
// paeth filter( DH, AL, DL ):
|
|
{PUSH ECX
|
|
MOV ECX, EDX
|
|
MOV DL, AL
|
|
MOV AL, DH
|
|
CALL PaethPredictor
|
|
POP ECX}
|
|
|
|
PUSH ESI
|
|
PUSH EDI
|
|
MOV ECX, EDX
|
|
SHL ECX, 16
|
|
MOV CH, AL // ECX = [a][c][b][?]
|
|
|
|
MOV ESI, EAX // ESI = b
|
|
MOVZX EDI, DL // EDI = c
|
|
NEG EDI // EDI = -c
|
|
MOVZX EAX, DH // EAX = a
|
|
ADD ESI, EAX
|
|
LEA ESI, [ESI+EDI*2] // ESI = a+b-2c
|
|
ADD EAX, EDI // EAX = a-c
|
|
CDQ
|
|
XOR EAX, EDX
|
|
SUB EAX, EDX // EAX = |a-c| = pb
|
|
XCHG EAX, ESI // ESI = pb, EAX = a+b-2c
|
|
CDQ
|
|
XOR EAX, EDX
|
|
SUB EAX, EDX // EAX = |a+b-2c| = pc
|
|
XCHG EDI, EAX // EDI = pc, EAX = -c
|
|
MOVZX EDX, CH // EDX = b
|
|
ADD EAX, EDX // EAX = b-c
|
|
CDQ
|
|
XOR EAX, EDX
|
|
SUB EAX, EDX // EAX = |b-c| = pa
|
|
// EAX = pa , ESI = pb , EDI = pc
|
|
|
|
CMP EAX, ESI // pa <= pb ?
|
|
JA @@1
|
|
CMP EAX, EDI // pa <= pc ?
|
|
MOV CL, 24
|
|
JBE @@2
|
|
|
|
@@1:
|
|
MOV CL, 8
|
|
CMP ESI, EDI
|
|
JBE @@2
|
|
MOV CL, 16
|
|
@@2:
|
|
SHR ECX, CL
|
|
POP EDI
|
|
POP ESI
|
|
{$ENDIF}
|
|
|
|
ADD [EDI], CL
|
|
//ADD [EDI], AL
|
|
INC EDI
|
|
|
|
DEC EBP
|
|
JNZ @@loop2
|
|
|
|
POP EBP
|
|
POP EBX
|
|
POP EDI
|
|
POP ESI
|
|
end;
|
|
{$ELSE}
|
|
{$IFDEF PAS_PNG}////////////////////////////////////////
|
|
{Initialize}
|
|
p1 := @Row_Buffer[RowUsed][1];
|
|
p2 := @Row_Buffer[not RowUsed][1];
|
|
For Col := 0 to Offset-1 do begin
|
|
pp := p2[0]; // PaethPredictor(0, p2[0], 0);
|
|
p1[0] := (pp + p1[0]) and 255;
|
|
Inc(PByte(p1)); Inc(PByte(p2));
|
|
end;
|
|
Offs := -Offset;
|
|
For Col := Offset to Row_Bytes-1 do begin
|
|
pp := PaethPredictor(p1[Offs], // left
|
|
p2[0], // above
|
|
p2[Offs]); // above-left
|
|
p1[0] := (pp + p1[0]) and 255;
|
|
Inc(PByte(p1)); Inc(PByte(p2));
|
|
end;
|
|
{$ELSE}/////////////////////////////////////////////////
|
|
{Initialize}
|
|
left := 0;
|
|
aboveleft := 0;
|
|
{Test each byte}
|
|
FOR Col := 1 to Row_Bytes DO
|
|
begin
|
|
{Obtains above pixel}
|
|
above := Row_Buffer[not RowUsed][Col];
|
|
{Obtains left and top-left pixels}
|
|
if (col - 1 >= offset) Then
|
|
begin
|
|
left := row_buffer[RowUsed][col - offset];
|
|
aboveleft := row_buffer[not RowUsed][col - offset];
|
|
end;
|
|
|
|
{Obtains current pixel and paeth predictor}
|
|
vv := row_buffer[RowUsed][Col];
|
|
pp := PaethPredictor(left, above, aboveleft);
|
|
|
|
{$IFDEF DEBUG_PAETH}
|
|
LogFileOutput( GetStartDir + 'paeth_log.txt',
|
|
Int2Str( pp ) + ' <- ' + Int2Str( left ) + ',' +
|
|
Int2Str( above ) + ',' + Int2Str( aboveleft ) );
|
|
{$ENDIF}
|
|
|
|
{Calculates}
|
|
Row_Buffer[RowUsed][Col] := (pp + vv) and $FF;
|
|
end {for};
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
end {case};
|
|
end;
|
|
|
|
{Reads the image data from the stream}
|
|
function IDAT_Load(Chunk: Pointer; Stream: PStream; const ChunkName: TChunkName;
|
|
Size: Integer): Boolean;
|
|
var
|
|
ZLIBStream: TZStreamRec2;
|
|
CRCCheck,
|
|
CRCFile: DWORD;
|
|
Hdr: PChunkIHDR;
|
|
begin
|
|
with PChunkIDAT( Chunk )^ do
|
|
begin
|
|
{Get pointer to the header chunk}
|
|
Hdr := Owner.Header;
|
|
{Build palette if necessary}
|
|
if Hdr.HasPalette then PreparePalette();
|
|
|
|
{Copy image width and height}
|
|
ImageWidth := Hdr.Width;
|
|
ImageHeight := Hdr.Height;
|
|
if Owner.Scale <> psFullImage then
|
|
begin
|
|
ImageWidth := Owner.ScaledWidth;
|
|
ImageHeight := Owner.ScaledHeight;
|
|
end;
|
|
|
|
{Initialize to calculate CRC}
|
|
CRCFile := update_crc($ffffffff, @ChunkName[0], 4);
|
|
|
|
Owner.GetPixelInfo(Row_Bytes, Offset); {Obtain line information}
|
|
ZLIBStream := ZLIBInitInflate(Stream); {Initializes decompression}
|
|
|
|
{Calculate ending position for the current IDAT chunk}
|
|
EndPos := Stream.Position + DWORD( Size );
|
|
|
|
{Allocate memory}
|
|
GetMem(Row_Buffer[false], Row_Bytes + 12);
|
|
GetMem(Row_Buffer[true], Row_Bytes + 12);
|
|
ZeroMemory(Row_Buffer[false], Row_bytes + 1);
|
|
{Set the variable to alternate the Row_Buffer item to use}
|
|
RowUsed := TRUE;
|
|
|
|
{Call special methods for the different interlace methods}
|
|
case Owner.InterlaceMethod of
|
|
imNone: DecodeNonInterlaced(stream, ZLIBStream, Size, crcfile);
|
|
imAdam7: DecodeInterlacedAdam7(stream, ZLIBStream, size, crcfile);
|
|
end;
|
|
|
|
{Free memory}
|
|
ZLIBTerminateInflate(ZLIBStream); {Terminates decompression}
|
|
FreeMem(Row_Buffer[False]); //, Row_Bytes + 1);
|
|
FreeMem(Row_Buffer[True]); //, Row_Bytes + 1);
|
|
|
|
{Now checks CRC}
|
|
Stream.Read(CRCCheck, 4);
|
|
if Owner.FErrorOnInvalidCRC then
|
|
begin
|
|
CRCFile := CRCFile xor $ffffffff;
|
|
CRCCheck := ByteSwap(CRCCheck);
|
|
Result := CRCCheck = CRCFile;
|
|
|
|
{Handle CRC error}
|
|
if not Result then
|
|
begin
|
|
{In case it coult not load chunk}
|
|
Owner.FError := ErrInvalidCRC;
|
|
exit;
|
|
end;
|
|
end
|
|
else
|
|
Result := TRUE;
|
|
end;
|
|
end;
|
|
|
|
const
|
|
IDATHeader: TChunkName = ('I', 'D', 'A', 'T');
|
|
BUFFER = 5;
|
|
|
|
|
|
{Saves the IDAT chunk to a stream}
|
|
function IDAT_Save(Chunk: Pointer; Stream: PStream): Boolean;
|
|
var
|
|
ZLIBStream : TZStreamRec2;
|
|
Hdr: PChunkIHDR;
|
|
begin
|
|
with PChunkIDAT( Chunk )^ do
|
|
begin
|
|
{Get pointer to the header chunk}
|
|
Hdr := Owner.Header;
|
|
{Copy image width and height}
|
|
ImageWidth := Hdr.Width;
|
|
ImageHeight := Hdr.Height;
|
|
Owner.GetPixelInfo(Row_Bytes, Offset); {Obtain line information}
|
|
|
|
{Allocate memory}
|
|
GetMem(Encode_Buffer[BUFFER], Row_Bytes);
|
|
ZeroMemory(Encode_Buffer[BUFFER], Row_Bytes);
|
|
{Allocate buffers for the filters selected}
|
|
{Filter none will always be calculated to the other filters to work}
|
|
GetMem(Encode_Buffer[FILTER_NONE], Row_Bytes);
|
|
ZeroMemory(Encode_Buffer[FILTER_NONE], Row_Bytes);
|
|
if pfSub in Owner.Filters then
|
|
GetMem(Encode_Buffer[FILTER_SUB], Row_Bytes);
|
|
if pfUp in Owner.Filters then
|
|
GetMem(Encode_Buffer[FILTER_UP], Row_Bytes);
|
|
if pfAverage in Owner.Filters then
|
|
GetMem(Encode_Buffer[FILTER_AVERAGE], Row_Bytes);
|
|
if pfPaeth in Owner.Filters then
|
|
GetMem(Encode_Buffer[FILTER_PAETH], Row_Bytes);
|
|
|
|
{Initialize ZLIB}
|
|
ZLIBStream := ZLIBInitDeflate(Stream, Owner.fCompressionLevel,
|
|
Owner.MaxIdatSize);
|
|
{Write data depending on the interlace method}
|
|
case Owner.InterlaceMethod of
|
|
imNone: EncodeNonInterlaced(stream, ZLIBStream);
|
|
imAdam7: EncodeInterlacedAdam7(stream, ZLIBStream);
|
|
end;
|
|
{Terminates ZLIB}
|
|
ZLIBTerminateDeflate(ZLIBStream);
|
|
|
|
{Release allocated memory}
|
|
FreeMem(Encode_Buffer[BUFFER]); //, Row_Bytes);
|
|
FreeMem(Encode_Buffer[FILTER_NONE]); //, Row_Bytes);
|
|
if pfSub in Owner.Filters then
|
|
FreeMem(Encode_Buffer[FILTER_SUB]); //, Row_Bytes);
|
|
if pfUp in Owner.Filters then
|
|
FreeMem(Encode_Buffer[FILTER_UP]); //, Row_Bytes);
|
|
if pfAverage in Owner.Filters then
|
|
FreeMem(Encode_Buffer[FILTER_AVERAGE]); //, Row_Bytes);
|
|
if pfPaeth in Owner.Filters then
|
|
FreeMem(Encode_Buffer[FILTER_PAETH]); //, Row_Bytes);
|
|
|
|
{Everything went ok}
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
{Writes the IDAT using the settings}
|
|
procedure WriteIDAT(Stream: PStream; Data: Pointer; const Length: DWORD);
|
|
var
|
|
ChunkLen, CRC: DWORD;
|
|
begin
|
|
{Writes IDAT header}
|
|
ChunkLen := ByteSwap(Length);
|
|
Stream.Write(ChunkLen, 4); {Chunk length}
|
|
Stream.Write(IDATHeader[0], 4); {Idat header}
|
|
CRC := update_crc($ffffffff, @IDATHeader[0], 4); {Crc part for header}
|
|
|
|
{Writes IDAT data and calculates CRC for data}
|
|
Stream.Write(Data^, Length);
|
|
CRC := Byteswap(update_crc(CRC, Data, Length) xor $ffffffff);
|
|
{Writes final CRC}
|
|
Stream.Write(CRC, 4);
|
|
end;
|
|
|
|
{Compress and writes IDAT chunk data}
|
|
procedure TChunkIDAT.IDATZlibWrite(var ZLIBStream: TZStreamRec2;
|
|
Buffer: Pointer; const Length: DWORD);
|
|
begin
|
|
with ZLIBStream, ZLIBStream.ZLIB do
|
|
begin
|
|
{Set data to be compressed}
|
|
next_in := Buffer;
|
|
avail_in := Length;
|
|
|
|
{Compress all the data avaliable to compress}
|
|
while avail_in > 0 do
|
|
begin
|
|
deflate(ZLIB, Z_NO_FLUSH);
|
|
|
|
{The whole buffer was used, save data to stream and restore buffer}
|
|
if avail_out = 0 then
|
|
begin
|
|
{Writes this IDAT chunk}
|
|
WriteIDAT(fStream, Data, ZLIBAllocate);
|
|
|
|
{Restore buffer}
|
|
next_out := Data;
|
|
avail_out := ZLIBAllocate;
|
|
end {if avail_out = 0};
|
|
|
|
end {while avail_in};
|
|
|
|
end {with ZLIBStream, ZLIBStream.ZLIB}
|
|
end;
|
|
|
|
{Finishes compressing data to write IDAT chunk}
|
|
procedure TChunkIDAT.FinishIDATZlib(var ZLIBStream: TZStreamRec2);
|
|
begin
|
|
with ZLIBStream, ZLIBStream.ZLIB do
|
|
begin
|
|
{Set data to be compressed}
|
|
next_in := nil;
|
|
avail_in := 0;
|
|
|
|
while deflate(ZLIB,Z_FINISH) <> Z_STREAM_END do
|
|
begin
|
|
{Writes this IDAT chunk}
|
|
WriteIDAT(fStream, Data, ZLIBAllocate - avail_out);
|
|
{Re-update buffer}
|
|
next_out := Data;
|
|
avail_out := ZLIBAllocate;
|
|
end;
|
|
|
|
if avail_out < ZLIBAllocate then
|
|
{Writes final IDAT}
|
|
WriteIDAT(fStream, Data, ZLIBAllocate - avail_out);
|
|
|
|
end {with ZLIBStream, ZLIBStream.ZLIB};
|
|
end;
|
|
|
|
{Copy memory to encode RGB image with 1 byte for each color sample}
|
|
procedure TChunkIDAT.EncodeNonInterlacedRGB8(Src, Dest, Trans: pChar);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
FOR I := 1 TO ImageWidth DO
|
|
begin
|
|
{Copy pixel values}
|
|
Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) + 2)^]; inc(Dest);
|
|
Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) + 1)^]; inc(Dest);
|
|
Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) )^]; inc(Dest);
|
|
{Move to next pixel}
|
|
inc(Src, 3);
|
|
end {for I}
|
|
end;
|
|
|
|
{Copy memory to encode RGB images with 16 bits for each color sample}
|
|
procedure TChunkIDAT.EncodeNonInterlacedRGB16(Src, Dest, Trans: pChar);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
FOR I := 1 TO ImageWidth DO
|
|
begin
|
|
//Now we copy from 1 byte for each sample stored to a 2 bytes (or 1 word)
|
|
//for sample
|
|
{Copy pixel values}
|
|
pWORD(Dest)^ := fOwner.InverseGamma[pByte(Longint(Src) + 2)^]; inc(Dest, 2);
|
|
pWORD(Dest)^ := fOwner.InverseGamma[pByte(Longint(Src) + 1)^]; inc(Dest, 2);
|
|
pWORD(Dest)^ := fOwner.InverseGamma[pByte(Longint(Src) )^]; inc(Dest, 2);
|
|
{Move to next pixel}
|
|
inc(Src, 3);
|
|
end {for I}
|
|
|
|
end;
|
|
|
|
{Copy memory to encode types using palettes (1, 4 or 8 bits per pixel)}
|
|
procedure TChunkIDAT.EncodeNonInterlacedPalette148(Src, Dest, Trans: pChar);
|
|
begin
|
|
{It's simple as copying the data}
|
|
CopyMemory(Dest, Src, Row_Bytes);
|
|
end;
|
|
|
|
{Copy memory to encode grayscale images with 2 bytes for each sample}
|
|
procedure TChunkIDAT.EncodeNonInterlacedGrayscale16(Src, Dest, Trans: pChar);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
FOR I := 1 TO ImageWidth DO
|
|
begin
|
|
//Now we copy from 1 byte for each sample stored to a 2 bytes (or 1 word)
|
|
//for sample
|
|
pWORD(Dest)^ := pByte(Longint(Src))^; inc(Dest, 2);
|
|
{Move to next pixel}
|
|
inc(Src);
|
|
end {for I}
|
|
end;
|
|
|
|
{Encode images using RGB followed by an alpha value using 1 byte for each}
|
|
procedure TChunkIDAT.EncodeNonInterlacedRGBAlpha8(Src, Dest, Trans: pChar);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
{Copy the data to the destination, including data from Trans pointer}
|
|
FOR i := 1 TO ImageWidth do
|
|
begin
|
|
Byte(Dest^) := Owner.InverseGamma[PByte(Longint(Src) + 2)^]; inc(Dest);
|
|
Byte(Dest^) := Owner.InverseGamma[PByte(Longint(Src) + 1)^]; inc(Dest);
|
|
Byte(Dest^) := Owner.InverseGamma[PByte(Longint(Src) )^]; inc(Dest);
|
|
Dest^ := Trans^; inc(Dest);
|
|
inc(Src, 3); inc(Trans);
|
|
end {for i};
|
|
end;
|
|
|
|
{Encode images using RGB followed by an alpha value using 2 byte for each}
|
|
procedure TChunkIDAT.EncodeNonInterlacedRGBAlpha16(Src, Dest, Trans: pChar);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
{Copy the data to the destination, including data from Trans pointer}
|
|
FOR i := 1 TO ImageWidth do
|
|
begin
|
|
pWord(Dest)^ := Owner.InverseGamma[PByte(Longint(Src) + 2)^]; inc(Dest, 2);
|
|
pWord(Dest)^ := Owner.InverseGamma[PByte(Longint(Src) + 1)^]; inc(Dest, 2);
|
|
pWord(Dest)^ := Owner.InverseGamma[PByte(Longint(Src) )^]; inc(Dest, 2);
|
|
pWord(Dest)^ := PByte(Longint(Trans) )^; inc(Dest, 2);
|
|
inc(Src, 3); inc(Trans);
|
|
end {for i};
|
|
end;
|
|
|
|
{Encode grayscale images followed by an alpha value using 1 byte for each}
|
|
procedure TChunkIDAT.EncodeNonInterlacedGrayscaleAlpha8(Src, Dest,Trans: pChar);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
{Copy the data to the destination, including data from Trans pointer}
|
|
FOR i := 1 TO ImageWidth do
|
|
begin
|
|
Dest^ := Src^; inc(Dest);
|
|
Dest^ := Trans^; inc(Dest);
|
|
inc(Src); inc(Trans);
|
|
end {for i};
|
|
end;
|
|
|
|
{Encode grayscale images followed by an alpha value using 2 byte for each}
|
|
procedure TChunkIDAT.EncodeNonInterlacedGrayscaleAlpha16(Src, Dest,Trans:pChar);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
{Copy the data to the destination, including data from Trans pointer}
|
|
FOR i := 1 TO ImageWidth do
|
|
begin
|
|
pWord(Dest)^ := pByte(Src)^; inc(Dest, 2);
|
|
pWord(Dest)^ := pByte(Trans)^; inc(Dest, 2);
|
|
inc(Src); inc(Trans);
|
|
end {for i};
|
|
end;
|
|
|
|
{Encode non interlaced images}
|
|
procedure TChunkIDAT.EncodeNonInterlaced(Stream: PStream;
|
|
var ZLIBStream: TZStreamRec2);
|
|
var
|
|
{Current line}
|
|
j: Integer;
|
|
{Pointers to image data}
|
|
Dta, Trans: PByte;
|
|
{Filter used for this line}
|
|
Filter: Byte;
|
|
{Method which will copy the data into the buffer}
|
|
CopyProc: procedure(Src, Dst, Trans: Pchar) of object;
|
|
W, H: Integer;
|
|
Stop: Boolean;
|
|
begin
|
|
CopyProc := nil; {Initialize to avoid warnings}
|
|
{Defines the method to copy the data to the buffer depending on}
|
|
{the image parameters}
|
|
case Header.ColorType of
|
|
{R, G, B values}
|
|
COLOR_RGB:
|
|
case Header.BitDepth of
|
|
8: CopyProc := EncodeNonInterlacedRGB8;
|
|
16: CopyProc := EncodeNonInterlacedRGB16;
|
|
end;
|
|
{Palette and grayscale values}
|
|
COLOR_GRAYSCALE, COLOR_PALETTE:
|
|
case Header.BitDepth of
|
|
1, 4, 8: CopyProc := EncodeNonInterlacedPalette148;
|
|
16: CopyProc := EncodeNonInterlacedGrayscale16;
|
|
end;
|
|
{RGB with a following alpha value}
|
|
COLOR_RGBALPHA:
|
|
case Header.BitDepth of
|
|
8: CopyProc := EncodeNonInterlacedRGBAlpha8;
|
|
16: CopyProc := EncodeNonInterlacedRGBAlpha16;
|
|
end;
|
|
{Grayscale images followed by an alpha}
|
|
COLOR_GRAYSCALEALPHA:
|
|
case Header.BitDepth of
|
|
8: CopyProc := EncodeNonInterlacedGrayscaleAlpha8;
|
|
16: CopyProc := EncodeNonInterlacedGrayscaleAlpha16;
|
|
end;
|
|
end {case Header.ColorType};
|
|
|
|
{Get the image data pointer}
|
|
Stop := FALSE;
|
|
if Assigned( Owner.OnGetRow ) then
|
|
begin
|
|
Owner.OnGetRow( Owner, 0, W, H, Dta, Trans, Stop );
|
|
end
|
|
else
|
|
begin
|
|
W := ImageWidth;
|
|
H := ImageHeight;
|
|
Longint(Dta) := Longint(Header.ImageData) +
|
|
Header.BytesPerRow * (ImageHeight - 1);
|
|
Trans := Header.ImageAlpha;
|
|
end;
|
|
|
|
{Writes each line}
|
|
if not Stop then
|
|
FOR j := 0 to H - 1 do
|
|
begin
|
|
{Copy data into buffer}
|
|
CopyProc(PChar( Dta ), @Encode_Buffer[BUFFER][0], PChar( Trans ));
|
|
{Filter data}
|
|
Filter := FilterToEncode;
|
|
|
|
{Compress data}
|
|
IDATZlibWrite(ZLIBStream, @Filter, 1);
|
|
IDATZlibWrite(ZLIBStream, @Encode_Buffer[Filter][0], Row_Bytes);
|
|
|
|
{Adjust pointers to the actual image data}
|
|
if j < H-1 then
|
|
begin
|
|
if Assigned( Owner.OnGetRow ) then
|
|
begin
|
|
Owner.OnGetRow( Owner, j+1, W, H, Dta, Trans, Stop );
|
|
if Stop then break;
|
|
end
|
|
else
|
|
begin
|
|
dec(Dta, Header.BytesPerRow);
|
|
inc(Trans, ImageWidth);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{Compress and finishes copying the remaining data}
|
|
FinishIDATZlib(ZLIBStream);
|
|
end;
|
|
|
|
{Copy memory to encode interlaced images using RGB value with 1 byte for}
|
|
{each color sample}
|
|
procedure TChunkIDAT.EncodeInterlacedRGB8(const Pass: Byte; Src, Dest,
|
|
Trans: pChar);
|
|
var
|
|
Col: Integer;
|
|
begin
|
|
{Get first column and enter in loop}
|
|
Col := ColumnStart[Pass];
|
|
Src := pChar(Longint(Src) + Col * 3);
|
|
repeat
|
|
{Copy this row}
|
|
Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) + 2)^]; inc(Dest);
|
|
Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) + 1)^]; inc(Dest);
|
|
Byte(Dest^) := fOwner.InverseGamma[pByte(Longint(Src) )^]; inc(Dest);
|
|
|
|
{Move to next column}
|
|
inc(Src, ColumnIncrement[Pass] * 3);
|
|
inc(Col, ColumnIncrement[Pass]);
|
|
until Col >= ImageWidth;
|
|
end;
|
|
|
|
{Copy memory to encode interlaced RGB images with 2 bytes each color sample}
|
|
procedure TChunkIDAT.EncodeInterlacedRGB16(const Pass: Byte; Src, Dest,
|
|
Trans: pChar);
|
|
var
|
|
Col: Integer;
|
|
begin
|
|
{Get first column and enter in loop}
|
|
Col := ColumnStart[Pass];
|
|
Src := pChar(Longint(Src) + Col * 3);
|
|
repeat
|
|
{Copy this row}
|
|
pWord(Dest)^ := Owner.InverseGamma[pByte(Longint(Src) + 2)^]; inc(Dest, 2);
|
|
pWord(Dest)^ := Owner.InverseGamma[pByte(Longint(Src) + 1)^]; inc(Dest, 2);
|
|
pWord(Dest)^ := Owner.InverseGamma[pByte(Longint(Src) )^]; inc(Dest, 2);
|
|
|
|
{Move to next column}
|
|
inc(Src, ColumnIncrement[Pass] * 3);
|
|
inc(Col, ColumnIncrement[Pass]);
|
|
until Col >= ImageWidth;
|
|
end;
|
|
|
|
{Copy memory to encode interlaced images using palettes using bit depths}
|
|
{1, 4, 8 (each pixel in the image)}
|
|
procedure TChunkIDAT.EncodeInterlacedPalette148(const Pass: Byte; Src, Dest,
|
|
Trans: pChar);
|
|
const
|
|
BitTable: Array[1..8] of Integer = ($1, $3, 0, $F, 0, 0, 0, $FF);
|
|
StartBit: Array[1..8] of Integer = (7 , 0 , 0, 4, 0, 0, 0, 0);
|
|
var
|
|
CurBit, Col: Integer;
|
|
Src2: PChar;
|
|
begin
|
|
{Clean the line}
|
|
fillchar(Dest^, Row_Bytes, #0);
|
|
{Get first column and enter in loop}
|
|
Col := ColumnStart[Pass];
|
|
with Header.BitmapInfo.bmiHeader do
|
|
repeat
|
|
{Copy data}
|
|
CurBit := StartBit[biBitCount];
|
|
repeat
|
|
{Adjust pointer to pixel byte bounds}
|
|
Src2 := pChar(Longint(Src) + (biBitCount * Col) div 8);
|
|
{Copy data}
|
|
Byte(Dest^) := Byte(Dest^) or
|
|
(((Byte(Src2^) shr (StartBit[Header.BitDepth] - (biBitCount * Col)
|
|
mod 8))) and (BitTable[biBitCount])) shl CurBit;
|
|
|
|
{Move to next column}
|
|
inc(Col, ColumnIncrement[Pass]);
|
|
{Will read next bits}
|
|
dec(CurBit, biBitCount);
|
|
until CurBit < 0;
|
|
|
|
{Move to next byte in source}
|
|
inc(Dest);
|
|
until Col >= ImageWidth;
|
|
end;
|
|
|
|
{Copy to encode interlaced grayscale images using 16 bits for each sample}
|
|
procedure TChunkIDAT.EncodeInterlacedGrayscale16(const Pass: Byte; Src, Dest,
|
|
Trans: pChar);
|
|
var
|
|
Col: Integer;
|
|
begin
|
|
{Get first column and enter in loop}
|
|
Col := ColumnStart[Pass];
|
|
Src := pChar(Longint(Src) + Col);
|
|
repeat
|
|
{Copy this row}
|
|
pWord(Dest)^ := Byte(Src^); inc(Dest, 2);
|
|
|
|
{Move to next column}
|
|
inc(Src, ColumnIncrement[Pass]);
|
|
inc(Col, ColumnIncrement[Pass]);
|
|
until Col >= ImageWidth;
|
|
end;
|
|
|
|
{Copy to encode interlaced rgb images followed by an alpha value, all using}
|
|
{one byte for each sample}
|
|
procedure TChunkIDAT.EncodeInterlacedRGBAlpha8(const Pass: Byte; Src, Dest,
|
|
Trans: pChar);
|
|
var
|
|
Col: Integer;
|
|
begin
|
|
{Get first column and enter in loop}
|
|
Col := ColumnStart[Pass];
|
|
Src := pChar(Longint(Src) + Col * 3);
|
|
Trans := pChar(Longint(Trans) + Col);
|
|
repeat
|
|
{Copy this row}
|
|
Byte(Dest^) := Owner.InverseGamma[pByte(Longint(Src) + 2)^]; inc(Dest);
|
|
Byte(Dest^) := Owner.InverseGamma[pByte(Longint(Src) + 1)^]; inc(Dest);
|
|
Byte(Dest^) := Owner.InverseGamma[pByte(Longint(Src) )^]; inc(Dest);
|
|
Dest^ := Trans^; inc(Dest);
|
|
|
|
{Move to next column}
|
|
inc(Src, ColumnIncrement[Pass] * 3);
|
|
inc(Trans, ColumnIncrement[Pass]);
|
|
inc(Col, ColumnIncrement[Pass]);
|
|
until Col >= ImageWidth;
|
|
end;
|
|
|
|
{Copy to encode interlaced rgb images followed by an alpha value, all using}
|
|
{two byte for each sample}
|
|
procedure TChunkIDAT.EncodeInterlacedRGBAlpha16(const Pass: Byte; Src, Dest,
|
|
Trans: pChar);
|
|
var
|
|
Col: Integer;
|
|
begin
|
|
{Get first column and enter in loop}
|
|
Col := ColumnStart[Pass];
|
|
Src := pChar(Longint(Src) + Col * 3);
|
|
Trans := pChar(Longint(Trans) + Col);
|
|
repeat
|
|
{Copy this row}
|
|
pWord(Dest)^ := pByte(Longint(Src) + 2)^; inc(Dest, 2);
|
|
pWord(Dest)^ := pByte(Longint(Src) + 1)^; inc(Dest, 2);
|
|
pWord(Dest)^ := pByte(Longint(Src) )^; inc(Dest, 2);
|
|
pWord(Dest)^ := pByte(Trans)^; inc(Dest, 2);
|
|
|
|
{Move to next column}
|
|
inc(Src, ColumnIncrement[Pass] * 3);
|
|
inc(Trans, ColumnIncrement[Pass]);
|
|
inc(Col, ColumnIncrement[Pass]);
|
|
until Col >= ImageWidth;
|
|
end;
|
|
|
|
{Copy to encode grayscale interlaced images followed by an alpha value, all}
|
|
{using 1 byte for each sample}
|
|
procedure TChunkIDAT.EncodeInterlacedGrayscaleAlpha8(const Pass: Byte; Src,
|
|
Dest, Trans: pChar);
|
|
var
|
|
Col: Integer;
|
|
begin
|
|
{Get first column and enter in loop}
|
|
Col := ColumnStart[Pass];
|
|
Src := pChar(Longint(Src) + Col);
|
|
Trans := pChar(Longint(Trans) + Col);
|
|
repeat
|
|
{Copy this row}
|
|
Dest^ := Src^; inc(Dest);
|
|
Dest^ := Trans^; inc(Dest);
|
|
|
|
{Move to next column}
|
|
inc(Src, ColumnIncrement[Pass]);
|
|
inc(Trans, ColumnIncrement[Pass]);
|
|
inc(Col, ColumnIncrement[Pass]);
|
|
until Col >= ImageWidth;
|
|
end;
|
|
|
|
{Copy to encode grayscale interlaced images followed by an alpha value, all}
|
|
{using 2 bytes for each sample}
|
|
procedure TChunkIDAT.EncodeInterlacedGrayscaleAlpha16(const Pass: Byte; Src,
|
|
Dest, Trans: pChar);
|
|
var
|
|
Col: Integer;
|
|
begin
|
|
{Get first column and enter in loop}
|
|
Col := ColumnStart[Pass];
|
|
Src := pChar(Longint(Src) + Col);
|
|
Trans := pChar(Longint(Trans) + Col);
|
|
repeat
|
|
{Copy this row}
|
|
pWord(Dest)^ := pByte(Src)^; inc(Dest, 2);
|
|
pWord(Dest)^ := pByte(Trans)^; inc(Dest, 2);
|
|
|
|
{Move to next column}
|
|
inc(Src, ColumnIncrement[Pass]);
|
|
inc(Trans, ColumnIncrement[Pass]);
|
|
inc(Col, ColumnIncrement[Pass]);
|
|
until Col >= ImageWidth;
|
|
end;
|
|
|
|
{Encode interlaced images}
|
|
procedure TChunkIDAT.EncodeInterlacedAdam7(Stream: PStream;
|
|
var ZLIBStream: TZStreamRec2);
|
|
var
|
|
CurrentPass, Filter: Byte;
|
|
PixelsThisRow: Integer;
|
|
CurrentRow: Integer;
|
|
Trans, Dta: PByte;
|
|
CopyProc: procedure(const Pass: Byte; Src, Dest, Trans: pChar) of object;
|
|
Stop: Boolean;
|
|
W, H: Integer;
|
|
begin
|
|
CopyProc := nil; {Initialize to avoid warnings}
|
|
{Defines the method to copy the data to the buffer depending on}
|
|
{the image parameters}
|
|
case Header.ColorType of
|
|
{R, G, B values}
|
|
COLOR_RGB:
|
|
case Header.BitDepth of
|
|
8: CopyProc := EncodeInterlacedRGB8;
|
|
16: CopyProc := EncodeInterlacedRGB16;
|
|
end;
|
|
{Grayscale and palette}
|
|
COLOR_PALETTE, COLOR_GRAYSCALE:
|
|
case Header.BitDepth of
|
|
1, 4, 8: CopyProc := EncodeInterlacedPalette148;
|
|
16: CopyProc := EncodeInterlacedGrayscale16;
|
|
end;
|
|
{RGB followed by alpha}
|
|
COLOR_RGBALPHA:
|
|
case Header.BitDepth of
|
|
8: CopyProc := EncodeInterlacedRGBAlpha8;
|
|
16: CopyProc := EncodeInterlacedRGBAlpha16;
|
|
end;
|
|
COLOR_GRAYSCALEALPHA:
|
|
{Grayscale followed by alpha}
|
|
case Header.BitDepth of
|
|
8: CopyProc := EncodeInterlacedGrayscaleAlpha8;
|
|
16: CopyProc := EncodeInterlacedGrayscaleAlpha16;
|
|
end;
|
|
end {case Header.ColorType};
|
|
|
|
{Compress the image using the seven passes for ADAM 7}
|
|
Stop := FALSE;
|
|
FOR CurrentPass := 0 TO 6 DO
|
|
begin
|
|
{Calculates the number of pixels and bytes for this pass row}
|
|
PixelsThisRow := (ImageWidth - ColumnStart[CurrentPass] +
|
|
ColumnIncrement[CurrentPass] - 1) div ColumnIncrement[CurrentPass];
|
|
Row_Bytes := BytesForPixels(PixelsThisRow, Header.ColorType,
|
|
Header.BitDepth);
|
|
ZeroMemory(Encode_Buffer[FILTER_NONE], Row_Bytes);
|
|
|
|
{Get current row index}
|
|
CurrentRow := RowStart[CurrentPass];
|
|
{Get a pointer to the current row image data}
|
|
Stop := FALSE;
|
|
if Assigned( Owner.OnGetRow ) then
|
|
begin
|
|
Owner.OnGetRow( Owner, CurrentRow, W, H, Dta, Trans, Stop );
|
|
end
|
|
else
|
|
begin
|
|
W := ImageWidth;
|
|
H := ImageHeight;
|
|
Dta := Ptr(Longint(Header.ImageData) + Header.BytesPerRow *
|
|
(ImageHeight - 1 - CurrentRow));
|
|
Trans := Ptr(Longint(Header.ImageAlpha) + ImageWidth * CurrentRow);
|
|
end;
|
|
|
|
{Process all the image rows}
|
|
if (Row_Bytes > 0) and not Stop then
|
|
while CurrentRow < ImageHeight do
|
|
begin
|
|
{Copy data into buffer}
|
|
CopyProc(CurrentPass, PChar( Dta ), @Encode_Buffer[BUFFER][0], PChar( Trans ));
|
|
{Filter data}
|
|
Filter := FilterToEncode;
|
|
|
|
{Compress data}
|
|
IDATZlibWrite(ZLIBStream, @Filter, 1);
|
|
IDATZlibWrite(ZLIBStream, @Encode_Buffer[Filter][0], Row_Bytes);
|
|
|
|
{Move to the next row}
|
|
inc(CurrentRow, RowIncrement[CurrentPass]);
|
|
{Move pointer to the next line}
|
|
if CurrentRow < ImageHeight then
|
|
begin
|
|
Owner.OnGetRow( Owner, CurrentRow, W, H, Dta, Trans, Stop );
|
|
if Stop then break;
|
|
end
|
|
else
|
|
begin
|
|
dec(Dta, RowIncrement[CurrentPass] * Header.BytesPerRow);
|
|
inc(Trans, RowIncrement[CurrentPass] * ImageWidth);
|
|
end;
|
|
end {while CurrentRow < ImageHeight}
|
|
|
|
end {CurrentPass};
|
|
|
|
{Compress and finishes copying the remaining data}
|
|
FinishIDATZlib(ZLIBStream);
|
|
end;
|
|
|
|
{Filters the row to be encoded and returns the best filter}
|
|
function TChunkIDAT.FilterToEncode: Byte;
|
|
var
|
|
Run, LongestRun, ii, jj: DWORD;
|
|
Last, Above, LastAbove: Byte;
|
|
begin
|
|
{Selecting more filters using the Filters property from TPngObject}
|
|
{increases the chances to the file be much smaller, but decreases}
|
|
{the performace}
|
|
|
|
{This method will creates the same line data using the different}
|
|
{filter methods and select the best}
|
|
|
|
{Sub-filter}
|
|
if pfSub in Owner.Filters then
|
|
for ii := 0 to Row_Bytes - 1 do
|
|
begin
|
|
{There is no previous pixel when it's on the first pixel, so}
|
|
{set last as zero when in the first}
|
|
if (ii >= Offset) then
|
|
last := Encode_Buffer[BUFFER]^[ii - Offset]
|
|
else
|
|
last := 0;
|
|
Encode_Buffer[FILTER_SUB]^[ii] := Encode_Buffer[BUFFER]^[ii] - last;
|
|
end;
|
|
|
|
{Up filter}
|
|
if pfUp in Owner.Filters then
|
|
for ii := 0 to Row_Bytes - 1 do
|
|
Encode_Buffer[FILTER_UP]^[ii] := Encode_Buffer[BUFFER]^[ii] -
|
|
Encode_Buffer[FILTER_NONE]^[ii];
|
|
|
|
{Average filter}
|
|
if pfAverage in Owner.Filters then
|
|
for ii := 0 to Row_Bytes - 1 do
|
|
begin
|
|
{Get the previous pixel, if the current pixel is the first, the}
|
|
{previous is considered to be 0}
|
|
if (ii >= Offset) then
|
|
last := Encode_Buffer[BUFFER]^[ii - Offset]
|
|
else
|
|
last := 0;
|
|
{Get the pixel above}
|
|
above := Encode_Buffer[FILTER_NONE]^[ii];
|
|
|
|
{Calculates formula to the average pixel}
|
|
Encode_Buffer[FILTER_AVERAGE]^[ii] := Encode_Buffer[BUFFER]^[ii] -
|
|
(above + last) div 2 ;
|
|
end;
|
|
|
|
{Paeth filter (the slower)}
|
|
if pfPaeth in Owner.Filters then
|
|
begin
|
|
{Initialize}
|
|
last := 0;
|
|
lastabove := 0;
|
|
for ii := 0 to Row_Bytes - 1 do
|
|
begin
|
|
{In case this pixel is not the first in the line obtains the}
|
|
{previous one and the one above the previous}
|
|
if (ii >= Offset) then
|
|
begin
|
|
last := Encode_Buffer[BUFFER]^[ii - Offset];
|
|
lastabove := Encode_Buffer[FILTER_NONE]^[ii - Offset];
|
|
end;
|
|
{Obtains the pixel above}
|
|
above := Encode_Buffer[FILTER_NONE]^[ii];
|
|
{Calculate paeth filter for this byte}
|
|
Encode_Buffer[FILTER_PAETH]^[ii] := Encode_Buffer[BUFFER]^[ii] -
|
|
PaethPredictor(last, above, lastabove);
|
|
end;
|
|
end;
|
|
|
|
{Now calculates the same line using no filter, which is necessary}
|
|
{in order to have data to the filters when the next line comes}
|
|
CopyMemory(@Encode_Buffer[FILTER_NONE]^[0],
|
|
@Encode_Buffer[BUFFER]^[0], Row_Bytes);
|
|
|
|
{If only filter none is selected in the filter list, we don't need}
|
|
{to proceed and further}
|
|
if (Owner.Filters = [pfNone]) or (Owner.Filters = []) then
|
|
begin
|
|
Result := FILTER_NONE;
|
|
exit;
|
|
end {if (Owner.Filters = [pfNone...};
|
|
|
|
{Check which filter is the best by checking which has the larger}
|
|
{sequence of the same byte, since they are best compressed}
|
|
LongestRun := 0; Result := FILTER_NONE;
|
|
for ii := FILTER_NONE TO FILTER_PAETH do
|
|
{Check if this filter was selected}
|
|
if TFilter(ii) in Owner.Filters then
|
|
begin
|
|
Run := 0;
|
|
{Check if it's the only filter}
|
|
if Owner.Filters = [TFilter(ii)] then
|
|
begin
|
|
Result := ii;
|
|
exit;
|
|
end;
|
|
|
|
{Check using a sequence of four bytes}
|
|
for jj := 2 to Row_Bytes - 1 do
|
|
if (Encode_Buffer[ii]^[jj] = Encode_Buffer [ii]^[jj-1]) or
|
|
(Encode_Buffer[ii]^[jj] = Encode_Buffer [ii]^[jj-2]) then
|
|
inc(Run); {Count the number of sequences}
|
|
|
|
{Check if this one is the best so far}
|
|
if (Run > LongestRun) then
|
|
begin
|
|
Result := ii;
|
|
LongestRun := Run;
|
|
end {if (Run > LongestRun)};
|
|
|
|
end {if TFilter(ii) in Owner.Filters};
|
|
end;
|
|
|
|
{TChunkPLTE implementation}
|
|
|
|
{Returns an item in the palette}
|
|
function TChunkPLTE.GetPaletteItem(Idx: Byte): TRGBQuad;
|
|
begin
|
|
{Test if item is valid, if not return 0}
|
|
if Idx >= Count then
|
|
begin
|
|
Result.rgbBlue := 0;
|
|
Result.rgbGreen := 0;
|
|
Result.rgbRed := 0;
|
|
Result.rgbReserved := 0;
|
|
end
|
|
else
|
|
{Returns the item}
|
|
Result := Header.BitmapInfo.bmiColors[Idx];
|
|
end;
|
|
|
|
{Loads the palette chunk from a stream}
|
|
function PLTE_Load(Chunk: Pointer; Stream: PStream;
|
|
const ChunkName: TChunkName; Size: Integer): Boolean;
|
|
type
|
|
pPalEntry = ^PalEntry;
|
|
PalEntry = record r, g, b: Byte end;
|
|
var
|
|
j : Integer; {For the FOR}
|
|
PalColor : pPalEntry;
|
|
begin
|
|
{Let ancestor load data and check CRC}
|
|
Result := PChunk( Chunk ).LoadFromStream(Stream, ChunkName, Size);
|
|
if not Result then exit;
|
|
|
|
with PChunkPLTE( Chunk )^ do
|
|
begin
|
|
{This chunk must be divisible by 3 in order to be valid}
|
|
if (Size mod 3 <> 0) or (Size div 3 > 256) then
|
|
begin
|
|
{Raise error}
|
|
Result := FALSE;
|
|
Owner.FError := ErrInvalidPalette;
|
|
exit;
|
|
end {if Size mod 3 <> 0};
|
|
|
|
{Fill array with the palette entries}
|
|
fCount := Size div 3;
|
|
PalColor := Data;
|
|
FOR j := 0 TO fCount - 1 DO
|
|
with Header.BitmapInfo.bmiColors[j] do
|
|
begin
|
|
rgbRed := Owner.GammaTable[PalColor.r];
|
|
rgbGreen := Owner.GammaTable[PalColor.g];
|
|
rgbBlue := Owner.GammaTable[PalColor.b];
|
|
rgbReserved := 0;
|
|
inc(PalColor); {Move to next palette entry}
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{Saves the PLTE chunk to a stream}
|
|
function PLTE_Save(Chunk: Pointer; Stream: PStream): Boolean;
|
|
var
|
|
J: Integer;
|
|
DataPtr: pByte;
|
|
begin
|
|
with PChunkPLTE( Chunk )^ do
|
|
begin
|
|
{Adjust size to hold all the palette items}
|
|
ResizeData(fCount * 3);
|
|
{Copy pointer to data}
|
|
DataPtr := fData;
|
|
|
|
{Copy palette items}
|
|
with Header^ do
|
|
FOR j := 0 TO fCount - 1 DO
|
|
with BitmapInfo.bmiColors[j] do
|
|
begin
|
|
DataPtr^ := Owner.InverseGamma[rgbRed]; inc(DataPtr);
|
|
DataPtr^ := Owner.InverseGamma[rgbGreen]; inc(DataPtr);
|
|
DataPtr^ := Owner.InverseGamma[rgbBlue]; inc(DataPtr);
|
|
end {with BitmapInfo};
|
|
|
|
{Let ancestor do the rest of the work}
|
|
Result := SaveToStream(Stream);
|
|
end;
|
|
end;
|
|
|
|
{TChunkgAMA implementation}
|
|
|
|
{Gamma chunk being created}
|
|
constructor TChunkgAMa.Create(AOwner: PPngObject);
|
|
begin
|
|
{Call ancestor}
|
|
inherited Create(AOwner);
|
|
Gamma := 1; {Initial value}
|
|
end;
|
|
|
|
{Returns gamma value}
|
|
function TChunkgAMA.GetValue: DWORD;
|
|
begin
|
|
{Make sure that the size is four bytes}
|
|
if DataSize <> 4 then
|
|
begin
|
|
{Adjust size and returns 1}
|
|
ResizeData(4);
|
|
Result := 1;
|
|
end
|
|
{If it's right, read the value}
|
|
else Result := DWORD(ByteSwap(PDWORD(Data)^))
|
|
end;
|
|
|
|
function Power(Base, Exponent: Extended): Extended;
|
|
begin
|
|
if Exponent = 0.0 then
|
|
Result := 1.0 {Math rule}
|
|
else if (Base = 0) or (Exponent = 0) then Result := 0
|
|
else
|
|
Result := Exp(Exponent * Ln(Base));
|
|
end;
|
|
|
|
|
|
{Loading the chunk from a stream}
|
|
function gAMA_Load(Chunk: Pointer; Stream: PStream;
|
|
const ChunkName: TChunkName; Size: Integer): Boolean;
|
|
var
|
|
i: Integer;
|
|
Value: DWORD;
|
|
begin
|
|
{Call ancestor and test if it went ok}
|
|
Result := PChunk( Chunk ).LoadFromStream(Stream, ChunkName, Size);
|
|
if not Result then exit;
|
|
|
|
with PChunkGAMA( Chunk )^ do
|
|
begin
|
|
Value := Gamma;
|
|
{Build gamma table and inverse table for saving}
|
|
if Value <> 0 then
|
|
with Owner^ do
|
|
FOR i := 0 TO 255 DO
|
|
begin
|
|
GammaTable[I] := Round(Power((I / 255), 1 /
|
|
(Value / 100000 * 2.2)) * 255);
|
|
InverseGamma[Round(Power((I / 255), 1 /
|
|
(Value / 100000 * 2.2)) * 255)] := I;
|
|
end
|
|
end;
|
|
end;
|
|
|
|
function TPngObject.GetScaledHeight: Integer;
|
|
var i: Integer;
|
|
begin
|
|
Result := Height;
|
|
CASE Scale OF
|
|
psHalfSize : i := 2;
|
|
psQuarterSize: i := 4;
|
|
psEightsSize : i := 8;
|
|
else Exit;
|
|
END;
|
|
Result := Result div i;
|
|
end;
|
|
|
|
function TPngObject.GetScaledWidth: Integer;
|
|
var i: Integer;
|
|
begin
|
|
Result := Width;
|
|
CASE Scale OF
|
|
psHalfSize : i := 2;
|
|
psQuarterSize: i := 4;
|
|
psEightsSize : i := 8;
|
|
else Exit;
|
|
END;
|
|
Result := Result div i;
|
|
end;
|
|
|
|
{Sets the gamma value}
|
|
procedure TChunkgAMA.SetValue(const Value: DWORD);
|
|
begin
|
|
{Make sure that the size is four bytes}
|
|
if DataSize <> 4 then ResizeData(4);
|
|
{If it's right, set the value}
|
|
PDWORD(Data)^ := ByteSwap(Value);
|
|
end;
|
|
|
|
{TPngObject implementation}
|
|
|
|
{Clear all the chunks in the list}
|
|
procedure TPngObject.ClearChunks;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Free_And_Nil( fBitmap );
|
|
{Initialize gamma}
|
|
InitializeGamma();
|
|
{Free all the objects and memory (0 chunks Bug fixed by Noel Sharpe)}
|
|
for i := 0 TO Chunks.Count - 1 do
|
|
PObj( Chunks.Items[i] ).Free;
|
|
Chunks.Clear;
|
|
end;
|
|
|
|
{Portable Network Graphics object being created}
|
|
function NewPngObject: PPngObject;
|
|
begin
|
|
{Let it be created}
|
|
new( Result, Create );
|
|
|
|
with Result^ do
|
|
begin
|
|
{Initial properties}
|
|
fFilters := [pfSub];
|
|
fCompressionLevel := 7;
|
|
fInterlaceMethod := imNone;
|
|
fMaxIdatSize := High(Word);
|
|
{Create chunklist object}
|
|
fChunkList := NewList;
|
|
end;
|
|
end;
|
|
|
|
{Portable Network Graphics object being destroyed}
|
|
destructor TPngObject.Destroy;
|
|
begin
|
|
{Free object list}
|
|
ClearChunks;
|
|
fChunkList.Free;
|
|
|
|
{Call ancestor destroy}
|
|
inherited Destroy;
|
|
end;
|
|
|
|
{Returns linesize and byte offset for pixels}
|
|
procedure TPngObject.GetPixelInfo(var LineSize, Offset: DWORD);
|
|
begin
|
|
{There must be an Header chunk to calculate size}
|
|
if HeaderPresent then
|
|
begin
|
|
{Calculate number of bytes for each line}
|
|
LineSize := BytesForPixels(Header.Width, Header.ColorType, Header.BitDepth);
|
|
|
|
{Calculates byte offset}
|
|
Case Header.ColorType of
|
|
{Grayscale}
|
|
COLOR_GRAYSCALE:
|
|
If Header.BitDepth = 16 Then
|
|
Offset := 2
|
|
Else
|
|
Offset := 1 ;
|
|
{It always smaller or equal one byte, so it occupes one byte}
|
|
COLOR_PALETTE:
|
|
offset := 1;
|
|
{It might be 3 or 6 bytes}
|
|
COLOR_RGB:
|
|
offset := 3 * Header.BitDepth Div 8;
|
|
{It might be 2 or 4 bytes}
|
|
COLOR_GRAYSCALEALPHA:
|
|
offset := 2 * Header.BitDepth Div 8;
|
|
{4 or 8 bytes}
|
|
COLOR_RGBALPHA:
|
|
offset := 4 * Header.BitDepth Div 8;
|
|
else
|
|
Offset := 0;
|
|
End ;
|
|
|
|
end
|
|
else
|
|
begin
|
|
{In case if there isn't any Header chunk}
|
|
Offset := 0;
|
|
LineSize := 0;
|
|
end;
|
|
|
|
end;
|
|
|
|
{Returns image height}
|
|
function TPngObject.GetHeight: Integer;
|
|
begin
|
|
{There must be a Header chunk to get the size, otherwise returns 0}
|
|
if HeaderPresent then
|
|
Result := Header.Height
|
|
else Result := 0;
|
|
end;
|
|
|
|
{Returns image width}
|
|
function TPngObject.GetWidth: Integer;
|
|
begin
|
|
{There must be a Header chunk to get the size, otherwise returns 0}
|
|
if HeaderPresent then
|
|
Result := Header.Width
|
|
else Result := 0;
|
|
end;
|
|
|
|
{Returns if the image is empty}
|
|
function TPngObject.GetEmpty: Boolean;
|
|
begin
|
|
Result := (Chunks.Count = 0);
|
|
end;
|
|
|
|
{Set the maximum size for IDAT chunk}
|
|
procedure TPngObject.SetMaxIdatSize(const Value: DWORD);
|
|
begin
|
|
{Make sure the size is at least 65535}
|
|
if Value < High(Word) then
|
|
fMaxIdatSize := High(Word) else fMaxIdatSize := Value;
|
|
end;
|
|
|
|
{Creates a file stream reading from the filename in the parameter and load}
|
|
function TPngObject.LoadFromFile(const Filename: String): Boolean;
|
|
var FileStream: PStream;
|
|
begin
|
|
FileStream := NewReadFileStream(Filename);
|
|
Result := LoadFromStream(FileStream);
|
|
FileStream.Free;
|
|
end;
|
|
|
|
{Saves the current png image to a file}
|
|
procedure TPngObject.SaveToFile(const Filename: String);
|
|
var FileStream: PStream;
|
|
begin
|
|
FileStream := NewWriteFileStream(Filename);
|
|
SaveToStream(FileStream);
|
|
FileStream.Free;
|
|
end;
|
|
|
|
{Returns pointer to the chunk TChunkIHDR which should be the first}
|
|
function TPngObject.GetHeader: PChunkIHDR;
|
|
begin
|
|
{If there is a TChunkIHDR returns it, otherwise returns nil}
|
|
if (Chunks.Count > 0) {and (Chunks.Items[0] is TChunkIHDR)} then
|
|
Result := Pointer( Chunks.Items[0] )
|
|
else
|
|
begin
|
|
{No header, throw error message}
|
|
Result := nil
|
|
end
|
|
end;
|
|
|
|
{Draws using partial transparency}
|
|
procedure TPngObject.DrawPartialTrans(DC: HDC; Rect: TRect);
|
|
type
|
|
{Access to pixels}
|
|
TPixelLine = Array[Word] of TRGBQuad;
|
|
pPixelLine = ^TPixelLine;
|
|
const
|
|
{Structure used to create the bitmap}
|
|
BitmapInfoHeader: TBitmapInfoHeader =
|
|
(biSize: sizeof(TBitmapInfoHeader);
|
|
biWidth: 100;
|
|
biHeight: 100;
|
|
biPlanes: 1;
|
|
biBitCount: 32;
|
|
biCompression: BI_RGB;
|
|
biSizeImage: 0;
|
|
biXPelsPerMeter: 0;
|
|
biYPelsPerMeter: 0;
|
|
biClrUsed: 0;
|
|
biClrImportant: 0);
|
|
var
|
|
{Buffer bitmap creation}
|
|
BitmapInfo : TBitmapInfo;
|
|
BufferDC : HDC;
|
|
BufferBits : Pointer;
|
|
OldBitmap,
|
|
BufferBitmap: HBitmap;
|
|
|
|
{Transparency/palette chunks}
|
|
TransparencyChunk: PChunktRNS;
|
|
PaletteChunk: PChunkPLTE;
|
|
TransValue, PaletteIndex: Byte;
|
|
CurBit: Integer;
|
|
Data: PByte;
|
|
|
|
{Buffer bitmap modification}
|
|
BytesPerRowDest,
|
|
BytesPerRowSrc,
|
|
BytesPerRowAlpha: Integer;
|
|
ImageSource,
|
|
AlphaSource : pByteArray;
|
|
ImageData : pPixelLine;
|
|
i, j : Integer;
|
|
begin
|
|
{Prepare to create the bitmap}
|
|
Fillchar(BitmapInfo, sizeof(BitmapInfo), #0);
|
|
BitmapInfoHeader.biWidth := Header.Width;
|
|
BitmapInfoHeader.biHeight := -1 * Header.Height;
|
|
BitmapInfo.bmiHeader := BitmapInfoHeader;
|
|
|
|
{Create the bitmap which will receive the background, the applied}
|
|
{alpha blending and then will be painted on the background}
|
|
BufferDC := CreateCompatibleDC(0);
|
|
{In case BufferDC could not be created}
|
|
if (BufferDC = 0) then //RaiseError(EPNGOutMemory, EPNGOutMemoryText);
|
|
Exit;
|
|
BufferBitmap := CreateDIBSection(BufferDC, BitmapInfo, DIB_RGB_COLORS,
|
|
BufferBits, 0, 0);
|
|
{In case buffer bitmap could not be created}
|
|
if (BufferBitmap = 0) or (BufferBits = Nil) then
|
|
begin
|
|
if BufferBitmap <> 0 then DeleteObject(BufferBitmap);
|
|
DeleteDC(BufferDC);
|
|
//RaiseError(EPNGOutMemory, EPNGOutMemoryText);
|
|
Exit;
|
|
end;
|
|
|
|
{Selects new bitmap and release old bitmap}
|
|
OldBitmap := SelectObject(BufferDC, BufferBitmap);
|
|
|
|
{Draws the background on the buffer image}
|
|
StretchBlt(BufferDC, 0, 0, Header.Width, Header.height, DC, Rect.Left,
|
|
Rect.Top, Header.Width, Header.Height, SRCCOPY);
|
|
|
|
{Obtain number of bytes for each row}
|
|
BytesPerRowAlpha := Header.Width;
|
|
BytesPerRowDest := (((BitmapInfo.bmiHeader.biBitCount * Width) + 31)
|
|
and not 31) div 8; {Number of bytes for each image row in destination}
|
|
BytesPerRowSrc := (((Header.BitmapInfo.bmiHeader.biBitCount * Header.Width) +
|
|
31) and not 31) div 8; {Number of bytes for each image row in source}
|
|
|
|
{Obtains image pointers}
|
|
ImageData := BufferBits;
|
|
AlphaSource := Header.ImageAlpha;
|
|
Longint(ImageSource) := Longint(Header.ImageData) +
|
|
Header.BytesPerRow * Longint(Header.Height - 1);
|
|
|
|
case Header.BitmapInfo.bmiHeader.biBitCount of
|
|
{R, G, B images}
|
|
24:
|
|
FOR j := 1 TO Header.Height DO
|
|
begin
|
|
{Process all the pixels in this line}
|
|
FOR i := 0 TO Header.Width - 1 DO
|
|
with ImageData[i] do
|
|
begin
|
|
rgbRed := (255+ImageSource[2+i*3] * AlphaSource[i] + rgbRed * (255 -
|
|
AlphaSource[i])) shr 8;
|
|
rgbGreen := (255+ImageSource[1+i*3] * AlphaSource[i] + rgbGreen *
|
|
(255 - AlphaSource[i])) shr 8;
|
|
rgbBlue := (255+ImageSource[i*3] * AlphaSource[i] + rgbBlue *
|
|
(255 - AlphaSource[i])) shr 8;
|
|
end;
|
|
|
|
{Move pointers}
|
|
Longint(ImageData) := Longint(ImageData) + BytesPerRowDest;
|
|
Longint(ImageSource) := Longint(ImageSource) - BytesPerRowSrc;
|
|
Longint(AlphaSource) := Longint(AlphaSource) + BytesPerRowAlpha;
|
|
end;
|
|
{Palette images with 1 byte for each pixel}
|
|
1,4,8: if Header.ColorType = COLOR_GRAYSCALEALPHA then
|
|
FOR j := 1 TO Header.Height DO
|
|
begin
|
|
{Process all the pixels in this line}
|
|
FOR i := 0 TO Header.Width - 1 DO
|
|
with ImageData[i], Header.BitmapInfo do begin
|
|
rgbRed := (255 + ImageSource[i] * AlphaSource[i] +
|
|
rgbRed * (255 - AlphaSource[i])) shr 8;
|
|
rgbGreen := (255 + ImageSource[i] * AlphaSource[i] +
|
|
rgbGreen * (255 - AlphaSource[i])) shr 8;
|
|
rgbBlue := (255 + ImageSource[i] * AlphaSource[i] +
|
|
rgbBlue * (255 - AlphaSource[i])) shr 8;
|
|
end;
|
|
|
|
{Move pointers}
|
|
Longint(ImageData) := Longint(ImageData) + BytesPerRowDest;
|
|
Longint(ImageSource) := Longint(ImageSource) - BytesPerRowSrc;
|
|
Longint(AlphaSource) := Longint(AlphaSource) + BytesPerRowAlpha;
|
|
end
|
|
else {Palette images}
|
|
begin
|
|
{Obtain pointer to the transparency chunk}
|
|
TransparencyChunk := ChunkByName('tRNS');
|
|
PaletteChunk := ChunkByName('PLTE');
|
|
|
|
FOR j := 1 TO Header.Height DO
|
|
begin
|
|
{Process all the pixels in this line}
|
|
i := 0; Data := @ImageSource[0];
|
|
repeat
|
|
CurBit := 0;
|
|
|
|
repeat
|
|
{Obtains the palette index}
|
|
case Header.BitDepth of
|
|
1: PaletteIndex := (Data^ shr (7-(I Mod 8))) and 1;
|
|
2,4: PaletteIndex := (Data^ shr ((1-(I Mod 2))*4)) and $0F;
|
|
else PaletteIndex := Data^;
|
|
end;
|
|
|
|
{Updates the image with the new pixel}
|
|
with ImageData[i] do
|
|
begin
|
|
TransValue := TransparencyChunk.PaletteValues[PaletteIndex];
|
|
rgbRed := (255 + PaletteChunk.Item[PaletteIndex].rgbRed *
|
|
TransValue + rgbRed * (255 - TransValue)) shr 8;
|
|
rgbGreen := (255 + PaletteChunk.Item[PaletteIndex].rgbGreen *
|
|
TransValue + rgbGreen * (255 - TransValue)) shr 8;
|
|
rgbBlue := (255 + PaletteChunk.Item[PaletteIndex].rgbBlue *
|
|
TransValue + rgbBlue * (255 - TransValue)) shr 8;
|
|
end;
|
|
|
|
{Move to next data}
|
|
inc(i); inc(CurBit, Header.BitmapInfo.bmiHeader.biBitCount);
|
|
until CurBit >= 8;
|
|
{Move to next source data}
|
|
inc(Data);
|
|
until i >= Integer(Header.Width);
|
|
|
|
{Move pointers}
|
|
Longint(ImageData) := Longint(ImageData) + BytesPerRowDest;
|
|
Longint(ImageSource) := Longint(ImageSource) - BytesPerRowSrc;
|
|
end
|
|
end {Palette images}
|
|
end {case Header.BitmapInfo.bmiHeader.biBitCount};
|
|
|
|
{Draws the new bitmap on the foreground}
|
|
StretchBlt(DC, Rect.Left, Rect.Top, Header.Width, Header.Height, BufferDC,
|
|
0, 0, Header.Width, Header.Height, SRCCOPY);
|
|
|
|
{Free bitmap}
|
|
SelectObject(BufferDC, OldBitmap);
|
|
DeleteObject(BufferBitmap);
|
|
DeleteDC(BufferDC);
|
|
end;
|
|
|
|
{Draws the image into a canvas}
|
|
function TPngObject.Draw(DC: HDC; X, Y: Integer): Boolean;
|
|
var
|
|
Hdr: PChunkIHDR;
|
|
begin
|
|
Result := FALSE;
|
|
{Quit in case there is no header, otherwise obtain it}
|
|
Hdr := Header;
|
|
if Hdr = nil then Exit;
|
|
|
|
Result := TRUE;
|
|
if 0 = StretchDiBits(DC, X, Y, {Hdr.Width} ScaledWidth, {Hdr.Height} ScaledHeight, 0, 0,
|
|
ScaledWidth, ScaledHeight, Hdr.ImageData,
|
|
pBitmapInfo(@Hdr.BitmapInfo)^, DIB_RGB_COLORS, SRCCOPY) then
|
|
begin
|
|
if 0 = SetDibitsToDevice( DC, X, Y, {Hdr.Width} ScaledWidth, {Hdr.Height} ScaledHeight, 0, 0, 0,
|
|
{Hdr.Height} ScaledHeight, Pointer( Integer( Hdr.ImageData ) + (Hdr.Height-1) * Hdr.BytesPerRow ),
|
|
pBitmapInfo( @Hdr.BitmapInfo )^, DIB_RGB_COLORS ) then
|
|
begin
|
|
Result := FALSE;
|
|
asm
|
|
nop
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TPngObject.DrawTransparent(DC: HDC; X, Y, maxX, maxY: Integer;
|
|
TranColor: TColor);
|
|
var
|
|
Hdr: PChunkIHDR;
|
|
begin
|
|
{Quit in case there is no header, otherwise obtain it}
|
|
Hdr := Header;
|
|
if Hdr = nil then Exit;
|
|
|
|
{Copy the data to the canvas}
|
|
case Self.TransparencyMode of
|
|
ptmPartial:
|
|
DrawPartialTrans(DC, MakeRect( X, Y, min( X + Width, maxX ), min( Y + Height, maxY ) ));
|
|
else DrawTransparentBitmap(DC,
|
|
Hdr.ImageData, Hdr.BitmapInfo.bmiHeader,
|
|
pBitmapInfo(@Header.BitmapInfo), MakeRect( X, Y, min( X + Width, maxX ), min( Y + Height, maxY ) ),
|
|
Color2RGB(TranColor))
|
|
end {case}
|
|
end;
|
|
|
|
function TPngObject.StretchDraw(DC: HDC; const Rect: TRect): Boolean;
|
|
var
|
|
Hdr: PChunkIHDR;
|
|
begin
|
|
Result := FALSE;
|
|
{Quit in case there is no header, otherwise obtain it}
|
|
Hdr := Header;
|
|
if Hdr = nil then Exit;
|
|
if (Rect.Right - Rect.Left = Hdr.Width) and
|
|
(Rect.Bottom - Rect.Top = Hdr.Height) then
|
|
begin
|
|
Result := Draw( DC, Rect.Left, Rect.Top );
|
|
if Result then
|
|
Exit;
|
|
end;
|
|
Result := Hdr.Height = StretchDiBits(DC, Rect.Left,
|
|
Rect.Top, Rect.Right - Rect.Left, Rect.Bottom - Rect.Top, 0, 0,
|
|
ScaledWidth, ScaledHeight, Hdr.ImageData,
|
|
pBitmapInfo(@Hdr.BitmapInfo)^, DIB_RGB_COLORS, SRCCOPY)
|
|
end;
|
|
|
|
procedure TPngObject.StretchDrawTransparent(DC: HDC; const Rect: TRect;
|
|
TranColor: TColor);
|
|
var
|
|
Hdr: PChunkIHDR;
|
|
begin
|
|
{Quit in case there is no header, otherwise obtain it}
|
|
Hdr := Header;
|
|
if Hdr = nil then Exit;
|
|
|
|
case Self.TransparencyMode of
|
|
ptmPartial:
|
|
DrawPartialTrans(DC, Rect);
|
|
else // ptmBit:
|
|
DrawTransparentBitmap(DC,
|
|
Hdr.ImageData, Hdr.BitmapInfo.bmiHeader,
|
|
pBitmapInfo(@Header.BitmapInfo), Rect,
|
|
Color2RGB(TranColor));
|
|
end;
|
|
end;
|
|
|
|
{Characters for the header}
|
|
const
|
|
PngHeader: Array[0..7] of Char = (#137, #80, #78, #71, #13, #10, #26, #10);
|
|
|
|
{Loads the image from a stream of data}
|
|
function TPngObject.LoadFromStream(Stream: PStream): Boolean;
|
|
const
|
|
ChunkLoadArray: TLoadArray = ( nil, IHDR_Load, nil, IDAT_Load,
|
|
PLTE_Load, gAMA_Load, TRNS_Load, tEXt_Load, tIME_Load );
|
|
var
|
|
Hdr: Array[0..7] of Char;
|
|
HasIDAT: Boolean;
|
|
|
|
{Chunks reading}
|
|
ChunkLength: DWORD;
|
|
ChunkName : TChunkName;
|
|
|
|
Chunk: PChunk;
|
|
CType: TChunkType;
|
|
Start: DWORD;
|
|
begin
|
|
FError := ErrOK;
|
|
Result := FALSE;
|
|
|
|
Start := Stream.Position;
|
|
|
|
{Initialize before start loading chunks}
|
|
ClearChunks();
|
|
{Reads the header}
|
|
Stream.Read(Hdr[0], 8);
|
|
|
|
{Test if the header matches}
|
|
if Hdr <> PngHeader then
|
|
begin
|
|
FError := ErrInvalidHeader;
|
|
Exit;
|
|
end;
|
|
|
|
HasIDAT := FALSE;
|
|
{Load chunks}
|
|
repeat
|
|
if Assigned( fOnProgress ) then
|
|
begin
|
|
if not OnProgress( @ Self, 0, 0,
|
|
(Stream.Position - Start) * 100 div (Stream.Size - Start) ) then
|
|
break;
|
|
end;
|
|
|
|
{Reads chunk length and invert since it is in network order}
|
|
{also checks the Read method return, if it returns 0, it}
|
|
{means that no bytes was readed, probably because it reached}
|
|
{the end of the file}
|
|
if Stream.Read(ChunkLength, 4) < 4 then
|
|
begin
|
|
{In case it found the end of the file here}
|
|
FError := ErrUnexpectedEnd;
|
|
Result := HeaderPresent and (ChunkByName( 'IDAT' ) <> nil);
|
|
Exit;
|
|
end;
|
|
|
|
ChunkLength := ByteSwap(ChunkLength);
|
|
{Reads chunk name}
|
|
Stream.Read(Chunkname, 4);
|
|
|
|
{Here we check if the first chunk is the Header which is necessary}
|
|
{to the file in order to be a valid Portable Network Graphics image}
|
|
if (Chunks.Count = 0) and (ChunkName <> 'IHDR') then
|
|
begin
|
|
FError := ErrIHDRNotFirst;
|
|
exit;
|
|
end;
|
|
|
|
{Has a previous IDAT}
|
|
if (HasIDAT and (ChunkName = 'IDAT')) or (ChunkName = 'cHRM') then
|
|
begin
|
|
Stream.Position := Stream.Position + ChunkLength + 4;
|
|
Continue;
|
|
end;
|
|
{Tell it has an IDAT chunk}
|
|
if ChunkName = 'IDAT' then HasIDAT := TRUE;
|
|
|
|
{Creates object for this chunk}
|
|
|
|
Chunk := CreateChunkByName( ChunkName );
|
|
|
|
{Check if the chunk is unknown and this is critical}
|
|
if Chunk = nil then
|
|
begin
|
|
FError := ErrUnknownCriticalChunk;
|
|
Exit;
|
|
end;
|
|
|
|
{Loads it}
|
|
CType := ChunkTypeByName( ChunkName );
|
|
if Assigned( ChunkLoadArray[ CType ] ) then
|
|
begin
|
|
if not ChunkLoadArray[ CType ]( Chunk, Stream, ChunkName, ChunkLength ) then
|
|
break;
|
|
if HasIDAT and (Scale <> psFullImage) then
|
|
break;
|
|
end
|
|
else
|
|
begin
|
|
if not Chunk.LoadFromStream( Stream, ChunkName, ChunkLength ) then
|
|
break;
|
|
end;
|
|
|
|
{Terminates when it reaches the IEND chunk}
|
|
until (ChunkName = 'IEND');
|
|
|
|
{Check if there is data}
|
|
if not HasIDAT then
|
|
begin
|
|
FError := ErrNoImageData;
|
|
Exit;
|
|
end;
|
|
|
|
Result := TRUE;
|
|
end;
|
|
|
|
{Saves to clipboard format (thanks to Antoine Pottern)}
|
|
function TPNGObject.CopyToClipboard: Boolean;
|
|
begin
|
|
Result := FALSE;
|
|
if Bitmap <> nil then
|
|
Result := Bitmap.CopyToClipboard;
|
|
end;
|
|
{var Bitmap: PBitmap;
|
|
begin
|
|
Bitmap := NewBitmap( Width, Height );
|
|
TRY
|
|
Draw( Bitmap.Canvas.Handle, 0, 0 );
|
|
Result := Bitmap.CopyToClipboard;
|
|
FINALLY
|
|
Bitmap.Free;
|
|
END;
|
|
end;}
|
|
|
|
{Loads data from clipboard}
|
|
function TPngObject.PasteFromClipboard: Boolean;
|
|
var Bitmap1: PBitmap;
|
|
begin
|
|
Bitmap1 := NewBitmap( 0, 0 );
|
|
TRY
|
|
Result := Bitmap1.PasteFromClipboard;
|
|
if not Result then Exit;
|
|
AssignHandle( Bitmap1.Handle, FALSE, 0 );
|
|
FINALLY
|
|
Bitmap1.Free;
|
|
END;
|
|
end;
|
|
|
|
{Returns if the image is transparent}
|
|
{function TPngObject.GetTransparent: Boolean;
|
|
begin
|
|
Result := (TransparencyMode <> ptmNone);
|
|
end;}
|
|
|
|
{Saving the PNG image to a stream of data}
|
|
procedure TPngObject.SaveToStream(Stream: PStream);
|
|
const
|
|
ChunkSaveArray: TSaveArray = ( nil, IHDR_Save, nil, IDAT_Save,
|
|
PLTE_Save, nil, TRNS_Save, tEXt_Save, tIME_Save );
|
|
var
|
|
j: Integer;
|
|
CType: TChunkType;
|
|
begin
|
|
{Reads the header}
|
|
Stream.Write(PNGHeader[0], 8);
|
|
{Write each chunk}
|
|
FOR j := 0 TO Chunks.Count - 1 DO
|
|
begin
|
|
CType := ChunkTypeByName( PChunk( Chunks.Items[j] ).ChnkName );
|
|
if Assigned( ChunkSaveArray[ CType ] ) then
|
|
ChunkSaveArray[ CType ]( Chunks.Items[j], Stream )
|
|
else
|
|
PChunk( Chunks.Items[j] ).SaveToStream(Stream);
|
|
end;
|
|
end;
|
|
|
|
{Prepares the Header chunk}
|
|
procedure BuildHeader(Header: PChunkIHDR; Handle: HBitmap; Info: Windows.PBitmap;
|
|
HasPalette: Boolean);
|
|
var
|
|
DC: HDC;
|
|
begin
|
|
{Set width and height}
|
|
Header.Width := Info.bmWidth;
|
|
Header.Height := abs(Info.bmHeight);
|
|
{Set bit depth}
|
|
if Info.bmBitsPixel >= 16 then
|
|
Header.BitDepth := 8 else Header.BitDepth := Info.bmBitsPixel;
|
|
{Set color type}
|
|
if Info.bmBitsPixel >= 16 then
|
|
Header.ColorType := COLOR_RGB else Header.ColorType := COLOR_PALETTE;
|
|
{Set other info}
|
|
Header.CompressionMethod := 0; {deflate/inflate}
|
|
Header.InterlaceMethod := 0; {no interlace}
|
|
|
|
{Prepares bitmap headers to hold data}
|
|
Header.PrepareImageData();
|
|
if Handle <> 0 then
|
|
begin
|
|
{Copy image data}
|
|
DC := CreateCompatibleDC(0);
|
|
GetDIBits(DC, Handle, 0, Header.Height, Header.ImageData,
|
|
pBitmapInfo(@Header.BitmapInfo)^, DIB_RGB_COLORS);
|
|
DeleteDC(DC);
|
|
end;
|
|
end;
|
|
|
|
{Loads the image from a resource}
|
|
procedure TPngObject.LoadFromResourceName(Instance: HInst;
|
|
const AName: String);
|
|
var MemStream: PStream;
|
|
begin
|
|
{Creates an especial stream to load from the resource}
|
|
MemStream := NewMemoryStream;
|
|
Resource2Stream( MemStream, Instance, PChar( AName ), RT_RCDATA );
|
|
{Loads the png image from the resource}
|
|
try
|
|
MemStream.Position := 0;
|
|
LoadFromStream(MemStream);
|
|
finally
|
|
MemStream.Free;
|
|
end;
|
|
end;
|
|
|
|
{Loads the png from a resource ID}
|
|
procedure TPngObject.LoadFromResourceID(Instance: HInst; ResID: Integer);
|
|
begin
|
|
LoadFromResourceName(Instance, String(ResID));
|
|
end;
|
|
|
|
{Assigns from a bitmap object}
|
|
procedure TPngObject.AssignHandle(Handle: HBitmap; Transparent: Boolean;
|
|
TranColor: ColorRef);
|
|
var
|
|
BitmapInfo: Windows.TBitmap;
|
|
HasPalette: Boolean;
|
|
|
|
{Chunks}
|
|
Head: PChunkIHDR;
|
|
PLTE: PChunkPLTE;
|
|
//IDAT: PChunkIDAT;
|
|
//IEND: PChunkIEND;
|
|
TRNS: PChunkTRNS;
|
|
begin
|
|
{Obtain bitmap info}
|
|
GetObject(Handle, SizeOf(BitmapInfo), @BitmapInfo);
|
|
|
|
{Only bit depths 1, 4 and 8 needs a palette}
|
|
HasPalette := (BitmapInfo.bmBitsPixel < 16);
|
|
|
|
{Clear old chunks and prepare}
|
|
ClearChunks();
|
|
|
|
{Create the chunks}
|
|
Head := CreateChunkByName( 'IHDR' );
|
|
|
|
PLTE := nil;
|
|
if HasPalette then
|
|
PLTE := CreateChunkByName( 'PLTE' );
|
|
|
|
TRNS := nil;
|
|
if Transparent then
|
|
TRNS := CreateChunkByName( 'TRNS' );
|
|
CreateChunkByName( 'IDAT' );
|
|
CreateChunkByName( 'IEND' );
|
|
|
|
{This method will fill the Header chunk with bitmap information}
|
|
{and copy the image data}
|
|
BuildHeader(Head, Handle, @BitmapInfo, HasPalette);
|
|
|
|
{In case there is a image data, set the PLTE chunk fCount variable}
|
|
{to the actual number of palette colors which is 2^(Bits for each pixel)}
|
|
if HasPalette then PLTE.fCount := 1 shl BitmapInfo.bmBitsPixel;
|
|
|
|
{In case it is a transparent bitmap, prepares it}
|
|
if Transparent then TRNS.TransparentColor := TranColor;
|
|
|
|
end;
|
|
|
|
{Assigns from another PNG}
|
|
procedure TPngObject.AssignPNG(Source: PPNGObject);
|
|
var Strm: PStream;
|
|
begin
|
|
Strm := NewMemoryStream;
|
|
Source.SaveToStream( Strm );
|
|
Strm.Position := 0;
|
|
LoadFromStream( Strm );
|
|
Strm.Free;
|
|
end;
|
|
|
|
{Returns a alpha data scanline}
|
|
function TPngObject.GetAlphaScanline(const LineIndex: Integer): pByteArray;
|
|
begin
|
|
with Header^ do
|
|
if (ColorType = COLOR_RGBALPHA) or (ColorType = COLOR_GRAYSCALEALPHA) then
|
|
Integer(Result) := Integer(ImageAlpha) + (LineIndex * Longint(Width))
|
|
else Result := nil; {In case the image does not use alpha information}
|
|
end;
|
|
|
|
{Returns a png data scanline}
|
|
function TPngObject.GetScanline(const LineIndex: Integer): Pointer;
|
|
begin
|
|
with Header^ do
|
|
Integer(Result) := (Integer(ImageData) + ((Integer(Height) - 1) *
|
|
BytesPerRow)) - (LineIndex * BytesPerRow);
|
|
end;
|
|
|
|
{Initialize gamma table}
|
|
procedure TPngObject.InitializeGamma;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
{Build gamma table as if there was no gamma}
|
|
FOR i := 0 to 255 do
|
|
begin
|
|
GammaTable[i] := i;
|
|
InverseGamma[i] := i;
|
|
end {for i}
|
|
end;
|
|
|
|
{Returns the transparency mode used by this png}
|
|
function TPngObject.GetTransparencyMode: TPNGTransparencyMode;
|
|
var
|
|
TRNS: PChunkTRNS;
|
|
begin
|
|
with Header^ do
|
|
begin
|
|
Result := ptmNone; {Default result}
|
|
{Gets the TRNS chunk pointer}
|
|
TRNS := ChunkByName('TRNS');
|
|
|
|
{Test depending on the color type}
|
|
case ColorType of
|
|
{This modes are always partial}
|
|
COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA: Result := ptmPartial;
|
|
{This modes support bit transparency}
|
|
COLOR_RGB, COLOR_GRAYSCALE: if TRNS <> nil then Result := ptmBit;
|
|
{Supports booth translucid and bit}
|
|
COLOR_PALETTE:
|
|
{A TRNS chunk must be present, otherwise it won't support transparency}
|
|
if TRNS <> nil then
|
|
if TRNS.BitTransparency then
|
|
Result := ptmBit else Result := ptmPartial
|
|
end {case}
|
|
|
|
end {with Header}
|
|
end;
|
|
|
|
{Add a text chunk}
|
|
procedure TPngObject.AddText(const Keyword, Text: String);
|
|
var
|
|
TextChunk: PChunkTEXT;
|
|
begin
|
|
new( TextChunk, Create( @ Self ) );
|
|
fChunkList.Insert( fChunkList.Count-1, TextChunk );
|
|
TextChunk.Keyword := Keyword;
|
|
TextChunk.Text := Text;
|
|
end;
|
|
|
|
{Removes the image transparency}
|
|
procedure TPngObject.RemoveTransparency;
|
|
var TRNS: PChunkTRNS;
|
|
begin
|
|
TRNS := ChunkByName('TRNS');
|
|
if TRNS <> nil then
|
|
begin
|
|
Chunks.Remove(TRNS);
|
|
TRNS.Free;
|
|
end;
|
|
end;
|
|
|
|
{Generates alpha information}
|
|
procedure TPngObject.CreateAlpha;
|
|
var
|
|
TRNS: PChunkTRNS;
|
|
begin
|
|
{Generates depending on the color type}
|
|
with Header^ do
|
|
case ColorType of
|
|
{Png allocates different memory space to hold alpha information}
|
|
{for these types}
|
|
COLOR_GRAYSCALE, COLOR_RGB:
|
|
begin
|
|
{Transform into the appropriate color type}
|
|
if ColorType = COLOR_GRAYSCALE then
|
|
ColorType := COLOR_GRAYSCALEALPHA
|
|
else ColorType := COLOR_RGBALPHA;
|
|
{Allocates memory to hold alpha information}
|
|
GetMem(ImageAlpha, Integer(Width) * Integer(Height));
|
|
FillChar(ImageAlpha^, Integer(Width) * Integer(Height), #255);
|
|
end;
|
|
{Palette uses the TChunktRNS to store alpha}
|
|
COLOR_PALETTE:
|
|
begin
|
|
{Gets/creates TRNS chunk}
|
|
TRNS := ChunkByName( 'TRNS' );
|
|
if TRNS = nil then
|
|
TRNS := CreateChunkByName( 'TRNS' );
|
|
|
|
{Prepares the TRNS chunk}
|
|
with TRNS^ do
|
|
begin
|
|
Fillchar(PaletteValues[0], 256, #255);
|
|
fDataSize := 1 shl Header.BitDepth;
|
|
fBitTransparency := False
|
|
end {with Chunks.Add};
|
|
end;
|
|
end {case Header.ColorType}
|
|
|
|
end;
|
|
|
|
{Returns transparent color}
|
|
function TPngObject.GetTransparentColor: TColor;
|
|
var
|
|
TRNS: PChunkTRNS;
|
|
begin
|
|
TRNS := ChunkByName( 'TRNS' );
|
|
{Reads the transparency chunk to get this info}
|
|
if Assigned(TRNS) then Result := TRNS.TransparentColor
|
|
else Result := 0
|
|
end;
|
|
|
|
procedure TPngObject.SetTransparentColor(const Value: TColor);
|
|
var
|
|
TRNS: PChunkTRNS;
|
|
begin
|
|
if HeaderPresent then
|
|
{Tests the ColorType}
|
|
case Header.ColorType of
|
|
{Not allowed for this modes}
|
|
COLOR_RGBALPHA, COLOR_GRAYSCALEALPHA:
|
|
{Self.RaiseError(
|
|
EPNGCannotChangeTransparent, EPNGCannotChangeTransparentText)};
|
|
{Allowed}
|
|
COLOR_PALETTE, COLOR_RGB, COLOR_GRAYSCALE:
|
|
begin
|
|
TRNS := ChunkByName('TRNS');
|
|
if not Assigned(TRNS) then
|
|
TRNS := CreateChunkByName('TRNS');
|
|
{Sets the transparency value from TRNS chunk}
|
|
TRNS.TransparentColor := Value
|
|
end {COLOR_PALETTE, COLOR_RGB, COLOR_GRAYSCALE)}
|
|
end {case}
|
|
end;
|
|
|
|
{Returns if header is present}
|
|
function TPngObject.HeaderPresent: Boolean;
|
|
begin
|
|
Result := (Chunks.Count > 0) and (PChunk(Chunks.Items[0]).ChnkName = 'IHDR')
|
|
end;
|
|
|
|
function TPngObject.ChunkByName(const AName: TChunkName): Pointer;
|
|
var I: Integer;
|
|
Chunk: PChunk;
|
|
begin
|
|
for I := 0 to fChunkList.Count-1 do
|
|
begin
|
|
Chunk := fChunkList.Items[ I ];
|
|
if Chunk.ChnkName = AName then
|
|
begin
|
|
Result := Chunk;
|
|
Exit;
|
|
end;
|
|
end;
|
|
Result := nil;
|
|
end;
|
|
|
|
function TPngObject.CreateChunkByName(const AName: TChunkName): Pointer;
|
|
var
|
|
IHDR: PChunkIHDR;
|
|
IEND: PChunkIEND;
|
|
IDAT: PChunkIDAT;
|
|
PLTE: PChunkPLTE;
|
|
GAMA: PChunkGAMA;
|
|
TRNS: PChunkTRNS;
|
|
TEXT: PChunkTEXT;
|
|
TIME: PChunkTIME;
|
|
Chnk: PChunk;
|
|
begin
|
|
Result := nil;
|
|
case ChunkTypeByName( AName ) of
|
|
ctIHDR: begin
|
|
if HeaderPresent then Exit;
|
|
new( IHDR, Create( @ Self ) );
|
|
fChunkList.Insert( 0, IHDR );
|
|
Result := IHDR;
|
|
end;
|
|
ctIEND: begin
|
|
if (fChunkList.Count > 0) and
|
|
(PChunk( fChunkList.Items[ fChunkList.Count-1 ] ).ChnkName = 'IEND') then
|
|
Exit;
|
|
new( IEND, Create( @ Self ) );
|
|
fChunkList.Add( IEND );
|
|
Result := IEND;
|
|
end;
|
|
ctIDAT: begin
|
|
if ChunkByName( 'IDAT' ) <> nil then Exit;
|
|
new( IDAT, Create( @ Self ) );
|
|
IHDR := ChunkByName( 'IHDR' );
|
|
PLTE := ChunkByName( 'PLTE' );
|
|
if PLTE <> nil then
|
|
fChunkList.Insert( PLTE.Index+1, IDAT )
|
|
else
|
|
if IHDR <> nil then
|
|
fChunkList.Insert( 1, IDAT )
|
|
else
|
|
fChunkList.Insert( 0, IDAT );
|
|
Result := IDAT;
|
|
end;
|
|
ctPLTE: begin
|
|
if ChunkByName( 'PLTE' ) <> nil then Exit;
|
|
new( PLTE, Create( @ Self ) );
|
|
IDAT := ChunkByName( 'IDAT' );
|
|
IHDR := ChunkByName( 'IHDR' );
|
|
if IDAT <> nil then
|
|
fChunkList.Insert( IDAT.Index, PLTE )
|
|
else if IHDR <> nil then
|
|
fChunkList.Insert( 1, PLTE )
|
|
else
|
|
fChunkList.Insert( 0, PLTE );
|
|
Result := PLTE;
|
|
end;
|
|
ctgAMA: begin
|
|
if ChunkByName( 'gAMA' ) <> nil then Exit;
|
|
new( GAMA, Create( @ Self ) );
|
|
PLTE := ChunkByName( 'PLTE' );
|
|
IDAT := ChunkByName( 'IDAT' );
|
|
IHDR := ChunkByName( 'IHDR' );
|
|
if PLTE <> nil then
|
|
fChunkList.Insert( PLTE.Index + 1, GAMA )
|
|
else if IDAT <> nil then
|
|
fChunkList.Insert( IDAT.Index + 1, GAMA )
|
|
else if IHDR <> nil then
|
|
fChunkList.Insert( 1, GAMA )
|
|
else
|
|
fChunkList.Insert( 0, GAMA );
|
|
Result := GAMA;
|
|
end;
|
|
ctTRNS: begin
|
|
if ChunkByName( 'TRNS' ) <> nil then Exit;
|
|
new( TRNS, Create( @ Self ) );
|
|
GAMA := ChunkByName( 'gAMA' );
|
|
PLTE := ChunkByName( 'PLTE' );
|
|
IDAT := ChunkByName( 'IDAT' );
|
|
IHDR := ChunkByName( 'IHDR' );
|
|
if GAMA <> nil then
|
|
fChunkList.Insert( GAMA.Index + 1, TRNS )
|
|
else if PLTE <> nil then
|
|
fChunkList.Insert( PLTE.Index + 1, TRNS )
|
|
else if IDAT <> nil then
|
|
fChunkList.Insert( IDAT.Index + 1, TRNS )
|
|
else if IHDR <> nil then
|
|
fChunkList.Insert( 1, TRNS )
|
|
else
|
|
fChunkList.Insert( 0, TRNS );
|
|
Result := GAMA;
|
|
end;
|
|
cttEXt: begin
|
|
new( TEXT, Create( @ Self ) );
|
|
IEND := ChunkByName( 'IEND' );
|
|
if IEND <> nil then
|
|
fChunkList.Insert( IEND.Index, TEXT )
|
|
else
|
|
fChunkList.Add( TEXT );
|
|
Result := TEXT;
|
|
end;
|
|
cttIME: begin
|
|
new( TIME, Create( @ Self ) );
|
|
IEND := ChunkByName( 'IEND' );
|
|
if IEND <> nil then
|
|
fChunkList.Insert( IEND.Index, TIME )
|
|
else
|
|
fChunkList.Add( TIME );
|
|
Result := TIME;
|
|
end;
|
|
else
|
|
begin
|
|
new( Chnk, Create( @ Self ) );
|
|
IEND := ChunkByName( 'IEND' );
|
|
if IEND <> nil then
|
|
fChunkList.Insert( IEND.Index, Chnk )
|
|
else
|
|
fChunkList.Add( Chnk );
|
|
Result := Chnk;
|
|
end;
|
|
end;
|
|
PChunk( Result ).fChnkName := AName;
|
|
end;
|
|
|
|
{ TChunktEXt }
|
|
|
|
destructor TChunktEXt.Destroy;
|
|
begin
|
|
fKeyword := '';
|
|
fText := '';
|
|
inherited;
|
|
end;
|
|
|
|
procedure TPngObject.AssignDib(DibHeader: pBitmapInfo; DibData: Pointer;
|
|
Transparent: Boolean; TranColor: ColorRef);
|
|
var
|
|
BitmapInfo: Windows.TBitmap;
|
|
HasPalette: Boolean;
|
|
|
|
{Chunks}
|
|
Head: PChunkIHDR;
|
|
PLTE: PChunkPLTE;
|
|
//IDAT: PChunkIDAT;
|
|
//IEND: PChunkIEND;
|
|
TRNS: PChunkTRNS;
|
|
begin
|
|
{Obtain bitmap info}
|
|
FillChar( BitmapInfo, SizeOf( BitmapInfo ), 0 );
|
|
BitmapInfo.bmType := 0;
|
|
BitmapInfo.bmWidth := DibHeader.bmiHeader.biWidth;
|
|
BitmapInfo.bmHeight := DibHeader.bmiHeader.biHeight;
|
|
BitmapInfo.bmWidthBytes := ( (DibHeader.bmiHeader.biWidth *
|
|
(DibHeader.bmiHeader.biPlanes * DibHeader.bmiHeader.biBitCount) + 7) div 8
|
|
+ 3) div 4;
|
|
BitmapInfo.bmPlanes := DibHeader.bmiHeader.biPlanes;
|
|
BitmapInfo.bmBitsPixel := DibHeader.bmiHeader.biPlanes * DibHeader.bmiHeader.biBitCount;
|
|
BitmapInfo.bmBits := DibData;
|
|
|
|
{Only bit depths 1, 4 and 8 needs a palette}
|
|
HasPalette := (BitmapInfo.bmBitsPixel < 16);
|
|
|
|
{Clear old chunks and prepare}
|
|
ClearChunks();
|
|
|
|
{Create the chunks}
|
|
Head := CreateChunkByName( 'IHDR' );
|
|
|
|
PLTE := nil;
|
|
if HasPalette then
|
|
PLTE := CreateChunkByName( 'PLTE' );
|
|
|
|
TRNS := nil;
|
|
if Transparent then
|
|
TRNS := CreateChunkByName( 'TRNS' );
|
|
CreateChunkByName( 'IDAT' );
|
|
CreateChunkByName( 'IEND' );
|
|
|
|
{This method will fill the Header chunk with bitmap information}
|
|
{and copy the image data}
|
|
BuildHeader(Head, 0, @BitmapInfo, HasPalette);
|
|
|
|
{In case there is a image data, set the PLTE chunk fCount variable}
|
|
{to the actual number of palette colors which is 2^(Bits for each pixel)}
|
|
if HasPalette then PLTE.fCount := 1 shl BitmapInfo.bmBitsPixel;
|
|
|
|
{In case it is a transparent bitmap, prepares it}
|
|
if Transparent then TRNS.TransparentColor := TranColor;
|
|
|
|
end;
|
|
|
|
type
|
|
PCrackBitmap = ^TCrackBitmap;
|
|
TCrackBitmap = object( TBitmap )
|
|
end;
|
|
|
|
function TPngObject.GetBitmap: PBitmap;
|
|
begin
|
|
Result := fBitmap;
|
|
if Result <> nil then Exit;
|
|
if (Header = nil) or (Header.ImageData = nil) then Exit;
|
|
fBitmap := NewDIBBitmap( 1, 1, pf1bit );
|
|
GlobalFree( DWORD( PCrackBitmap( fBitmap ).fDIBBits ) );
|
|
move( Header.BitmapInfo, PCrackBitmap( fBitmap ).fDIBHeader^,
|
|
Sizeof( TMAXBITMAPINFO ) );
|
|
PCrackBitmap( fBitmap ).fDIBBits := Header.ImageData;
|
|
PCrackBitmap( fBitmap ).fWidth := Width;
|
|
PCrackBitmap( fBitmap ).fHeight := Height;
|
|
PCrackBitmap( fBitmap ).fDIBAutoFree := TRUE;
|
|
PCrackBitmap( fBitmap ).fScanLineSize :=
|
|
CalcScanLineSize( @PCrackBitmap( fBitmap ).fDIBHeader.bmiHeader );
|
|
PCrackBitmap( fBitmap ).fDibSize := PCrackBitmap( fBitmap ).fScanLineSize
|
|
* Height;
|
|
Result := fBitmap;
|
|
end;
|
|
|
|
{$IFDEF PNG_MMX}
|
|
initialization
|
|
mmxSupported := GetCpuType >= [ cpuMMX ];
|
|
{$ENDIF}
|
|
|
|
end.
|