| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166 |
- {
- $Id$
- Vampyre Imaging Library
- by Marek Mauder
- http://imaginglib.sourceforge.net
- The contents of this file are used with permission, subject to the Mozilla
- Public License Version 1.1 (the "License"); you may not use this file except
- in compliance with the License. You may obtain a copy of the License at
- http://www.mozilla.org/MPL/MPL-1.1.html
- Software distributed under the License is distributed on an "AS IS" basis,
- WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
- the specific language governing rights and limitations under the License.
- Alternatively, the contents of this file may be used under the terms of the
- GNU Lesser General Public License (the "LGPL License"), in which case the
- provisions of the LGPL License are applicable instead of those above.
- If you wish to allow use of your version of this file only under the terms
- of the LGPL License and not to allow others to use your version of this file
- under the MPL, indicate your decision by deleting the provisions above and
- replace them with the notice and other provisions required by the LGPL
- License. If you do not delete the provisions above, a recipient may use
- your version of this file under either the MPL or the LGPL License.
- For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
- }
- { This unit contains image format loaders/savers for Network Graphics image
- file formats PNG, MNG, and JNG.}
- unit ImagingNetworkGraphics;
- interface
- {$I ImagingOptions.inc}
- uses
- Classes, ImagingTypes, Imaging, ImagingUtility, ImagingFormats, dzlib;
- type
- { Basic class for Network Graphics file formats loaders/savers.}
- TNetworkGraphicsFileFormat = class(TImageFileFormat)
- protected
- FSignature: TChar8;
- FPreFilter: LongInt;
- FCompressLevel: LongInt;
- FLossyCompression: LongBool;
- FLossyAlpha: LongBool;
- FQuality: LongInt;
- FProgressive: LongBool;
- function GetSupportedFormats: TImageFormats; override;
- procedure ConvertToSupported(var Image: TImageData;
- const Info: TImageFormatInfo); override;
- public
- constructor Create; override;
- function TestFormat(Handle: TImagingHandle): Boolean; override;
- procedure CheckOptionsValidity; override;
- published
- { Sets precompression filter used when saving images with lossless compression.
- Allowed values are: 0 (none), 1 (sub), 2 (up), 3 (average), 4 (paeth),
- 5 (use 0 for indexed/gray images and 4 for RGB/ARGB images),
- 6 (adaptive filtering - use best filter for each scanline - very slow).
- Note that filters 3 and 4 are much slower than filters 1 and 2.
- Default value is 5.}
- property PreFilter: LongInt read FPreFilter write FPreFilter;
- { Sets ZLib compression level used when saving images with lossless compression.
- Allowed values are in range 0 (no compresstion) to 9 (best compression).
- Default value is 5.}
- property CompressLevel: LongInt read FCompressLevel write FCompressLevel;
- { Specifies whether MNG animation frames are saved with lossy or lossless
- compression. Lossless frames are saved as PNG images and lossy frames are
- saved as JNG images. Allowed values are 0 (False) and 1 (True).
- Default value is 0.}
- property LossyCompression: LongBool read FLossyCompression write FLossyCompression;
- { Defines whether alpha channel of lossy MNG frames or JNG images
- is lossy compressed too. Allowed values are 0 (False) and 1 (True).
- Default value is 0.}
- property LossyAlpha: LongBool read FLossyAlpha write FLossyAlpha;
- { Specifies compression quality used when saving lossy MNG frames or JNG images.
- For details look at ImagingJpegQuality option.}
- property Quality: LongInt read FQuality write FQuality;
- { Specifies whether images are saved in progressive format when saving lossy
- MNG frames or JNG images. For details look at ImagingJpegProgressive.}
- property Progressive: LongBool read FProgressive write FProgressive;
- end;
- { Class for loading Portable Network Graphics Images.
- Loads all types of this image format (all images in png test suite)
- and saves all types with bitcount >= 8 (non-interlaced only).
- Compression level and filtering can be set by options interface.
- Supported ancillary chunks (loading):
- tRNS, bKGD
- (for indexed images transparency contains alpha values for palette,
- RGB/Gray images with transparency are converted to formats with alpha
- and pixels with transparent color are replaced with background color
- with alpha = 0).}
- TPNGFileFormat = class(TNetworkGraphicsFileFormat)
- protected
- function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
- OnlyFirstLevel: Boolean): Boolean; override;
- function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
- Index: LongInt): Boolean; override;
- public
- constructor Create; override;
- end;
- {$IFDEF LINK_MNG}
- { Class for loading Multiple Network Graphics files.
- This format has complex animation capabilities but Imaging only
- extracts frames. Individual frames are stored as standard PNG or JNG
- images. Loads all types of these frames stored in IHDR-IEND and
- JHDR-IEND streams (Note that there are MNG chunks
- like BASI which define images but does not contain image data itself,
- those are ignored).
- Imaging saves MNG files as MNG-VLC (very low complexity) so it is basicaly
- an array of image frames without MNG animation chunks. Frames can be saved
- as lossless PNG or lossy JNG images (look at TPNGFileFormat and
- TJNGFileFormat for info). Every frame can be in different data format.
-
- Many frame compression settings can be modified by options interface.}
- TMNGFileFormat = class(TNetworkGraphicsFileFormat)
- protected
- function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
- OnlyFirstLevel: Boolean): Boolean; override;
- function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
- Index: LongInt): Boolean; override;
- public
- constructor Create; override;
- end;
- {$ENDIF}
- {$IFDEF LINK_JNG}
- { Class for loading JPEG Network Graphics Images.
- Loads all types of this image format (all images in jng test suite)
- and saves all types except 12 bit JPEGs.
- Alpha channel in JNG images is stored separately from color/gray data and
- can be lossy (as JPEG image) or lossless (as PNG image) compressed.
- Type of alpha compression, compression level and quality,
- and filtering can be set by options interface.
- Supported ancillary chunks (loading):
- tRNS, bKGD
- (Images with transparency are converted to formats with alpha
- and pixels with transparent color are replaced with background color
- with alpha = 0).}
- TJNGFileFormat = class(TNetworkGraphicsFileFormat)
- protected
- function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
- OnlyFirstLevel: Boolean): Boolean; override;
- function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
- Index: LongInt): Boolean; override;
- public
- constructor Create; override;
- end;
- {$ENDIF}
- implementation
- {$IFDEF LINK_JNG}
- uses
- ImagingJpeg, ImagingIO;
- {$ENDIF}
- const
- NGDefaultPreFilter = 5;
- NGDefaultCompressLevel = 5;
- NGDefaultLossyAlpha = False;
- NGDefaultLossyCompression = False;
- NGDefaultProgressive = False;
- NGDefaultQuality = 90;
- NGLosslessFormats: TImageFormats = [ifIndex8, ifGray8, ifA8Gray8, ifGray16,
- ifA16Gray16, ifR8G8B8, ifA8R8G8B8, ifR16G16B16, ifA16R16G16B16, ifB16G16R16,
- ifA16B16G16R16];
- NGLossyFormats: TImageFormats = [ifGray8, ifA8Gray8, ifR8G8B8, ifA8R8G8B8];
- SPNGFormatName = 'Portable Network Graphics';
- SPNGMasks = '*.png';
- SMNGFormatName = 'Multiple Network Graphics';
- SMNGMasks = '*.mng';
- SJNGFormatName = 'JPEG Network Graphics';
- SJNGMasks = '*.jng';
- resourcestring
- SErrorLoadingChunk = 'Error when reading %s chunk data. File may be corrupted.';
- type
- { Chunk header.}
- TChunkHeader = packed record
- DataSize: LongWord;
- ChunkID: TChar4;
- end;
- { IHDR chunk format.}
- TIHDR = packed record
- Width: LongWord; // Image width
- Height: LongWord; // Image height
- BitDepth: Byte; // Bits per pixel or bits per sample (for truecolor)
- ColorType: Byte; // 0 = grayscale, 2 = truecolor, 3 = palette,
- // 4 = gray + alpha, 6 = truecolor + alpha
- Compression: Byte; // Compression type: 0 = ZLib
- Filter: Byte; // Used precompress filter
- Interlacing: Byte; // Used interlacing: 0 = no int, 1 = Adam7
- end;
- PIHDR = ^TIHDR;
- { MHDR chunk format.}
- TMHDR = packed record
- FrameWidth: LongWord; // Frame width
- FrameHeight: LongWord; // Frame height
- TicksPerSecond: LongWord; // FPS of animation
- NominalLayerCount: LongWord; // Number of layers in file
- NominalFrameCount: LongWord; // Number of frames in file
- NominalPlayTime: LongWord; // Play time of animation in ticks
- SimplicityProfile: LongWord; // Defines which mMNG features are used in this file
- end;
- PMHDR = ^TMHDR;
- { JHDR chunk format.}
- TJHDR = packed record
- Width: LongWord; // Image width
- Height: LongWord; // Image height
- ColorType: Byte; // 8 = grayscale (Y), 10 = color (YCbCr),
- // 12 = gray + alpha (Y-alpha), 14 = color + alpha (YCbCr-alpha)
- SampleDepth: Byte; // 8, 12 or 20 (8 and 12 samples together) bit
- Compression: Byte; // Compression type: 8 = Huffman coding
- Interlacing: Byte; // 0 = single scan, 8 = progressive
- AlphaSampleDepth: Byte; // 0, 1, 2, 4, 8, 16 if alpha compression is 0 (PNG)
- // 8 if alpha compression is 8 (JNG)
- AlphaCompression: Byte; // 0 = PNG graysscale IDAT, 8 = grayscale 8-bit JPEG
- AlphaFilter: Byte; // 0 = PNG filter or no filter (JPEG)
- AlphaInterlacing: Byte; // 0 = non interlaced
- end;
- PJHDR = ^TJHDR;
- const
- { PNG file identifier.}
- PNGSignature: TChar8 = #$89'PNG'#$0D#$0A#$1A#$0A;
- { MNG file identifier.}
- MNGSignature: TChar8 = #$8A'MNG'#$0D#$0A#$1A#$0A;
- { JNG file identifier.}
- JNGSignature: TChar8 = #$8B'JNG'#$0D#$0A#$1A#$0A;
- { Constants for chunk identifiers and signature identifiers.
- They are in big-endian format.}
- IHDRChunk: TChar4 = 'IHDR';
- IENDChunk: TChar4 = 'IEND';
- MHDRChunk: TChar4 = 'MHDR';
- MENDChunk: TChar4 = 'MEND';
- JHDRChunk: TChar4 = 'JHDR';
- IDATChunk: TChar4 = 'IDAT';
- JDATChunk: TChar4 = 'JDAT';
- JDAAChunk: TChar4 = 'JDAA';
- JSEPChunk: TChar4 = 'JSEP';
- PLTEChunk: TChar4 = 'PLTE';
- BACKChunk: TChar4 = 'BACK';
- DEFIChunk: TChar4 = 'DEFI';
- TERMChunk: TChar4 = 'TERM';
- tRNSChunk: TChar4 = 'tRNS';
- bKGDChunk: TChar4 = 'bKGD';
- gAMAChunk: TChar4 = 'gAMA';
- { Interlace start and offsets.}
- RowStart: array[0..6] of LongInt = (0, 0, 4, 0, 2, 0, 1);
- ColumnStart: array[0..6] of LongInt = (0, 4, 0, 2, 0, 1, 0);
- RowIncrement: array[0..6] of LongInt = (8, 8, 8, 4, 4, 2, 2);
- ColumnIncrement: array[0..6] of LongInt = (8, 8, 4, 4, 2, 2, 1);
- type
- { Helper class that holds information about MNG frame in PNG or JNG format.}
- TFrameInfo = class(TObject)
- public
- IsJNG: Boolean;
- IHDR: TIHDR;
- JHDR: TJHDR;
- Palette: PPalette24;
- PaletteEntries: LongInt;
- Transparency: Pointer;
- TransparencySize: LongInt;
- Background: Pointer;
- BackgroundSize: LongInt;
- IDATMemory: TMemoryStream;
- JDATMemory: TMemoryStream;
- JDAAMemory: TMemoryStream;
- constructor Create;
- destructor Destroy; override;
- end;
- { Defines type of Network Graphics file.}
- TNGFileType = (ngPNG, ngMNG, ngJNG);
- TNGFileHandler = class(TObject)
- public
- FileType: TNGFileType;
- Frames: array of TFrameInfo;
- MHDR: TMHDR;
- GlobalPalette: PPalette24;
- GlobalPaletteEntries: LongInt;
- GlobalTransparency: Pointer;
- GlobalTransparencySize: LongInt;
- destructor Destroy; override;
- procedure Clear;
- function GetLastFrame: TFrameInfo;
- function AddFrameInfo: TFrameInfo;
- end;
- { Network Graphics file parser and frame converter.}
- TNGFileLoader = class(TNGFileHandler)
- public
- function LoadFile(Handle: TImagingHandle): Boolean;
- procedure LoadImageFromPNGFrame(const IHDR: TIHDR; IDATStream: TMemoryStream; var Image: TImageData);
- {$IFDEF LINK_JNG}
- procedure LoadImageFromJNGFrame(const JHDR: TJHDR; IDATStream, JDATStream, JDAAStream: TMemoryStream; var Image: TImageData);
- {$ENDIF}
- procedure ApplyFrameSettings(Frame: TFrameInfo; var Image: TImageData);
- end;
- TNGFileSaver = class(TNGFileHandler)
- public
- PreFilter: LongInt;
- CompressLevel: LongInt;
- LossyAlpha: Boolean;
- Quality: LongInt;
- Progressive: Boolean;
- function SaveFile(Handle: TImagingHandle): Boolean;
- procedure AddFrame(const Image: TImageData; IsJNG: Boolean);
- procedure StoreImageToPNGFrame(const IHDR: TIHDR; Bits: Pointer; FmtInfo: TImageFormatInfo; IDATStream: TMemoryStream);
- {$IFDEF LINK_JNG}
- procedure StoreImageToJNGFrame(const JHDR: TJHDR; const Image: TImageData; IDATStream, JDATStream, JDAAStream: TMemoryStream);
- {$ENDIF}
- procedure SetFileOptions(FileFormat: TNetworkGraphicsFileFormat);
- end;
- {$IFDEF LINK_JNG}
- TCustomIOJpegFileFormat = class(TJpegFileFormat)
- protected
- FCustomIO: TIOFunctions;
- procedure SetJpegIO(const JpegIO: TIOFunctions); override;
- procedure SetCustomIO(const CustomIO: TIOFunctions);
- end;
- {$ENDIF}
- { Helper routines }
- function PaethPredictor(A, B, C: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
- var
- P, PA, PB, PC: LongInt;
- begin
- P := A + B - C;
- PA := Abs(P - A);
- PB := Abs(P - B);
- PC := Abs(P - C);
- if (PA <= PB) and (PA <= PC) then
- Result := A
- else
- if PB <= PC then
- Result := B
- else
- Result := C;
- end;
- procedure SwapRGB(Line: PByte; Width, SampleDepth, BytesPerPixel: LongInt);
- var
- I: LongInt;
- Tmp: Word;
- begin
- case SampleDepth of
- 8:
- for I := 0 to Width - 1 do
- with PColor24Rec(Line)^ do
- begin
- Tmp := R;
- R := B;
- B := Tmp;
- Inc(Line, BytesPerPixel);
- end;
- 16:
- for I := 0 to Width - 1 do
- with PColor48Rec(Line)^ do
- begin
- Tmp := R;
- R := B;
- B := Tmp;
- Inc(Line, BytesPerPixel);
- end;
- end;
- end;
- const
- { Helper constants for 1/2/4 bit to 8 bit conversions.}
- Mask1: array[0..7] of Byte = ($80, $40, $20, $10, $08, $04, $02, $01);
- Shift1: array[0..7] of Byte = (7, 6, 5, 4, 3, 2, 1, 0);
- Mask2: array[0..3] of Byte = ($C0, $30, $0C, $03);
- Shift2: array[0..3] of Byte = (6, 4, 2, 0);
- Mask4: array[0..1] of Byte = ($F0, $0F);
- Shift4: array[0..1] of Byte = (4, 0);
- function Get1BitPixel(Line: PByteArray; X: LongInt): Byte;
- begin
- Result := (Line[X shr 3] and Mask1[X and 7]) shr
- Shift1[X and 7];
- end;
- function Get2BitPixel(Line: PByteArray; X: LongInt): Byte;
- begin
- Result := (Line[X shr 2] and Mask2[X and 3]) shr
- Shift2[X and 3];
- end;
- function Get4BitPixel(Line: PByteArray; X: LongInt): Byte;
- begin
- Result := (Line[X shr 1] and Mask4[X and 1]) shr
- Shift4[X and 1];
- end;
- {$IFDEF LINK_JNG}
- { TCustomIOJpegFileFormat class implementation }
- procedure TCustomIOJpegFileFormat.SetCustomIO(const CustomIO: TIOFunctions);
- begin
- FCustomIO := CustomIO;
- end;
- procedure TCustomIOJpegFileFormat.SetJpegIO(const JpegIO: TIOFunctions);
- begin
- inherited SetJpegIO(FCustomIO);
- end;
- {$ENDIF}
- { TFrameInfo class implementation }
- constructor TFrameInfo.Create;
- begin
- IDATMemory := TMemoryStream.Create;
- JDATMemory := TMemoryStream.Create;
- JDAAMemory := TMemoryStream.Create;
- end;
- destructor TFrameInfo.Destroy;
- begin
- FreeMem(Palette);
- FreeMem(Transparency);
- FreeMem(Background);
- IDATMemory.Free;
- JDATMemory.Free;
- JDAAMemory.Free;
- inherited Destroy;
- end;
- { TNGFileHandler class implementation}
- destructor TNGFileHandler.Destroy;
- begin
- Clear;
- inherited Destroy;
- end;
- procedure TNGFileHandler.Clear;
- var
- I: LongInt;
- begin
- for I := 0 to Length(Frames) - 1 do
- Frames[I].Free;
- SetLength(Frames, 0);
- FreeMemNil(GlobalPalette);
- GlobalPaletteEntries := 0;
- FreeMemNil(GlobalTransparency);
- GlobalTransparencySize := 0;
- end;
- function TNGFileHandler.GetLastFrame: TFrameInfo;
- var
- Len: LongInt;
- begin
- Len := Length(Frames);
- if Len > 0 then
- Result := Frames[Len - 1]
- else
- Result := nil;
- end;
- function TNGFileHandler.AddFrameInfo: TFrameInfo;
- var
- Len: LongInt;
- begin
- Len := Length(Frames);
- SetLength(Frames, Len + 1);
- Result := TFrameInfo.Create;
- Frames[Len] := Result;
- end;
- { TNGFileLoader class implementation}
- function TNGFileLoader.LoadFile(Handle: TImagingHandle): Boolean;
- var
- Sig: TChar8;
- Chunk: TChunkHeader;
- ChunkData: Pointer;
- ChunkCrc: LongWord;
- procedure ReadChunk;
- begin
- GetIO.Read(Handle, @Chunk, SizeOf(Chunk));
- Chunk.DataSize := SwapEndianLongWord(Chunk.DataSize);
- end;
- procedure ReadChunkData;
- var
- ReadBytes: LongWord;
- begin
- FreeMemNil(ChunkData);
- GetMem(ChunkData, Chunk.DataSize);
- ReadBytes := GetIO.Read(Handle, ChunkData, Chunk.DataSize);
- GetIO.Read(Handle, @ChunkCrc, SizeOf(ChunkCrc));
- if ReadBytes <> Chunk.DataSize then
- RaiseImaging(SErrorLoadingChunk, [string(Chunk.ChunkID)]);
- end;
- procedure SkipChunkData;
- begin
- GetIO.Seek(Handle, Chunk.DataSize + SizeOf(ChunkCrc), smFromCurrent);
- end;
- procedure StartNewPNGImage;
- var
- Frame: TFrameInfo;
- begin
- ReadChunkData;
- Frame := AddFrameInfo;
- Frame.IsJNG := False;
- Frame.IHDR := PIHDR(ChunkData)^;
- end;
- procedure StartNewJNGImage;
- var
- Frame: TFrameInfo;
- begin
- ReadChunkData;
- Frame := AddFrameInfo;
- Frame.IsJNG := True;
- Frame.JHDR := PJHDR(ChunkData)^;
- end;
- procedure AppendIDAT;
- begin
- ReadChunkData;
- // Append current IDAT chunk to storage stream
- GetLastFrame.IDATMemory.Write(ChunkData^, Chunk.DataSize);
- end;
- procedure AppendJDAT;
- begin
- ReadChunkData;
- // Append current JDAT chunk to storage stream
- GetLastFrame.JDATMemory.Write(ChunkData^, Chunk.DataSize);
- end;
- procedure AppendJDAA;
- begin
- ReadChunkData;
- // Append current JDAA chunk to storage stream
- GetLastFrame.JDAAMemory.Write(ChunkData^, Chunk.DataSize);
- end;
- procedure LoadPLTE;
- begin
- ReadChunkData;
- if GetLastFrame = nil then
- begin
- // Load global palette
- GetMem(GlobalPalette, Chunk.DataSize);
- Move(ChunkData^, GlobalPalette^, Chunk.DataSize);
- GlobalPaletteEntries := Chunk.DataSize div 3;
- end
- else if GetLastFrame.Palette = nil then
- begin
- if (Chunk.DataSize = 0) and (GlobalPalette <> nil) then
- begin
- // Use global palette
- GetMem(GetLastFrame.Palette, GlobalPaletteEntries * SizeOf(TColor24Rec));
- Move(GlobalPalette^, GetLastFrame.Palette^, GlobalPaletteEntries * SizeOf(TColor24Rec));
- GetLastFrame.PaletteEntries := GlobalPaletteEntries;
- end
- else
- begin
- // Load pal from PLTE chunk
- GetMem(GetLastFrame.Palette, Chunk.DataSize);
- Move(ChunkData^, GetLastFrame.Palette^, Chunk.DataSize);
- GetLastFrame.PaletteEntries := Chunk.DataSize div 3;
- end;
- end;
- end;
- procedure LoadtRNS;
- begin
- ReadChunkData;
- if GetLastFrame = nil then
- begin
- // Load global transparency
- GetMem(GlobalTransparency, Chunk.DataSize);
- Move(ChunkData^, GlobalTransparency^, Chunk.DataSize);
- GlobalTransparencySize := Chunk.DataSize;
- end
- else if GetLastFrame.Transparency = nil then
- begin
- if (Chunk.DataSize = 0) and (GlobalTransparency <> nil) then
- begin
- // Use global transparency
- GetMem(GetLastFrame.Transparency, GlobalTransparencySize);
- Move(GlobalTransparency^, GetLastFrame.Transparency^, Chunk.DataSize);
- GetLastFrame.TransparencySize := GlobalTransparencySize;
- end
- else
- begin
- // Load pal from tRNS chunk
- GetMem(GetLastFrame.Transparency, Chunk.DataSize);
- Move(ChunkData^, GetLastFrame.Transparency^, Chunk.DataSize);
- GetLastFrame.TransparencySize := Chunk.DataSize;
- end;
- end;
- end;
- procedure LoadbKGD;
- begin
- ReadChunkData;
- if GetLastFrame.Background = nil then
- begin
- GetMem(GetLastFrame.Background, Chunk.DataSize);
- Move(ChunkData^, GetLastFrame.Background^, Chunk.DataSize);
- GetLastFrame.BackgroundSize := Chunk.DataSize;
- end;
- end;
- begin
- Result := False;
- Clear;
- ChunkData := nil;
- with GetIO do
- try
- Read(Handle, @Sig, SizeOf(Sig));
- // Set file type according to the signature
- if Sig = PNGSignature then FileType := ngPNG
- else if Sig = MNGSignature then FileType := ngMNG
- else if Sig = JNGSignature then FileType := ngJNG
- else Exit;
- if FileType = ngMNG then
- begin
- // Store MNG header if present
- ReadChunk;
- ReadChunkData;
- MHDR := PMHDR(ChunkData)^;
- SwapEndianLongWord(@MHDR, SizeOf(MHDR) div SizeOf(LongWord));
- end
- else
- FillChar(MHDR, SizeOf(MHDR), 0);
- // Read chunks until ending chunk or EOF is reached
- repeat
- ReadChunk;
- if Chunk.ChunkID = IHDRChunk then StartNewPNGImage
- else if Chunk.ChunkID = JHDRChunk then StartNewJNGImage
- else if Chunk.ChunkID = IDATChunk then AppendIDAT
- else if Chunk.ChunkID = JDATChunk then AppendJDAT
- else if Chunk.ChunkID = JDAAChunk then AppendJDAA
- else if Chunk.ChunkID = PLTEChunk then LoadPLTE
- else if Chunk.ChunkID = tRNSChunk then LoadtRNS
- else if Chunk.ChunkID = bKGDChunk then LoadbKGD
- else SkipChunkData;
- until Eof(Handle) or (Chunk.ChunkID = MENDChunk) or
- ((FileType <> ngMNG) and (Chunk.ChunkID = IENDChunk));
- Result := True;
- finally
- FreeMemNil(ChunkData);
- end;
- end;
- procedure TNGFileLoader.LoadImageFromPNGFrame(const IHDR: TIHDR;
- IDATStream: TMemoryStream; var Image: TImageData);
- type
- TGetPixelFunc = function(Line: PByteArray; X: LongInt): Byte;
- var
- LineBuffer: array[Boolean] of PByteArray;
- ActLine: Boolean;
- Data, TotalBuffer, ZeroLine, PrevLine: Pointer;
- BitCount, TotalSize, TotalPos, BytesPerPixel, I, Pass,
- SrcDataSize, BytesPerLine, InterlaceLineBytes, InterlaceWidth: LongInt;
- procedure DecodeAdam7;
- const
- BitTable: array[1..8] of LongInt = ($1, $3, 0, $F, 0, 0, 0, $FF);
- StartBit: array[1..8] of LongInt = (7, 6, 0, 4, 0, 0, 0, 0);
- var
- Src, Dst, Dst2: PByte;
- CurBit, Col: LongInt;
- begin
- Src := @LineBuffer[ActLine][1];
- Col := ColumnStart[Pass];
- with Image do
- case BitCount of
- 1, 2, 4:
- begin
- Dst := @PByteArray(Data)[I * BytesPerLine];
- repeat
- CurBit := StartBit[BitCount];
- repeat
- Dst2 := @PByteArray(Dst)[(BitCount * Col) shr 3];
- Dst2^ := Dst2^ or ((Src^ shr CurBit) and BitTable[BitCount])
- shl (StartBit[BitCount] - (Col * BitCount mod 8));
- Inc(Col, ColumnIncrement[Pass]);
- Dec(CurBit, BitCount);
- until CurBit < 0;
- Inc(Src);
- until Col >= Width;
- end;
- else
- begin
- Dst := @PByteArray(Data)[I * BytesPerLine + Col * BytesPerPixel];
- repeat
- CopyPixel(Src, Dst, BytesPerPixel);
- Inc(Dst, BytesPerPixel);
- Inc(Src, BytesPerPixel);
- Inc(Dst, ColumnIncrement[Pass] * BytesPerPixel - BytesPerPixel);
- Inc(Col, ColumnIncrement[Pass]);
- until Col >= Width;
- end;
- end;
- end;
- procedure FilterScanline(Filter: Byte; BytesPerPixel: LongInt; Line, PrevLine, Target: PByteArray;
- BytesPerLine: LongInt);
- var
- I: LongInt;
- begin
- case Filter of
- 0:
- begin
- // No filter
- Move(Line^, Target^, BytesPerLine);
- end;
- 1:
- begin
- // Sub filter
- Move(Line^, Target^, BytesPerPixel);
- for I := BytesPerPixel to BytesPerLine - 1 do
- Target[I] := (Line[I] + Target[I - BytesPerPixel]) and $FF;
- end;
- 2:
- begin
- // Up filter
- for I := 0 to BytesPerLine - 1 do
- Target[I] := (Line[I] + PrevLine[I]) and $FF;
- end;
- 3:
- begin
- // Average filter
- for I := 0 to BytesPerPixel - 1 do
- Target[I] := (Line[I] + PrevLine[I] shr 1) and $FF;
- for I := BytesPerPixel to BytesPerLine - 1 do
- Target[I] := (Line[I] + (Target[I - BytesPerPixel] + PrevLine[I]) shr 1) and $FF;
- end;
- 4:
- begin
- // Paeth filter
- for I := 0 to BytesPerPixel - 1 do
- Target[I] := (Line[I] + PaethPredictor(0, PrevLine[I], 0)) and $FF;
- for I := BytesPerPixel to BytesPerLine - 1 do
- Target[I] := (Line[I] + PaethPredictor(Target[I - BytesPerPixel], PrevLine[I], PrevLine[I - BytesPerPixel])) and $FF;
- end;
- end;
- end;
- procedure Convert124To8(DataIn: Pointer; DataOut: Pointer; Width, Height,
- WidthBytes: LongInt; Indexed: Boolean);
- var
- X, Y, Mul: LongInt;
- GetPixel: TGetPixelFunc;
- begin
- GetPixel := Get1BitPixel;
- Mul := 255;
- case IHDR.BitDepth of
- 2:
- begin
- Mul := 85;
- GetPixel := Get2BitPixel;
- end;
- 4:
- begin
- Mul := 17;
- GetPixel := Get4BitPixel;
- end;
- end;
- if Indexed then Mul := 1;
- for Y := 0 to Height - 1 do
- for X := 0 to Width - 1 do
- PByteArray(DataOut)[Y * Width + X] :=
- GetPixel(@PByteArray(DataIn)[Y * WidthBytes], X) * Mul;
- end;
- procedure TransformLOCOToRGB(Data: PByte; NumPixels, BytesPerPixel: LongInt);
- var
- I: LongInt;
- begin
- for I := 0 to NumPixels - 1 do
- begin
- if IHDR.BitDepth = 8 then
- begin
- PColor32Rec(Data).R := Byte(PColor32Rec(Data).R + PColor32Rec(Data).G);
- PColor32Rec(Data).B := Byte(PColor32Rec(Data).B + PColor32Rec(Data).G);
- end
- else
- begin
- PColor64Rec(Data).R := Word(PColor64Rec(Data).R + PColor64Rec(Data).G);
- PColor64Rec(Data).B := Word(PColor64Rec(Data).B + PColor64Rec(Data).G);
- end;
- Inc(Data, BytesPerPixel);
- end;
- end;
- begin
- Image.Width := SwapEndianLongWord(IHDR.Width);
- Image.Height := SwapEndianLongWord(IHDR.Height);
- Image.Format := ifUnknown;
- case IHDR.ColorType of
- 0:
- begin
- // Gray scale image
- case IHDR.BitDepth of
- 1, 2, 4, 8: Image.Format := ifGray8;
- 16: Image.Format := ifGray16;
- end;
- BitCount := IHDR.BitDepth;
- end;
- 2:
- begin
- // RGB image
- case IHDR.BitDepth of
- 8: Image.Format := ifR8G8B8;
- 16: Image.Format := ifR16G16B16;
- end;
- BitCount := IHDR.BitDepth * 3;
- end;
- 3:
- begin
- // Indexed image
- case IHDR.BitDepth of
- 1, 2, 4, 8: Image.Format := ifIndex8;
- end;
- BitCount := IHDR.BitDepth;
- end;
- 4:
- begin
- // Grayscale + alpha image
- case IHDR.BitDepth of
- 8: Image.Format := ifA8Gray8;
- 16: Image.Format := ifA16Gray16;
- end;
- BitCount := IHDR.BitDepth * 2;
- end;
- 6:
- begin
- // ARGB image
- case IHDR.BitDepth of
- 8: Image.Format := ifA8R8G8B8;
- 16: Image.Format := ifA16R16G16B16;
- end;
- BitCount := IHDR.BitDepth * 4;
- end;
- end;
- // Start decoding
- LineBuffer[True] := nil;
- LineBuffer[False] := nil;
- TotalBuffer := nil;
- ZeroLine := nil;
- BytesPerPixel := (BitCount + 7) div 8;
- ActLine := True;
- with Image do
- try
- BytesPerLine := (Width * BitCount + 7) div 8;
- SrcDataSize := Height * BytesPerLine;
- GetMem(Data, SrcDataSize);
- FillChar(Data^, SrcDataSize, 0);
- GetMem(ZeroLine, BytesPerLine);
- FillChar(ZeroLine^, BytesPerLine, 0);
- if IHDR.Interlacing = 1 then
- begin
- // Decode interlaced images
- TotalPos := 0;
- DecompressBuf(IDATStream.Memory, IDATStream.Size, 0,
- Pointer(TotalBuffer), TotalSize);
- GetMem(LineBuffer[True], BytesPerLine + 1);
- GetMem(LineBuffer[False], BytesPerLine + 1);
- for Pass := 0 to 6 do
- begin
- // Prepare next interlace run
- if Width <= ColumnStart[Pass] then
- Continue;
- InterlaceWidth := (Width + ColumnIncrement[Pass] - 1 -
- ColumnStart[Pass]) div ColumnIncrement[Pass];
- InterlaceLineBytes := (InterlaceWidth * BitCount + 7) shr 3;
- I := RowStart[Pass];
- FillChar(LineBuffer[True][0], BytesPerLine + 1, 0);
- FillChar(LineBuffer[False][0], BytesPerLine + 1, 0);
- while I < Height do
- begin
- // Copy line from decompressed data to working buffer
- Move(PByteArray(TotalBuffer)[TotalPos],
- LineBuffer[ActLine][0], InterlaceLineBytes + 1);
- Inc(TotalPos, InterlaceLineBytes + 1);
- // Swap red and blue channels if necessary
- if (IHDR.ColorType in [2, 6]) then
- SwapRGB(@LineBuffer[ActLine][1], InterlaceWidth, IHDR.BitDepth, BytesPerPixel);
- // Reverse-filter current scanline
- FilterScanline(LineBuffer[ActLine][0], BytesPerPixel,
- @LineBuffer[ActLine][1], @LineBuffer[not ActLine][1],
- @LineBuffer[ActLine][1], InterlaceLineBytes);
- // Decode Adam7 interlacing
- DecodeAdam7;
- ActLine := not ActLine;
- // Continue with next row in interlaced order
- Inc(I, RowIncrement[Pass]);
- end;
- end;
- end
- else
- begin
- // Decode non-interlaced images
- PrevLine := ZeroLine;
- DecompressBuf(IDATStream.Memory, IDATStream.Size, SrcDataSize + Height,
- Pointer(TotalBuffer), TotalSize);
- for I := 0 to Height - 1 do
- begin
- // Swap red and blue channels if necessary
- if IHDR.ColorType in [2, 6] then
- SwapRGB(@PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1], Width,
- IHDR.BitDepth, BytesPerPixel);
- // reverse-filter current scanline
- FilterScanline(PByteArray(TotalBuffer)[I * (BytesPerLine + 1)],
- BytesPerPixel, @PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1],
- PrevLine, @PByteArray(Data)[I * BytesPerLine], BytesPerLine);
- PrevLine := @PByteArray(Data)[I * BytesPerLine];
- end;
- end;
- Size := Width * Height * BytesPerPixel;
- if Size <> SrcDataSize then
- begin
- // If source data size is different from size of image in assigned
- // format we must convert it (it is in 1/2/4 bit count)
- GetMem(Bits, Size);
- case IHDR.ColorType of
- 0: Convert124To8(Data, Bits, Width, Height, BytesPerLine, False);
- 3: Convert124To8(Data, Bits, Width, Height, BytesPerLine, True);
- end;
- FreeMem(Data);
- end
- else
- begin
- // If source data size is the same as size of
- // image Bits in assigned format we simply copy pointer reference
- Bits := Data;
- end;
- // LOCO transformation was used too (only for color types 2 and 6)
- if (IHDR.Filter = 64) and (IHDR.ColorType in [2, 6]) then
- TransformLOCOToRGB(Bits, Width * Height, BytesPerPixel);
- // Images with 16 bit channels must be swapped because of PNG's big endianity
- if IHDR.BitDepth = 16 then
- SwapEndianWord(Bits, Width * Height * BytesPerPixel div SizeOf(Word));
- finally
- FreeMem(LineBuffer[True]);
- FreeMem(LineBuffer[False]);
- FreeMem(TotalBuffer);
- FreeMem(ZeroLine);
- end;
- end;
- {$IFDEF LINK_JNG}
- procedure TNGFileLoader.LoadImageFromJNGFrame(const JHDR: TJHDR; IDATStream,
- JDATStream, JDAAStream: TMemoryStream; var Image: TImageData);
- var
- AlphaImage: TImageData;
- FakeIHDR: TIHDR;
- FmtInfo: TImageFormatInfo;
- I: LongInt;
- AlphaPtr: PByte;
- GrayPtr: PWordRec;
- ColorPtr: PColor32Rec;
- procedure LoadJpegFromStream(Stream: TStream; var DestImage: TImageData);
- var
- JpegFormat: TCustomIOJpegFileFormat;
- Handle: TImagingHandle;
- DynImages: TDynImageDataArray;
- begin
- if JHDR.SampleDepth <> 12 then
- begin
- JpegFormat := TCustomIOJpegFileFormat.Create;
- JpegFormat.SetCustomIO(StreamIO);
- Stream.Position := 0;
- Handle := StreamIO.OpenRead(Pointer(Stream));
- try
- JpegFormat.LoadData(Handle, DynImages, True);
- DestImage := DynImages[0];
- finally
- StreamIO.Close(Handle);
- JpegFormat.Free;
- SetLength(DynImages, 0);
- end;
- end
- else
- NewImage(JHDR.Width, JHDR.Height, ifR8G8B8, DestImage);
- end;
- begin
- LoadJpegFromStream(JDATStream, Image);
- // If present separate alpha channel is processed
- if (JHDR.ColorType in [12, 14]) and (Image.Format in [ifGray8, ifR8G8B8]) then
- begin
- InitImage(AlphaImage);
- if JHDR.AlphaCompression = 0 then
- begin
- // Alpha channel is PNG compressed
- FakeIHDR.Width := JHDR.Width;
- FakeIHDR.Height := JHDR.Height;
- FakeIHDR.ColorType := 0;
- FakeIHDR.BitDepth := JHDR.AlphaSampleDepth;
- FakeIHDR.Filter := JHDR.AlphaFilter;
- FakeIHDR.Interlacing := JHDR.AlphaInterlacing;
- LoadImageFromPNGFrame(FakeIHDR, IDATStream, AlphaImage);
- end
- else
- begin
- // Alpha channel is JPEG compressed
- LoadJpegFromStream(JDAAStream, AlphaImage);
- end;
- // Check if alpha channel is the same size as image
- if (Image.Width <> AlphaImage.Width) and (Image.Height <> AlphaImage.Height) then
- ResizeImage(AlphaImage, Image.Width, Image.Height, rfNearest);
- // Check alpha channels data format
- GetImageFormatInfo(AlphaImage.Format, FmtInfo);
- if (FmtInfo.BytesPerPixel > 1) or (not FmtInfo.HasGrayChannel) then
- ConvertImage(AlphaImage, ifGray8);
- // Convert image to fromat with alpha channel
- if Image.Format = ifGray8 then
- ConvertImage(Image, ifA8Gray8)
- else
- ConvertImage(Image, ifA8R8G8B8);
- // Combine alpha channel with image
- AlphaPtr := AlphaImage.Bits;
- if Image.Format = ifA8Gray8 then
- begin
- GrayPtr := Image.Bits;
- for I := 0 to Image.Width * Image.Height - 1 do
- begin
- GrayPtr.High := AlphaPtr^;
- Inc(GrayPtr);
- Inc(AlphaPtr);
- end;
- end
- else
- begin
- ColorPtr := Image.Bits;
- for I := 0 to Image.Width * Image.Height - 1 do
- begin
- ColorPtr.A := AlphaPtr^;
- Inc(ColorPtr);
- Inc(AlphaPtr);
- end;
- end;
- FreeImage(AlphaImage);
- end;
- end;
- {$ENDIF}
- procedure TNGFileLoader.ApplyFrameSettings(Frame: TFrameInfo; var Image: TImageData);
- var
- FmtInfo: TImageFormatInfo;
- BackGroundColor: TColor64Rec;
- ColorKey: TColor64Rec;
- Alphas: PByteArray;
- AlphasSize: LongInt;
- IsColorKeyPresent: Boolean;
- IsBackGroundPresent: Boolean;
- IsColorFormat: Boolean;
- procedure ConverttRNS;
- begin
- if FmtInfo.IsIndexed then
- begin
- if Alphas = nil then
- begin
- GetMem(Alphas, Frame.TransparencySize);
- Move(Frame.Transparency^, Alphas^, Frame.TransparencySize);
- AlphasSize := Frame.TransparencySize;
- end;
- end
- else
- if not FmtInfo.HasAlphaChannel then
- begin
- FillChar(ColorKey, SizeOf(ColorKey), 0);
- Move(Frame.Transparency^, ColorKey, Min(Frame.TransparencySize, SizeOf(ColorKey)));
- if IsColorFormat then
- SwapValues(ColorKey.R, ColorKey.B);
- SwapEndianWord(@ColorKey, 3);
- // 1/2/4 bit images were converted to 8 bit so we must convert color key too
- if (not Frame.IsJNG) and (Frame.IHDR.ColorType in [0, 4]) then
- case Frame.IHDR.BitDepth of
- 1: ColorKey.B := Word(ColorKey.B * 255);
- 2: ColorKey.B := Word(ColorKey.B * 85);
- 4: ColorKey.B := Word(ColorKey.B * 17);
- end;
- IsColorKeyPresent := True;
- end;
- end;
- procedure ConvertbKGD;
- begin
- FillChar(BackGroundColor, SizeOf(BackGroundColor), 0);
- Move(Frame.Background^, BackGroundColor, Min(Frame.BackgroundSize,
- SizeOf(BackGroundColor)));
- if IsColorFormat then
- SwapValues(BackGroundColor.R, BackGroundColor.B);
- SwapEndianWord(@BackGroundColor, 3);
- // 1/2/4 bit images were converted to 8 bit so we must convert back color too
- if (not Frame.IsJNG) and (Frame.IHDR.ColorType in [0, 4]) then
- case Frame.IHDR.BitDepth of
- 1: BackGroundColor.B := Word(BackGroundColor.B * 255);
- 2: BackGroundColor.B := Word(BackGroundColor.B * 85);
- 4: BackGroundColor.B := Word(BackGroundColor.B * 17);
- end;
- IsBackGroundPresent := True;
- end;
- procedure ReconstructPalette;
- var
- I: LongInt;
- begin
- with Image do
- begin
- GetMem(Palette, FmtInfo.PaletteEntries * SizeOf(TColor32Rec));
- FillChar(Palette^, FmtInfo.PaletteEntries * SizeOf(TColor32Rec), $FF);
- // if RGB palette was loaded from file then use it
- if Frame.Palette <> nil then
- for I := 0 to Min(Frame.PaletteEntries, FmtInfo.PaletteEntries) - 1 do
- with Palette[I] do
- begin
- R := Frame.Palette[I].B;
- G := Frame.Palette[I].G;
- B := Frame.Palette[I].R;
- end;
- // if palette alphas were loaded from file then use them
- if Alphas <> nil then
- for I := 0 to Min(AlphasSize, FmtInfo.PaletteEntries) - 1 do
- Palette[I].A := Alphas[I];
- end;
- end;
- procedure ApplyColorKey;
- var
- DestFmt: TImageFormat;
- OldPixel, NewPixel: Pointer;
- begin
- case Image.Format of
- ifGray8: DestFmt := ifA8Gray8;
- ifGray16: DestFmt := ifA16Gray16;
- ifR8G8B8: DestFmt := ifA8R8G8B8;
- ifR16G16B16: DestFmt := ifA16R16G16B16;
- else
- DestFmt := ifUnknown;
- end;
- if DestFmt <> ifUnknown then
- begin
- if not IsBackGroundPresent then
- BackGroundColor := ColorKey;
- ConvertImage(Image, DestFmt);
- OldPixel := @ColorKey;
- NewPixel := @BackGroundColor;
- // Now back color and color key must be converted to image's data format, looks ugly
- case Image.Format of
- ifA8Gray8:
- begin
- TColor32Rec(TInt64Rec(ColorKey).Low).B := Byte(ColorKey.B);
- TColor32Rec(TInt64Rec(ColorKey).Low).G := $FF;
- TColor32Rec(TInt64Rec(BackGroundColor).Low).B := Byte(BackGroundColor.B);
- end;
- ifA16Gray16:
- begin
- ColorKey.G := $FFFF;
- end;
- ifA8R8G8B8:
- begin
- TColor32Rec(TInt64Rec(ColorKey).Low).R := Byte(ColorKey.R);
- TColor32Rec(TInt64Rec(ColorKey).Low).G := Byte(ColorKey.G);
- TColor32Rec(TInt64Rec(ColorKey).Low).B := Byte(ColorKey.B);
- TColor32Rec(TInt64Rec(ColorKey).Low).A := $FF;
- TColor32Rec(TInt64Rec(BackGroundColor).Low).R := Byte(BackGroundColor.R);
- TColor32Rec(TInt64Rec(BackGroundColor).Low).G := Byte(BackGroundColor.G);
- TColor32Rec(TInt64Rec(BackGroundColor).Low).B := Byte(BackGroundColor.B);
- end;
- ifA16R16G16B16:
- begin
- ColorKey.A := $FFFF;
- end;
- end;
- ReplaceColor(Image, 0, 0, Image.Width, Image.Height, OldPixel, NewPixel);
- end;
- end;
- begin
- Alphas := nil;
- IsColorKeyPresent := False;
- IsBackGroundPresent := False;
- GetImageFormatInfo(Image.Format, FmtInfo);
- IsColorFormat := (Frame.IsJNG and (Frame.JHDR.ColorType in [10, 14])) or
- (not Frame.IsJNG and (Frame.IHDR.ColorType in [2, 6]));
- // Convert some chunk data to useful format
- if Frame.Transparency <> nil then
- ConverttRNS;
- if Frame.Background <> nil then
- ConvertbKGD;
- // Build palette for indexed images
- if FmtInfo.IsIndexed then
- ReconstructPalette;
- // Apply color keying
- if IsColorKeyPresent and not FmtInfo.HasAlphaChannel then
- ApplyColorKey;
- FreeMemNil(Alphas);
- end;
- { TNGFileSaver class implementation }
- procedure TNGFileSaver.StoreImageToPNGFrame(const IHDR: TIHDR; Bits: Pointer;
- FmtInfo: TImageFormatInfo; IDATStream: TMemoryStream);
- var
- TotalBuffer, CompBuffer, ZeroLine, PrevLine: Pointer;
- FilterLines: array[0..4] of PByteArray;
- TotalSize, CompSize, I, BytesPerLine, BytesPerPixel: LongInt;
- Filter: Byte;
- Adaptive: Boolean;
- procedure FilterScanline(Filter: Byte; BytesPerPixel: LongInt; Line, PrevLine, Target: PByteArray);
- var
- I: LongInt;
- begin
- case Filter of
- 0:
- begin
- // No filter
- Move(Line^, Target^, BytesPerLine);
- end;
- 1:
- begin
- // Sub filter
- Move(Line^, Target^, BytesPerPixel);
- for I := BytesPerPixel to BytesPerLine - 1 do
- Target[I] := (Line[I] - Line[I - BytesPerPixel]) and $FF;
- end;
- 2:
- begin
- // Up filter
- for I := 0 to BytesPerLine - 1 do
- Target[I] := (Line[I] - PrevLine[I]) and $FF;
- end;
- 3:
- begin
- // Average filter
- for I := 0 to BytesPerPixel - 1 do
- Target[I] := (Line[I] - PrevLine[I] shr 1) and $FF;
- for I := BytesPerPixel to BytesPerLine - 1 do
- Target[I] := (Line[I] - (Line[I - BytesPerPixel] + PrevLine[I]) shr 1) and $FF;
- end;
- 4:
- begin
- // Paeth filter
- for I := 0 to BytesPerPixel - 1 do
- Target[I] := (Line[I] - PaethPredictor(0, PrevLine[I], 0)) and $FF;
- for I := BytesPerPixel to BytesPerLine - 1 do
- Target[I] := (Line[I] - PaethPredictor(Line[I - BytesPerPixel], PrevLine[I], PrevLine[I - BytesPerPixel])) and $FF;
- end;
- end;
- end;
- procedure AdaptiveFilter(var Filter: Byte; BytesPerPixel: LongInt; Line, PrevLine, Target: PByteArray);
- var
- I, J, BestTest: LongInt;
- Sums: array[0..4] of LongInt;
- begin
- // Compute the output scanline using all five filters,
- // and select the filter that gives the smallest sum of
- // absolute values of outputs
- FillChar(Sums, SizeOf(Sums), 0);
- BestTest := MaxInt;
- for I := 0 to 4 do
- begin
- FilterScanline(I, BytesPerPixel, Line, PrevLine, FilterLines[I]);
- for J := 0 to BytesPerLine - 1 do
- Sums[I] := Sums[I] + Abs(ShortInt(FilterLines[I][J]));
- if Sums[I] < BestTest then
- begin
- Filter := I;
- BestTest := Sums[I];
- end;
- end;
- Move(FilterLines[Filter]^, Target^, BytesPerLine);
- end;
-
- begin
- // Select precompression filter and compression level
- Adaptive := False;
- Filter := 0;
- case PreFilter of
- 6:
- if not ((IHDR.BitDepth < 8) or (IHDR.ColorType = 3))
- then Adaptive := True;
- 0..4: Filter := PreFilter;
- else
- if IHDR.ColorType in [2, 6] then
- Filter := 4
- end;
- // Prepare data for compression
- CompBuffer := nil;
- FillChar(FilterLines, SizeOf(FilterLines), 0);
- BytesPerPixel := FmtInfo.BytesPerPixel;
- BytesPerLine := LongInt(IHDR.Width) * BytesPerPixel;
- TotalSize := (BytesPerLine + 1) * LongInt(IHDR.Height);
- GetMem(TotalBuffer, TotalSize);
- GetMem(ZeroLine, BytesPerLine);
- FillChar(ZeroLine^, BytesPerLine, 0);
- if Adaptive then
- for I := 0 to 4 do
- GetMem(FilterLines[I], BytesPerLine);
- PrevLine := ZeroLine;
- try
- // Process next scanlines
- for I := 0 to IHDR.Height - 1 do
- begin
- // Filter scanline
- if Adaptive then
- AdaptiveFilter(Filter, BytesPerPixel, @PByteArray(Bits)[I * BytesPerLine],
- PrevLine, @PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1])
- else
- FilterScanline(Filter, BytesPerPixel, @PByteArray(Bits)[I * BytesPerLine],
- PrevLine, @PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1]);
- PrevLine := @PByteArray(Bits)[I * BytesPerLine];
- // Swap red and blue if necessary
- if (IHDR.ColorType in [2, 6]) and not FmtInfo.IsRBSwapped then
- SwapRGB(@PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1],
- IHDR.Width, IHDR.BitDepth, FmtInfo.BytesPerPixel);
- // Images with 16 bit channels must be swapped because of PNG's big endianess
- if IHDR.BitDepth = 16 then
- SwapEndianWord(@PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1],
- BytesPerLine div SizeOf(Word));
- // Set filter used for this scanline
- PByteArray(TotalBuffer)[I * (BytesPerLine + 1)] := Filter;
- end;
- // Compress IDAT data
- CompressBuf(TotalBuffer, TotalSize, CompBuffer, CompSize, CompressLevel);
- // Write IDAT data to stream
- IDATStream.WriteBuffer(CompBuffer^, CompSize);
- finally
- FreeMem(TotalBuffer);
- FreeMem(CompBuffer);
- FreeMem(ZeroLine);
- if Adaptive then
- for I := 0 to 4 do
- FreeMem(FilterLines[I]);
- end;
- end;
- {$IFDEF LINK_JNG}
- procedure TNGFileSaver.StoreImageToJNGFrame(const JHDR: TJHDR;
- const Image: TImageData; IDATStream, JDATStream,
- JDAAStream: TMemoryStream);
- var
- ColorImage, AlphaImage: TImageData;
- FmtInfo: TImageFormatInfo;
- AlphaPtr: PByte;
- GrayPtr: PWordRec;
- ColorPtr: PColor32Rec;
- I: LongInt;
- FakeIHDR: TIHDR;
- procedure SaveJpegToStream(Stream: TStream; const Image: TImageData);
- var
- JpegFormat: TCustomIOJpegFileFormat;
- Handle: TImagingHandle;
- DynImages: TDynImageDataArray;
- begin
- JpegFormat := TCustomIOJpegFileFormat.Create;
- JpegFormat.SetCustomIO(StreamIO);
- // Only JDAT stream can be saved progressive
- if Stream = JDATStream then
- JpegFormat.FProgressive := Progressive
- else
- JpegFormat.FProgressive := False;
- JpegFormat.FQuality := Quality;
- SetLength(DynImages, 1);
- DynImages[0] := Image;
- Handle := StreamIO.OpenWrite(Pointer(Stream));
- try
- JpegFormat.SaveData(Handle, DynImages, 0);
- finally
- StreamIO.Close(Handle);
- SetLength(DynImages, 0);
- JpegFormat.Free;
- end;
- end;
- begin
- GetImageFormatInfo(Image.Format, FmtInfo);
- InitImage(ColorImage);
- InitImage(AlphaImage);
- if FmtInfo.HasAlphaChannel then
- begin
- // Create new image for alpha channel and color image without alpha
- CloneImage(Image, ColorImage);
- NewImage(Image.Width, Image.Height, ifGray8, AlphaImage);
- case Image.Format of
- ifA8Gray8: ConvertImage(ColorImage, ifGray8);
- ifA8R8G8B8: ConvertImage(ColorImage, ifR8G8B8);
- end;
- // Store source image's alpha to separate image
- AlphaPtr := AlphaImage.Bits;
- if Image.Format = ifA8Gray8 then
- begin
- GrayPtr := Image.Bits;
- for I := 0 to Image.Width * Image.Height - 1 do
- begin
- AlphaPtr^ := GrayPtr.High;
- Inc(GrayPtr);
- Inc(AlphaPtr);
- end;
- end
- else
- begin
- ColorPtr := Image.Bits;
- for I := 0 to Image.Width * Image.Height - 1 do
- begin
- AlphaPtr^ := ColorPtr.A;
- Inc(ColorPtr);
- Inc(AlphaPtr);
- end;
- end;
- // Write color image to stream as JPEG
- SaveJpegToStream(JDATStream, ColorImage);
- if LossyAlpha then
- begin
- // Write alpha image to stream as JPEG
- SaveJpegToStream(JDAAStream, AlphaImage);
- end
- else
- begin
- // Alpha channel is PNG compressed
- FakeIHDR.Width := JHDR.Width;
- FakeIHDR.Height := JHDR.Height;
- FakeIHDR.ColorType := 0;
- FakeIHDR.BitDepth := JHDR.AlphaSampleDepth;
- FakeIHDR.Filter := JHDR.AlphaFilter;
- FakeIHDR.Interlacing := JHDR.AlphaInterlacing;
- GetImageFormatInfo(AlphaImage.Format, FmtInfo);
- StoreImageToPNGFrame(FakeIHDR, AlphaImage.Bits, FmtInfo, IDATStream);
- end;
- FreeImage(ColorImage);
- FreeImage(AlphaImage);
- end
- else
- begin
- // Simply write JPEG to stream
- SaveJpegToStream(JDATStream, Image);
- end;
- end;
- {$ENDIF}
- procedure TNGFileSaver.AddFrame(const Image: TImageData; IsJNG: Boolean);
- var
- Frame: TFrameInfo;
- FmtInfo: TImageFormatInfo;
- procedure StorePalette;
- var
- Pal: PPalette24;
- Alphas: PByteArray;
- I, PalBytes: LongInt;
- AlphasDiffer: Boolean;
- begin
- // Fill and save RGB part of palette to PLTE chunk
- PalBytes := FmtInfo.PaletteEntries * SizeOf(TColor24Rec);
- GetMem(Pal, PalBytes);
- AlphasDiffer := False;
- for I := 0 to FmtInfo.PaletteEntries - 1 do
- begin
- Pal[I].B := Image.Palette[I].R;
- Pal[I].G := Image.Palette[I].G;
- Pal[I].R := Image.Palette[I].B;
- if Image.Palette[I].A < 255 then
- AlphasDiffer := True;
- end;
- Frame.Palette := Pal;
- Frame.PaletteEntries := FmtInfo.PaletteEntries;
- // Fill and save alpha part (if there are any alphas < 255) of palette to tRNS chunk
- if AlphasDiffer then
- begin
- PalBytes := FmtInfo.PaletteEntries * SizeOf(Byte);
- GetMem(Alphas, PalBytes);
- for I := 0 to FmtInfo.PaletteEntries - 1 do
- Alphas[I] := Image.Palette[I].A;
- Frame.Transparency := Alphas;
- Frame.TransparencySize := PalBytes;
- end;
- end;
- begin
- // Add new frame
- Frame := AddFrameInfo;
- Frame.IsJNG := IsJNG;
- with Frame do
- begin
- GetImageFormatInfo(Image.Format, FmtInfo);
- if IsJNG then
- begin
- {$IFDEF LINK_JNG}
- // Fill JNG header
- JHDR.Width := Image.Width;
- JHDR.Height := Image.Height;
- case Image.Format of
- ifGray8: JHDR.ColorType := 8;
- ifR8G8B8: JHDR.ColorType := 10;
- ifA8Gray8: JHDR.ColorType := 12;
- ifA8R8G8B8: JHDR.ColorType := 14;
- end;
- JHDR.SampleDepth := 8; // 8-bit samples and quantization tables
- JHDR.Compression := 8; // Huffman coding
- JHDR.Interlacing := Iff(Progressive, 8, 0);
- JHDR.AlphaSampleDepth := Iff(FmtInfo.HasAlphaChannel, 8, 0);
- JHDR.AlphaCompression := Iff(LossyAlpha, 8, 0);
- JHDR.AlphaFilter := 0;
- JHDR.AlphaInterlacing := 0;
- StoreImageToJNGFrame(JHDR, Image, IDATMemory, JDATMemory, JDAAMemory);
- // Finally swap endian
- SwapEndianLongWord(@JHDR, 2);
- {$ENDIF}
- end
- else
- begin
- // Fill PNG header
- IHDR.Width := Image.Width;
- IHDR.Height := Image.Height;
- IHDR.Compression := 0;
- IHDR.Filter := 0;
- IHDR.Interlacing := 0;
- IHDR.BitDepth := FmtInfo.BytesPerPixel * 8;
- // Select appropiate PNG color type and modify bitdepth
- if FmtInfo.HasGrayChannel then
- begin
- IHDR.ColorType := 0;
- if FmtInfo.HasAlphaChannel then
- begin
- IHDR.ColorType := 4;
- IHDR.BitDepth := IHDR.BitDepth div 2;
- end;
- end
- else
- if FmtInfo.IsIndexed then
- IHDR.ColorType := 3
- else
- if FmtInfo.HasAlphaChannel then
- begin
- IHDR.ColorType := 6;
- IHDR.BitDepth := IHDR.BitDepth div 4;
- end
- else
- begin
- IHDR.ColorType := 2;
- IHDR.BitDepth := IHDR.BitDepth div 3;
- end;
- // Compress PNG image and store it to stream
- StoreImageToPNGFrame(IHDR, Image.Bits, FmtInfo, IDATMemory);
- // Store palette if necesary
- if FmtInfo.IsIndexed then
- StorePalette;
- // Finally swap endian
- SwapEndianLongWord(@IHDR, 2);
- end;
- end;
- end;
- function TNGFileSaver.SaveFile(Handle: TImagingHandle): Boolean;
- var
- I: LongInt;
- Chunk: TChunkHeader;
- function CalcChunkCrc(const ChunkHdr: TChunkHeader; Data: Pointer;
- Size: LongInt): LongWord;
- begin
- Result := $FFFFFFFF;
- CalcCrc32(Result, @ChunkHdr.ChunkID, SizeOf(ChunkHdr.ChunkID));
- CalcCrc32(Result, Data, Size);
- Result := SwapEndianLongWord(Result xor $FFFFFFFF);
- end;
- procedure WriteChunk(var Chunk: TChunkHeader; ChunkData: Pointer);
- var
- ChunkCrc: LongWord;
- SizeToWrite: LongInt;
- begin
- SizeToWrite := Chunk.DataSize;
- Chunk.DataSize := SwapEndianLongWord(Chunk.DataSize);
- ChunkCrc := CalcChunkCrc(Chunk, ChunkData, SizeToWrite);
- GetIO.Write(Handle, @Chunk, SizeOf(Chunk));
- if SizeToWrite <> 0 then
- GetIO.Write(Handle, ChunkData, SizeToWrite);
- GetIO.Write(Handle, @ChunkCrc, SizeOf(ChunkCrc));
- end;
- begin
- Result := False;
- begin
- case FileType of
- ngPNG: GetIO.Write(Handle, @PNGSignature, SizeOf(TChar8));
- ngMNG: GetIO.Write(Handle, @MNGSignature, SizeOf(TChar8));
- ngJNG: GetIO.Write(Handle, @JNGSignature, SizeOf(TChar8));
- end;
- if FileType = ngMNG then
- begin
- SwapEndianLongWord(@MHDR, SizeOf(MHDR) div SizeOf(LongWord));
- Chunk.DataSize := SizeOf(MHDR);
- Chunk.ChunkID := MHDRChunk;
- WriteChunk(Chunk, @MHDR);
- end;
- for I := 0 to Length(Frames) - 1 do
- with Frames[I] do
- begin
- if IsJNG then
- begin
- // Write JHDR chunk
- Chunk.DataSize := SizeOf(JHDR);
- Chunk.ChunkID := JHDRChunk;
- WriteChunk(Chunk, @JHDR);
- // Write JNG image data
- Chunk.DataSize := JDATMemory.Size;
- Chunk.ChunkID := JDATChunk;
- WriteChunk(Chunk, JDATMemory.Memory);
- // Write alpha channel if present
- if JHDR.AlphaSampleDepth > 0 then
- begin
- if JHDR.AlphaCompression = 0 then
- begin
- // ALpha is PNG compressed
- Chunk.DataSize := IDATMemory.Size;
- Chunk.ChunkID := IDATChunk;
- WriteChunk(Chunk, IDATMemory.Memory);
- end
- else
- begin
- // Alpha is JNG compressed
- Chunk.DataSize := JDAAMemory.Size;
- Chunk.ChunkID := JDAAChunk;
- WriteChunk(Chunk, JDAAMemory.Memory);
- end;
- end;
- // Write image end
- Chunk.DataSize := 0;
- Chunk.ChunkID := IENDChunk;
- WriteChunk(Chunk, nil);
- end
- else
- begin
- // Write IHDR chunk
- Chunk.DataSize := SizeOf(IHDR);
- Chunk.ChunkID := IHDRChunk;
- WriteChunk(Chunk, @IHDR);
- // Write PLTE chunk if data is present
- if Palette <> nil then
- begin
- Chunk.DataSize := PaletteEntries * SizeOf(TColor24Rec);
- Chunk.ChunkID := PLTEChunk;
- WriteChunk(Chunk, Palette);
- end;
- // Write tRNS chunk if data is present
- if Transparency <> nil then
- begin
- Chunk.DataSize := TransparencySize;
- Chunk.ChunkID := tRNSChunk;
- WriteChunk(Chunk, Transparency);
- end;
- // Write PNG image data
- Chunk.DataSize := IDATMemory.Size;
- Chunk.ChunkID := IDATChunk;
- WriteChunk(Chunk, IDATMemory.Memory);
- // Write image end
- Chunk.DataSize := 0;
- Chunk.ChunkID := IENDChunk;
- WriteChunk(Chunk, nil);
- end;
- end;
- if FileType = ngMNG then
- begin
- Chunk.DataSize := 0;
- Chunk.ChunkID := MENDChunk;
- WriteChunk(Chunk, nil);
- end;
- end;
- end;
- procedure TNGFileSaver.SetFileOptions(FileFormat: TNetworkGraphicsFileFormat);
- begin
- PreFilter := FileFormat.FPreFilter;
- CompressLevel := FileFormat.FCompressLevel;
- LossyAlpha := FileFormat.FLossyAlpha;
- Quality := FileFormat.FQuality;
- Progressive := FileFormat.FProgressive;
- end;
- { TNetworkGraphicsFileFormat class implementation }
- constructor TNetworkGraphicsFileFormat.Create;
- begin
- inherited Create;
- FCanLoad := True;
- FCanSave := True;
- FIsMultiImageFormat := False;
- FPreFilter := NGDefaultPreFilter;
- FCompressLevel := NGDefaultCompressLevel;
- FLossyAlpha := NGDefaultLossyAlpha;
- FLossyCompression := NGDefaultLossyCompression;
- FQuality := NGDefaultQuality;
- FProgressive := NGDefaultProgressive;
- end;
- procedure TNetworkGraphicsFileFormat.CheckOptionsValidity;
- begin
- // Just check if save options has valid values
- if not (FPreFilter in [0..6]) then
- FPreFilter := NGDefaultPreFilter;
- if not (FCompressLevel in [0..9]) then
- FCompressLevel := NGDefaultCompressLevel;
- if not (FQuality in [1..100]) then
- FQuality := NGDefaultQuality;
- end;
- function TNetworkGraphicsFileFormat.GetSupportedFormats: TImageFormats;
- begin
- if FLossyCompression then
- Result := NGLossyFormats
- else
- Result := NGLosslessFormats;
- end;
- procedure TNetworkGraphicsFileFormat.ConvertToSupported(var Image: TImageData;
- const Info: TImageFormatInfo);
- var
- ConvFormat: TImageFormat;
- begin
- if not FLossyCompression then
- begin
- // Convert formats for lossless compression
- if Info.HasGrayChannel then
- begin
- if Info.HasAlphaChannel then
- begin
- if Info.BytesPerPixel <= 2 then
- // Convert <= 16bit grayscale images with alpha to ifA8Gray8
- ConvFormat := ifA8Gray8
- else
- // Convert > 16bit grayscale images with alpha to ifA16Gray16
- ConvFormat := ifA16Gray16
- end
- else
- // Convert grayscale images without alpha to ifGray16
- ConvFormat := ifGray16;
- end
- else
- if Info.IsFloatingPoint then
- // Convert floating point images to 64 bit ARGB (or RGB if no alpha)
- ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16B16G16R16, ifB16G16R16)
- else if Info.HasAlphaChannel or Info.IsSpecial then
- // Convert all other images with alpha or special images to A8R8G8B8
- ConvFormat := ifA8R8G8B8
- else
- // Convert images without alpha to R8G8B8
- ConvFormat := ifR8G8B8;
- end
- else
- begin
- // Convert formats for lossy compression
- if Info.HasGrayChannel then
- ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8Gray8, ifGray8)
- else
- ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8R8G8B8, ifR8G8B8);
- end;
- ConvertImage(Image, ConvFormat);
- end;
- function TNetworkGraphicsFileFormat.TestFormat(Handle: TImagingHandle): Boolean;
- var
- ReadCount: LongInt;
- Sig: TChar8;
- begin
- Result := False;
- if Handle <> nil then
- with GetIO do
- begin
- FillChar(Sig, SizeOf(Sig), 0);
- ReadCount := Read(Handle, @Sig, SizeOf(Sig));
- Seek(Handle, -ReadCount, smFromCurrent);
- Result := (ReadCount = SizeOf(Sig)) and (Sig = FSignature);
- end;
- end;
- { TPNGFileFormat class implementation }
- constructor TPNGFileFormat.Create;
- begin
- inherited Create;
- FName := SPNGFormatName;
- AddMasks(SPNGMasks);
- FSignature := PNGSignature;
-
- RegisterOption(ImagingPNGPreFilter, @FPreFilter);
- RegisterOption(ImagingPNGCompressLevel, @FCompressLevel);
- end;
- function TPNGFileFormat.LoadData(Handle: TImagingHandle;
- var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
- var
- NGFileLoader: TNGFileLoader;
- begin
- Result := False;
- NGFileLoader := TNGFileLoader.Create;
- try
- // Use NG file parser to load file
- if NGFileLoader.LoadFile(Handle) and (Length(NGFileLoader.Frames) > 0) then
- with NGFileLoader.Frames[0] do
- begin
- SetLength(Images, 1);
- // Build actual image bits
- if not IsJNG then
- NGFileLoader.LoadImageFromPNGFrame(IHDR, IDATMemory, Images[0]);
- // Build palette, aply color key or background
- NGFileLoader.ApplyFrameSettings(NGFileLoader.Frames[0], Images[0]);
- Result := True;
- end;
- finally
- NGFileLoader.Free;
- end;
- end;
- function TPNGFileFormat.SaveData(Handle: TImagingHandle;
- const Images: TDynImageDataArray; Index: LongInt): Boolean;
- var
- ImageToSave: TImageData;
- MustBeFreed: Boolean;
- NGFileSaver: TNGFileSaver;
- begin
- // Make image PNG compatible, store it in saver, and save it to file
- Result := MakeCompatible(Images[Index], ImageToSave, MustBeFreed);
- if Result then
- begin
- NGFileSaver := TNGFileSaver.Create;
- with NGFileSaver do
- try
- FileType := ngPNG;
- SetFileOptions(Self);
- AddFrame(ImageToSave, False);
- SaveFile(Handle);
- finally
- // Free NG saver and compatible image
- NGFileSaver.Free;
- if MustBeFreed then
- FreeImage(ImageToSave);
- end;
- end;
- end;
- {$IFDEF LINK_MNG}
- { TMNGFileFormat class implementation }
- constructor TMNGFileFormat.Create;
- begin
- inherited Create;
- FName := SMNGFormatName;
- FIsMultiImageFormat := True;
- AddMasks(SMNGMasks);
- FSignature := MNGSignature;
- RegisterOption(ImagingMNGLossyCompression, @FLossyCompression);
- RegisterOption(ImagingMNGLossyAlpha, @FLossyAlpha);
- RegisterOption(ImagingMNGPreFilter, @FPreFilter);
- RegisterOption(ImagingMNGCompressLevel, @FCompressLevel);
- RegisterOption(ImagingMNGQuality, @FQuality);
- RegisterOption(ImagingMNGProgressive, @FProgressive);
- end;
- function TMNGFileFormat.LoadData(Handle: TImagingHandle;
- var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
- var
- NGFileLoader: TNGFileLoader;
- I, Len: LongInt;
- begin
- Result := False;
- NGFileLoader := TNGFileLoader.Create;
- try
- // Use NG file parser to load file
- if NGFileLoader.LoadFile(Handle) then
- begin
- Len := Length(NGFileLoader.Frames);
- if Len > 0 then
- begin
- SetLength(Images, Len);
- for I := 0 to Len - 1 do
- with NGFileLoader.Frames[I] do
- begin
- // Build actual image bits
- if IsJNG then
- NGFileLoader.LoadImageFromJNGFrame(JHDR, IDATMemory, JDATMemory, JDAAMemory, Images[I])
- else
- NGFileLoader.LoadImageFromPNGFrame(IHDR, IDATMemory, Images[I]);
- // Build palette, aply color key or background
- NGFileLoader.ApplyFrameSettings(NGFileLoader.Frames[I], Images[I]);
- end;
- end
- else
- begin
- // Some MNG files (with BASI-IEND streams) dont have actual pixel data
- SetLength(Images, 1);
- with NGFileLoader.MHDR do
- NewImage(FrameWidth, FrameWidth, ifDefault, Images[0]);
- end;
- Result := True;
- end;
- finally
- NGFileLoader.Free;
- end;
- end;
- function TMNGFileFormat.SaveData(Handle: TImagingHandle;
- const Images: TDynImageDataArray; Index: LongInt): Boolean;
- var
- NGFileSaver: TNGFileSaver;
- I, LargestWidth, LargestHeight: LongInt;
- ImageToSave: TImageData;
- MustBeFreed: Boolean;
- begin
- Result := False;
- LargestWidth := 0;
- LargestHeight := 0;
- NGFileSaver := TNGFileSaver.Create;
- NGFileSaver.FileType := ngMNG;
- NGFileSaver.SetFileOptions(Self);
- with NGFileSaver do
- try
- // Store all frames to be saved frames file saver
- for I := FFirstIdx to FLastIdx do
- begin
- if MakeCompatible(Images[I], ImageToSave, MustBeFreed) then
- try
- // Add image as PNG or JNG frame
- AddFrame(ImageToSave, FLossyCompression);
- // Remember largest frame width and height
- LargestWidth := Iff(LargestWidth < ImageToSave.Width, ImageToSave.Width, LargestWidth);
- LargestHeight := Iff(LargestHeight < ImageToSave.Height, ImageToSave.Height, LargestHeight);
- finally
- if MustBeFreed then
- FreeImage(ImageToSave);
- end
- else
- Exit;
- end;
- // Fill MNG header
- MHDR.FrameWidth := LargestWidth;
- MHDR.FrameHeight := LargestHeight;
- MHDR.TicksPerSecond := 0;
- MHDR.NominalLayerCount := 0;
- MHDR.NominalFrameCount := Length(Frames);
- MHDR.NominalPlayTime := 0;
- MHDR.SimplicityProfile := 473; // 111011001 binary, defines MNG-VLC with transparency and JNG support
- // Finally save MNG file
- SaveFile(Handle);
- Result := True;
- finally
- NGFileSaver.Free;
- end;
- end;
- {$ENDIF}
- {$IFDEF LINK_JNG}
- { TJNGFileFormat class implementation }
- constructor TJNGFileFormat.Create;
- begin
- inherited Create;
- FName := SJNGFormatName;
- AddMasks(SJNGMasks);
- FSignature := JNGSignature;
- FLossyCompression := True;
- RegisterOption(ImagingJNGLossyAlpha, @FLossyAlpha);
- RegisterOption(ImagingJNGAlphaPreFilter, @FPreFilter);
- RegisterOption(ImagingJNGAlphaCompressLevel, @FCompressLevel);
- RegisterOption(ImagingJNGQuality, @FQuality);
- RegisterOption(ImagingJNGProgressive, @FProgressive);
- end;
- function TJNGFileFormat.LoadData(Handle: TImagingHandle;
- var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
- var
- NGFileLoader: TNGFileLoader;
- begin
- Result := False;
- NGFileLoader := TNGFileLoader.Create;
- try
- // Use NG file parser to load file
- if NGFileLoader.LoadFile(Handle) and (Length(NGFileLoader.Frames) > 0) then
- with NGFileLoader.Frames[0] do
- begin
- SetLength(Images, 1);
- // Build actual image bits
- if IsJNG then
- NGFileLoader.LoadImageFromJNGFrame(JHDR, IDATMemory, JDATMemory, JDAAMemory, Images[0]);
- // Build palette, aply color key or background
- NGFileLoader.ApplyFrameSettings(NGFileLoader.Frames[0], Images[0]);
- Result := True;
- end;
- finally
- NGFileLoader.Free;
- end;
- end;
- function TJNGFileFormat.SaveData(Handle: TImagingHandle;
- const Images: TDynImageDataArray; Index: LongInt): Boolean;
- var
- NGFileSaver: TNGFileSaver;
- ImageToSave: TImageData;
- MustBeFreed: Boolean;
- begin
- // Make image JNG compatible, store it in saver, and save it to file
- Result := MakeCompatible(Images[Index], ImageToSave, MustBeFreed);
- if Result then
- begin
- NGFileSaver := TNGFileSaver.Create;
- with NGFileSaver do
- try
- FileType := ngJNG;
- SetFileOptions(Self);
- AddFrame(ImageToSave, True);
- SaveFile(Handle);
- finally
- // Free NG saver and compatible image
- NGFileSaver.Free;
- if MustBeFreed then
- FreeImage(ImageToSave);
- end;
- end;
- end;
- {$ENDIF}
- initialization
- RegisterImageFileFormat(TPNGFileFormat);
- {$IFDEF LINK_MNG}
- RegisterImageFileFormat(TMNGFileFormat);
- {$ENDIF}
- {$IFDEF LINK_JNG}
- RegisterImageFileFormat(TJNGFileFormat);
- {$ENDIF}
- finalization
- {
- File Notes:
- -- TODOS ----------------------------------------------------
- - nothing now
- -- 0.24.3 Changes/Bug Fixes ---------------------------------
- - Changes for better thread safety.
- -- 0.23 Changes/Bug Fixes -----------------------------------
- - Added loading of global palettes and transparencies in MNG files
- (and by doing so fixed crash when loading images with global PLTE or tRNS).
- -- 0.21 Changes/Bug Fixes -----------------------------------
- - Small changes in converting to supported formats.
- - MakeCompatible method moved to base class, put ConvertToSupported here.
- GetSupportedFormats removed, it is now set in constructor.
- - Made public properties for options registered to SetOption/GetOption
- functions.
- - Changed extensions to filename masks.
- - Changed SaveData, LoadData, and MakeCompatible methods according
- to changes in base class in Imaging unit.
- -- 0.17 Changes/Bug Fixes -----------------------------------
- - MNG and JNG support added, PNG support redesigned to support NG file handlers
- - added classes for working with NG file formats
- - stuff from old ImagingPng unit added and that unit was deleted
- - unit created and initial stuff added
-
- -- 0.15 Changes/Bug Fixes -----------------------------------
- - when saving indexed images save alpha to tRNS?
- - added some defines and ifdefs to dzlib unit to allow choosing
- impaszlib, fpc's paszlib, zlibex or other zlib implementation
- - added colorkeying support
- - fixed 16bit channel image handling - pixels were not swapped
- - fixed arithmetic overflow (in paeth filter) in FPC
- - data of unknown chunks are skipped and not needlesly loaded
- -- 0.13 Changes/Bug Fixes -----------------------------------
- - adaptive filtering added to PNG saving
- - TPNGFileFormat class added
- }
- end.
|