ImagingNetworkGraphics.pas 68 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166
  1. {
  2. $Id$
  3. Vampyre Imaging Library
  4. by Marek Mauder
  5. http://imaginglib.sourceforge.net
  6. The contents of this file are used with permission, subject to the Mozilla
  7. Public License Version 1.1 (the "License"); you may not use this file except
  8. in compliance with the License. You may obtain a copy of the License at
  9. http://www.mozilla.org/MPL/MPL-1.1.html
  10. Software distributed under the License is distributed on an "AS IS" basis,
  11. WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
  12. the specific language governing rights and limitations under the License.
  13. Alternatively, the contents of this file may be used under the terms of the
  14. GNU Lesser General Public License (the "LGPL License"), in which case the
  15. provisions of the LGPL License are applicable instead of those above.
  16. If you wish to allow use of your version of this file only under the terms
  17. of the LGPL License and not to allow others to use your version of this file
  18. under the MPL, indicate your decision by deleting the provisions above and
  19. replace them with the notice and other provisions required by the LGPL
  20. License. If you do not delete the provisions above, a recipient may use
  21. your version of this file under either the MPL or the LGPL License.
  22. For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
  23. }
  24. { This unit contains image format loaders/savers for Network Graphics image
  25. file formats PNG, MNG, and JNG.}
  26. unit ImagingNetworkGraphics;
  27. interface
  28. {$I ImagingOptions.inc}
  29. uses
  30. Classes, ImagingTypes, Imaging, ImagingUtility, ImagingFormats, dzlib;
  31. type
  32. { Basic class for Network Graphics file formats loaders/savers.}
  33. TNetworkGraphicsFileFormat = class(TImageFileFormat)
  34. protected
  35. FSignature: TChar8;
  36. FPreFilter: LongInt;
  37. FCompressLevel: LongInt;
  38. FLossyCompression: LongBool;
  39. FLossyAlpha: LongBool;
  40. FQuality: LongInt;
  41. FProgressive: LongBool;
  42. function GetSupportedFormats: TImageFormats; override;
  43. procedure ConvertToSupported(var Image: TImageData;
  44. const Info: TImageFormatInfo); override;
  45. public
  46. constructor Create; override;
  47. function TestFormat(Handle: TImagingHandle): Boolean; override;
  48. procedure CheckOptionsValidity; override;
  49. published
  50. { Sets precompression filter used when saving images with lossless compression.
  51. Allowed values are: 0 (none), 1 (sub), 2 (up), 3 (average), 4 (paeth),
  52. 5 (use 0 for indexed/gray images and 4 for RGB/ARGB images),
  53. 6 (adaptive filtering - use best filter for each scanline - very slow).
  54. Note that filters 3 and 4 are much slower than filters 1 and 2.
  55. Default value is 5.}
  56. property PreFilter: LongInt read FPreFilter write FPreFilter;
  57. { Sets ZLib compression level used when saving images with lossless compression.
  58. Allowed values are in range 0 (no compresstion) to 9 (best compression).
  59. Default value is 5.}
  60. property CompressLevel: LongInt read FCompressLevel write FCompressLevel;
  61. { Specifies whether MNG animation frames are saved with lossy or lossless
  62. compression. Lossless frames are saved as PNG images and lossy frames are
  63. saved as JNG images. Allowed values are 0 (False) and 1 (True).
  64. Default value is 0.}
  65. property LossyCompression: LongBool read FLossyCompression write FLossyCompression;
  66. { Defines whether alpha channel of lossy MNG frames or JNG images
  67. is lossy compressed too. Allowed values are 0 (False) and 1 (True).
  68. Default value is 0.}
  69. property LossyAlpha: LongBool read FLossyAlpha write FLossyAlpha;
  70. { Specifies compression quality used when saving lossy MNG frames or JNG images.
  71. For details look at ImagingJpegQuality option.}
  72. property Quality: LongInt read FQuality write FQuality;
  73. { Specifies whether images are saved in progressive format when saving lossy
  74. MNG frames or JNG images. For details look at ImagingJpegProgressive.}
  75. property Progressive: LongBool read FProgressive write FProgressive;
  76. end;
  77. { Class for loading Portable Network Graphics Images.
  78. Loads all types of this image format (all images in png test suite)
  79. and saves all types with bitcount >= 8 (non-interlaced only).
  80. Compression level and filtering can be set by options interface.
  81. Supported ancillary chunks (loading):
  82. tRNS, bKGD
  83. (for indexed images transparency contains alpha values for palette,
  84. RGB/Gray images with transparency are converted to formats with alpha
  85. and pixels with transparent color are replaced with background color
  86. with alpha = 0).}
  87. TPNGFileFormat = class(TNetworkGraphicsFileFormat)
  88. protected
  89. function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
  90. OnlyFirstLevel: Boolean): Boolean; override;
  91. function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
  92. Index: LongInt): Boolean; override;
  93. public
  94. constructor Create; override;
  95. end;
  96. {$IFDEF LINK_MNG}
  97. { Class for loading Multiple Network Graphics files.
  98. This format has complex animation capabilities but Imaging only
  99. extracts frames. Individual frames are stored as standard PNG or JNG
  100. images. Loads all types of these frames stored in IHDR-IEND and
  101. JHDR-IEND streams (Note that there are MNG chunks
  102. like BASI which define images but does not contain image data itself,
  103. those are ignored).
  104. Imaging saves MNG files as MNG-VLC (very low complexity) so it is basicaly
  105. an array of image frames without MNG animation chunks. Frames can be saved
  106. as lossless PNG or lossy JNG images (look at TPNGFileFormat and
  107. TJNGFileFormat for info). Every frame can be in different data format.
  108. Many frame compression settings can be modified by options interface.}
  109. TMNGFileFormat = class(TNetworkGraphicsFileFormat)
  110. protected
  111. function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
  112. OnlyFirstLevel: Boolean): Boolean; override;
  113. function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
  114. Index: LongInt): Boolean; override;
  115. public
  116. constructor Create; override;
  117. end;
  118. {$ENDIF}
  119. {$IFDEF LINK_JNG}
  120. { Class for loading JPEG Network Graphics Images.
  121. Loads all types of this image format (all images in jng test suite)
  122. and saves all types except 12 bit JPEGs.
  123. Alpha channel in JNG images is stored separately from color/gray data and
  124. can be lossy (as JPEG image) or lossless (as PNG image) compressed.
  125. Type of alpha compression, compression level and quality,
  126. and filtering can be set by options interface.
  127. Supported ancillary chunks (loading):
  128. tRNS, bKGD
  129. (Images with transparency are converted to formats with alpha
  130. and pixels with transparent color are replaced with background color
  131. with alpha = 0).}
  132. TJNGFileFormat = class(TNetworkGraphicsFileFormat)
  133. protected
  134. function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
  135. OnlyFirstLevel: Boolean): Boolean; override;
  136. function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
  137. Index: LongInt): Boolean; override;
  138. public
  139. constructor Create; override;
  140. end;
  141. {$ENDIF}
  142. implementation
  143. {$IFDEF LINK_JNG}
  144. uses
  145. ImagingJpeg, ImagingIO;
  146. {$ENDIF}
  147. const
  148. NGDefaultPreFilter = 5;
  149. NGDefaultCompressLevel = 5;
  150. NGDefaultLossyAlpha = False;
  151. NGDefaultLossyCompression = False;
  152. NGDefaultProgressive = False;
  153. NGDefaultQuality = 90;
  154. NGLosslessFormats: TImageFormats = [ifIndex8, ifGray8, ifA8Gray8, ifGray16,
  155. ifA16Gray16, ifR8G8B8, ifA8R8G8B8, ifR16G16B16, ifA16R16G16B16, ifB16G16R16,
  156. ifA16B16G16R16];
  157. NGLossyFormats: TImageFormats = [ifGray8, ifA8Gray8, ifR8G8B8, ifA8R8G8B8];
  158. SPNGFormatName = 'Portable Network Graphics';
  159. SPNGMasks = '*.png';
  160. SMNGFormatName = 'Multiple Network Graphics';
  161. SMNGMasks = '*.mng';
  162. SJNGFormatName = 'JPEG Network Graphics';
  163. SJNGMasks = '*.jng';
  164. resourcestring
  165. SErrorLoadingChunk = 'Error when reading %s chunk data. File may be corrupted.';
  166. type
  167. { Chunk header.}
  168. TChunkHeader = packed record
  169. DataSize: LongWord;
  170. ChunkID: TChar4;
  171. end;
  172. { IHDR chunk format.}
  173. TIHDR = packed record
  174. Width: LongWord; // Image width
  175. Height: LongWord; // Image height
  176. BitDepth: Byte; // Bits per pixel or bits per sample (for truecolor)
  177. ColorType: Byte; // 0 = grayscale, 2 = truecolor, 3 = palette,
  178. // 4 = gray + alpha, 6 = truecolor + alpha
  179. Compression: Byte; // Compression type: 0 = ZLib
  180. Filter: Byte; // Used precompress filter
  181. Interlacing: Byte; // Used interlacing: 0 = no int, 1 = Adam7
  182. end;
  183. PIHDR = ^TIHDR;
  184. { MHDR chunk format.}
  185. TMHDR = packed record
  186. FrameWidth: LongWord; // Frame width
  187. FrameHeight: LongWord; // Frame height
  188. TicksPerSecond: LongWord; // FPS of animation
  189. NominalLayerCount: LongWord; // Number of layers in file
  190. NominalFrameCount: LongWord; // Number of frames in file
  191. NominalPlayTime: LongWord; // Play time of animation in ticks
  192. SimplicityProfile: LongWord; // Defines which mMNG features are used in this file
  193. end;
  194. PMHDR = ^TMHDR;
  195. { JHDR chunk format.}
  196. TJHDR = packed record
  197. Width: LongWord; // Image width
  198. Height: LongWord; // Image height
  199. ColorType: Byte; // 8 = grayscale (Y), 10 = color (YCbCr),
  200. // 12 = gray + alpha (Y-alpha), 14 = color + alpha (YCbCr-alpha)
  201. SampleDepth: Byte; // 8, 12 or 20 (8 and 12 samples together) bit
  202. Compression: Byte; // Compression type: 8 = Huffman coding
  203. Interlacing: Byte; // 0 = single scan, 8 = progressive
  204. AlphaSampleDepth: Byte; // 0, 1, 2, 4, 8, 16 if alpha compression is 0 (PNG)
  205. // 8 if alpha compression is 8 (JNG)
  206. AlphaCompression: Byte; // 0 = PNG graysscale IDAT, 8 = grayscale 8-bit JPEG
  207. AlphaFilter: Byte; // 0 = PNG filter or no filter (JPEG)
  208. AlphaInterlacing: Byte; // 0 = non interlaced
  209. end;
  210. PJHDR = ^TJHDR;
  211. const
  212. { PNG file identifier.}
  213. PNGSignature: TChar8 = #$89'PNG'#$0D#$0A#$1A#$0A;
  214. { MNG file identifier.}
  215. MNGSignature: TChar8 = #$8A'MNG'#$0D#$0A#$1A#$0A;
  216. { JNG file identifier.}
  217. JNGSignature: TChar8 = #$8B'JNG'#$0D#$0A#$1A#$0A;
  218. { Constants for chunk identifiers and signature identifiers.
  219. They are in big-endian format.}
  220. IHDRChunk: TChar4 = 'IHDR';
  221. IENDChunk: TChar4 = 'IEND';
  222. MHDRChunk: TChar4 = 'MHDR';
  223. MENDChunk: TChar4 = 'MEND';
  224. JHDRChunk: TChar4 = 'JHDR';
  225. IDATChunk: TChar4 = 'IDAT';
  226. JDATChunk: TChar4 = 'JDAT';
  227. JDAAChunk: TChar4 = 'JDAA';
  228. JSEPChunk: TChar4 = 'JSEP';
  229. PLTEChunk: TChar4 = 'PLTE';
  230. BACKChunk: TChar4 = 'BACK';
  231. DEFIChunk: TChar4 = 'DEFI';
  232. TERMChunk: TChar4 = 'TERM';
  233. tRNSChunk: TChar4 = 'tRNS';
  234. bKGDChunk: TChar4 = 'bKGD';
  235. gAMAChunk: TChar4 = 'gAMA';
  236. { Interlace start and offsets.}
  237. RowStart: array[0..6] of LongInt = (0, 0, 4, 0, 2, 0, 1);
  238. ColumnStart: array[0..6] of LongInt = (0, 4, 0, 2, 0, 1, 0);
  239. RowIncrement: array[0..6] of LongInt = (8, 8, 8, 4, 4, 2, 2);
  240. ColumnIncrement: array[0..6] of LongInt = (8, 8, 4, 4, 2, 2, 1);
  241. type
  242. { Helper class that holds information about MNG frame in PNG or JNG format.}
  243. TFrameInfo = class(TObject)
  244. public
  245. IsJNG: Boolean;
  246. IHDR: TIHDR;
  247. JHDR: TJHDR;
  248. Palette: PPalette24;
  249. PaletteEntries: LongInt;
  250. Transparency: Pointer;
  251. TransparencySize: LongInt;
  252. Background: Pointer;
  253. BackgroundSize: LongInt;
  254. IDATMemory: TMemoryStream;
  255. JDATMemory: TMemoryStream;
  256. JDAAMemory: TMemoryStream;
  257. constructor Create;
  258. destructor Destroy; override;
  259. end;
  260. { Defines type of Network Graphics file.}
  261. TNGFileType = (ngPNG, ngMNG, ngJNG);
  262. TNGFileHandler = class(TObject)
  263. public
  264. FileType: TNGFileType;
  265. Frames: array of TFrameInfo;
  266. MHDR: TMHDR;
  267. GlobalPalette: PPalette24;
  268. GlobalPaletteEntries: LongInt;
  269. GlobalTransparency: Pointer;
  270. GlobalTransparencySize: LongInt;
  271. destructor Destroy; override;
  272. procedure Clear;
  273. function GetLastFrame: TFrameInfo;
  274. function AddFrameInfo: TFrameInfo;
  275. end;
  276. { Network Graphics file parser and frame converter.}
  277. TNGFileLoader = class(TNGFileHandler)
  278. public
  279. function LoadFile(Handle: TImagingHandle): Boolean;
  280. procedure LoadImageFromPNGFrame(const IHDR: TIHDR; IDATStream: TMemoryStream; var Image: TImageData);
  281. {$IFDEF LINK_JNG}
  282. procedure LoadImageFromJNGFrame(const JHDR: TJHDR; IDATStream, JDATStream, JDAAStream: TMemoryStream; var Image: TImageData);
  283. {$ENDIF}
  284. procedure ApplyFrameSettings(Frame: TFrameInfo; var Image: TImageData);
  285. end;
  286. TNGFileSaver = class(TNGFileHandler)
  287. public
  288. PreFilter: LongInt;
  289. CompressLevel: LongInt;
  290. LossyAlpha: Boolean;
  291. Quality: LongInt;
  292. Progressive: Boolean;
  293. function SaveFile(Handle: TImagingHandle): Boolean;
  294. procedure AddFrame(const Image: TImageData; IsJNG: Boolean);
  295. procedure StoreImageToPNGFrame(const IHDR: TIHDR; Bits: Pointer; FmtInfo: TImageFormatInfo; IDATStream: TMemoryStream);
  296. {$IFDEF LINK_JNG}
  297. procedure StoreImageToJNGFrame(const JHDR: TJHDR; const Image: TImageData; IDATStream, JDATStream, JDAAStream: TMemoryStream);
  298. {$ENDIF}
  299. procedure SetFileOptions(FileFormat: TNetworkGraphicsFileFormat);
  300. end;
  301. {$IFDEF LINK_JNG}
  302. TCustomIOJpegFileFormat = class(TJpegFileFormat)
  303. protected
  304. FCustomIO: TIOFunctions;
  305. procedure SetJpegIO(const JpegIO: TIOFunctions); override;
  306. procedure SetCustomIO(const CustomIO: TIOFunctions);
  307. end;
  308. {$ENDIF}
  309. { Helper routines }
  310. function PaethPredictor(A, B, C: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
  311. var
  312. P, PA, PB, PC: LongInt;
  313. begin
  314. P := A + B - C;
  315. PA := Abs(P - A);
  316. PB := Abs(P - B);
  317. PC := Abs(P - C);
  318. if (PA <= PB) and (PA <= PC) then
  319. Result := A
  320. else
  321. if PB <= PC then
  322. Result := B
  323. else
  324. Result := C;
  325. end;
  326. procedure SwapRGB(Line: PByte; Width, SampleDepth, BytesPerPixel: LongInt);
  327. var
  328. I: LongInt;
  329. Tmp: Word;
  330. begin
  331. case SampleDepth of
  332. 8:
  333. for I := 0 to Width - 1 do
  334. with PColor24Rec(Line)^ do
  335. begin
  336. Tmp := R;
  337. R := B;
  338. B := Tmp;
  339. Inc(Line, BytesPerPixel);
  340. end;
  341. 16:
  342. for I := 0 to Width - 1 do
  343. with PColor48Rec(Line)^ do
  344. begin
  345. Tmp := R;
  346. R := B;
  347. B := Tmp;
  348. Inc(Line, BytesPerPixel);
  349. end;
  350. end;
  351. end;
  352. const
  353. { Helper constants for 1/2/4 bit to 8 bit conversions.}
  354. Mask1: array[0..7] of Byte = ($80, $40, $20, $10, $08, $04, $02, $01);
  355. Shift1: array[0..7] of Byte = (7, 6, 5, 4, 3, 2, 1, 0);
  356. Mask2: array[0..3] of Byte = ($C0, $30, $0C, $03);
  357. Shift2: array[0..3] of Byte = (6, 4, 2, 0);
  358. Mask4: array[0..1] of Byte = ($F0, $0F);
  359. Shift4: array[0..1] of Byte = (4, 0);
  360. function Get1BitPixel(Line: PByteArray; X: LongInt): Byte;
  361. begin
  362. Result := (Line[X shr 3] and Mask1[X and 7]) shr
  363. Shift1[X and 7];
  364. end;
  365. function Get2BitPixel(Line: PByteArray; X: LongInt): Byte;
  366. begin
  367. Result := (Line[X shr 2] and Mask2[X and 3]) shr
  368. Shift2[X and 3];
  369. end;
  370. function Get4BitPixel(Line: PByteArray; X: LongInt): Byte;
  371. begin
  372. Result := (Line[X shr 1] and Mask4[X and 1]) shr
  373. Shift4[X and 1];
  374. end;
  375. {$IFDEF LINK_JNG}
  376. { TCustomIOJpegFileFormat class implementation }
  377. procedure TCustomIOJpegFileFormat.SetCustomIO(const CustomIO: TIOFunctions);
  378. begin
  379. FCustomIO := CustomIO;
  380. end;
  381. procedure TCustomIOJpegFileFormat.SetJpegIO(const JpegIO: TIOFunctions);
  382. begin
  383. inherited SetJpegIO(FCustomIO);
  384. end;
  385. {$ENDIF}
  386. { TFrameInfo class implementation }
  387. constructor TFrameInfo.Create;
  388. begin
  389. IDATMemory := TMemoryStream.Create;
  390. JDATMemory := TMemoryStream.Create;
  391. JDAAMemory := TMemoryStream.Create;
  392. end;
  393. destructor TFrameInfo.Destroy;
  394. begin
  395. FreeMem(Palette);
  396. FreeMem(Transparency);
  397. FreeMem(Background);
  398. IDATMemory.Free;
  399. JDATMemory.Free;
  400. JDAAMemory.Free;
  401. inherited Destroy;
  402. end;
  403. { TNGFileHandler class implementation}
  404. destructor TNGFileHandler.Destroy;
  405. begin
  406. Clear;
  407. inherited Destroy;
  408. end;
  409. procedure TNGFileHandler.Clear;
  410. var
  411. I: LongInt;
  412. begin
  413. for I := 0 to Length(Frames) - 1 do
  414. Frames[I].Free;
  415. SetLength(Frames, 0);
  416. FreeMemNil(GlobalPalette);
  417. GlobalPaletteEntries := 0;
  418. FreeMemNil(GlobalTransparency);
  419. GlobalTransparencySize := 0;
  420. end;
  421. function TNGFileHandler.GetLastFrame: TFrameInfo;
  422. var
  423. Len: LongInt;
  424. begin
  425. Len := Length(Frames);
  426. if Len > 0 then
  427. Result := Frames[Len - 1]
  428. else
  429. Result := nil;
  430. end;
  431. function TNGFileHandler.AddFrameInfo: TFrameInfo;
  432. var
  433. Len: LongInt;
  434. begin
  435. Len := Length(Frames);
  436. SetLength(Frames, Len + 1);
  437. Result := TFrameInfo.Create;
  438. Frames[Len] := Result;
  439. end;
  440. { TNGFileLoader class implementation}
  441. function TNGFileLoader.LoadFile(Handle: TImagingHandle): Boolean;
  442. var
  443. Sig: TChar8;
  444. Chunk: TChunkHeader;
  445. ChunkData: Pointer;
  446. ChunkCrc: LongWord;
  447. procedure ReadChunk;
  448. begin
  449. GetIO.Read(Handle, @Chunk, SizeOf(Chunk));
  450. Chunk.DataSize := SwapEndianLongWord(Chunk.DataSize);
  451. end;
  452. procedure ReadChunkData;
  453. var
  454. ReadBytes: LongWord;
  455. begin
  456. FreeMemNil(ChunkData);
  457. GetMem(ChunkData, Chunk.DataSize);
  458. ReadBytes := GetIO.Read(Handle, ChunkData, Chunk.DataSize);
  459. GetIO.Read(Handle, @ChunkCrc, SizeOf(ChunkCrc));
  460. if ReadBytes <> Chunk.DataSize then
  461. RaiseImaging(SErrorLoadingChunk, [string(Chunk.ChunkID)]);
  462. end;
  463. procedure SkipChunkData;
  464. begin
  465. GetIO.Seek(Handle, Chunk.DataSize + SizeOf(ChunkCrc), smFromCurrent);
  466. end;
  467. procedure StartNewPNGImage;
  468. var
  469. Frame: TFrameInfo;
  470. begin
  471. ReadChunkData;
  472. Frame := AddFrameInfo;
  473. Frame.IsJNG := False;
  474. Frame.IHDR := PIHDR(ChunkData)^;
  475. end;
  476. procedure StartNewJNGImage;
  477. var
  478. Frame: TFrameInfo;
  479. begin
  480. ReadChunkData;
  481. Frame := AddFrameInfo;
  482. Frame.IsJNG := True;
  483. Frame.JHDR := PJHDR(ChunkData)^;
  484. end;
  485. procedure AppendIDAT;
  486. begin
  487. ReadChunkData;
  488. // Append current IDAT chunk to storage stream
  489. GetLastFrame.IDATMemory.Write(ChunkData^, Chunk.DataSize);
  490. end;
  491. procedure AppendJDAT;
  492. begin
  493. ReadChunkData;
  494. // Append current JDAT chunk to storage stream
  495. GetLastFrame.JDATMemory.Write(ChunkData^, Chunk.DataSize);
  496. end;
  497. procedure AppendJDAA;
  498. begin
  499. ReadChunkData;
  500. // Append current JDAA chunk to storage stream
  501. GetLastFrame.JDAAMemory.Write(ChunkData^, Chunk.DataSize);
  502. end;
  503. procedure LoadPLTE;
  504. begin
  505. ReadChunkData;
  506. if GetLastFrame = nil then
  507. begin
  508. // Load global palette
  509. GetMem(GlobalPalette, Chunk.DataSize);
  510. Move(ChunkData^, GlobalPalette^, Chunk.DataSize);
  511. GlobalPaletteEntries := Chunk.DataSize div 3;
  512. end
  513. else if GetLastFrame.Palette = nil then
  514. begin
  515. if (Chunk.DataSize = 0) and (GlobalPalette <> nil) then
  516. begin
  517. // Use global palette
  518. GetMem(GetLastFrame.Palette, GlobalPaletteEntries * SizeOf(TColor24Rec));
  519. Move(GlobalPalette^, GetLastFrame.Palette^, GlobalPaletteEntries * SizeOf(TColor24Rec));
  520. GetLastFrame.PaletteEntries := GlobalPaletteEntries;
  521. end
  522. else
  523. begin
  524. // Load pal from PLTE chunk
  525. GetMem(GetLastFrame.Palette, Chunk.DataSize);
  526. Move(ChunkData^, GetLastFrame.Palette^, Chunk.DataSize);
  527. GetLastFrame.PaletteEntries := Chunk.DataSize div 3;
  528. end;
  529. end;
  530. end;
  531. procedure LoadtRNS;
  532. begin
  533. ReadChunkData;
  534. if GetLastFrame = nil then
  535. begin
  536. // Load global transparency
  537. GetMem(GlobalTransparency, Chunk.DataSize);
  538. Move(ChunkData^, GlobalTransparency^, Chunk.DataSize);
  539. GlobalTransparencySize := Chunk.DataSize;
  540. end
  541. else if GetLastFrame.Transparency = nil then
  542. begin
  543. if (Chunk.DataSize = 0) and (GlobalTransparency <> nil) then
  544. begin
  545. // Use global transparency
  546. GetMem(GetLastFrame.Transparency, GlobalTransparencySize);
  547. Move(GlobalTransparency^, GetLastFrame.Transparency^, Chunk.DataSize);
  548. GetLastFrame.TransparencySize := GlobalTransparencySize;
  549. end
  550. else
  551. begin
  552. // Load pal from tRNS chunk
  553. GetMem(GetLastFrame.Transparency, Chunk.DataSize);
  554. Move(ChunkData^, GetLastFrame.Transparency^, Chunk.DataSize);
  555. GetLastFrame.TransparencySize := Chunk.DataSize;
  556. end;
  557. end;
  558. end;
  559. procedure LoadbKGD;
  560. begin
  561. ReadChunkData;
  562. if GetLastFrame.Background = nil then
  563. begin
  564. GetMem(GetLastFrame.Background, Chunk.DataSize);
  565. Move(ChunkData^, GetLastFrame.Background^, Chunk.DataSize);
  566. GetLastFrame.BackgroundSize := Chunk.DataSize;
  567. end;
  568. end;
  569. begin
  570. Result := False;
  571. Clear;
  572. ChunkData := nil;
  573. with GetIO do
  574. try
  575. Read(Handle, @Sig, SizeOf(Sig));
  576. // Set file type according to the signature
  577. if Sig = PNGSignature then FileType := ngPNG
  578. else if Sig = MNGSignature then FileType := ngMNG
  579. else if Sig = JNGSignature then FileType := ngJNG
  580. else Exit;
  581. if FileType = ngMNG then
  582. begin
  583. // Store MNG header if present
  584. ReadChunk;
  585. ReadChunkData;
  586. MHDR := PMHDR(ChunkData)^;
  587. SwapEndianLongWord(@MHDR, SizeOf(MHDR) div SizeOf(LongWord));
  588. end
  589. else
  590. FillChar(MHDR, SizeOf(MHDR), 0);
  591. // Read chunks until ending chunk or EOF is reached
  592. repeat
  593. ReadChunk;
  594. if Chunk.ChunkID = IHDRChunk then StartNewPNGImage
  595. else if Chunk.ChunkID = JHDRChunk then StartNewJNGImage
  596. else if Chunk.ChunkID = IDATChunk then AppendIDAT
  597. else if Chunk.ChunkID = JDATChunk then AppendJDAT
  598. else if Chunk.ChunkID = JDAAChunk then AppendJDAA
  599. else if Chunk.ChunkID = PLTEChunk then LoadPLTE
  600. else if Chunk.ChunkID = tRNSChunk then LoadtRNS
  601. else if Chunk.ChunkID = bKGDChunk then LoadbKGD
  602. else SkipChunkData;
  603. until Eof(Handle) or (Chunk.ChunkID = MENDChunk) or
  604. ((FileType <> ngMNG) and (Chunk.ChunkID = IENDChunk));
  605. Result := True;
  606. finally
  607. FreeMemNil(ChunkData);
  608. end;
  609. end;
  610. procedure TNGFileLoader.LoadImageFromPNGFrame(const IHDR: TIHDR;
  611. IDATStream: TMemoryStream; var Image: TImageData);
  612. type
  613. TGetPixelFunc = function(Line: PByteArray; X: LongInt): Byte;
  614. var
  615. LineBuffer: array[Boolean] of PByteArray;
  616. ActLine: Boolean;
  617. Data, TotalBuffer, ZeroLine, PrevLine: Pointer;
  618. BitCount, TotalSize, TotalPos, BytesPerPixel, I, Pass,
  619. SrcDataSize, BytesPerLine, InterlaceLineBytes, InterlaceWidth: LongInt;
  620. procedure DecodeAdam7;
  621. const
  622. BitTable: array[1..8] of LongInt = ($1, $3, 0, $F, 0, 0, 0, $FF);
  623. StartBit: array[1..8] of LongInt = (7, 6, 0, 4, 0, 0, 0, 0);
  624. var
  625. Src, Dst, Dst2: PByte;
  626. CurBit, Col: LongInt;
  627. begin
  628. Src := @LineBuffer[ActLine][1];
  629. Col := ColumnStart[Pass];
  630. with Image do
  631. case BitCount of
  632. 1, 2, 4:
  633. begin
  634. Dst := @PByteArray(Data)[I * BytesPerLine];
  635. repeat
  636. CurBit := StartBit[BitCount];
  637. repeat
  638. Dst2 := @PByteArray(Dst)[(BitCount * Col) shr 3];
  639. Dst2^ := Dst2^ or ((Src^ shr CurBit) and BitTable[BitCount])
  640. shl (StartBit[BitCount] - (Col * BitCount mod 8));
  641. Inc(Col, ColumnIncrement[Pass]);
  642. Dec(CurBit, BitCount);
  643. until CurBit < 0;
  644. Inc(Src);
  645. until Col >= Width;
  646. end;
  647. else
  648. begin
  649. Dst := @PByteArray(Data)[I * BytesPerLine + Col * BytesPerPixel];
  650. repeat
  651. CopyPixel(Src, Dst, BytesPerPixel);
  652. Inc(Dst, BytesPerPixel);
  653. Inc(Src, BytesPerPixel);
  654. Inc(Dst, ColumnIncrement[Pass] * BytesPerPixel - BytesPerPixel);
  655. Inc(Col, ColumnIncrement[Pass]);
  656. until Col >= Width;
  657. end;
  658. end;
  659. end;
  660. procedure FilterScanline(Filter: Byte; BytesPerPixel: LongInt; Line, PrevLine, Target: PByteArray;
  661. BytesPerLine: LongInt);
  662. var
  663. I: LongInt;
  664. begin
  665. case Filter of
  666. 0:
  667. begin
  668. // No filter
  669. Move(Line^, Target^, BytesPerLine);
  670. end;
  671. 1:
  672. begin
  673. // Sub filter
  674. Move(Line^, Target^, BytesPerPixel);
  675. for I := BytesPerPixel to BytesPerLine - 1 do
  676. Target[I] := (Line[I] + Target[I - BytesPerPixel]) and $FF;
  677. end;
  678. 2:
  679. begin
  680. // Up filter
  681. for I := 0 to BytesPerLine - 1 do
  682. Target[I] := (Line[I] + PrevLine[I]) and $FF;
  683. end;
  684. 3:
  685. begin
  686. // Average filter
  687. for I := 0 to BytesPerPixel - 1 do
  688. Target[I] := (Line[I] + PrevLine[I] shr 1) and $FF;
  689. for I := BytesPerPixel to BytesPerLine - 1 do
  690. Target[I] := (Line[I] + (Target[I - BytesPerPixel] + PrevLine[I]) shr 1) and $FF;
  691. end;
  692. 4:
  693. begin
  694. // Paeth filter
  695. for I := 0 to BytesPerPixel - 1 do
  696. Target[I] := (Line[I] + PaethPredictor(0, PrevLine[I], 0)) and $FF;
  697. for I := BytesPerPixel to BytesPerLine - 1 do
  698. Target[I] := (Line[I] + PaethPredictor(Target[I - BytesPerPixel], PrevLine[I], PrevLine[I - BytesPerPixel])) and $FF;
  699. end;
  700. end;
  701. end;
  702. procedure Convert124To8(DataIn: Pointer; DataOut: Pointer; Width, Height,
  703. WidthBytes: LongInt; Indexed: Boolean);
  704. var
  705. X, Y, Mul: LongInt;
  706. GetPixel: TGetPixelFunc;
  707. begin
  708. GetPixel := Get1BitPixel;
  709. Mul := 255;
  710. case IHDR.BitDepth of
  711. 2:
  712. begin
  713. Mul := 85;
  714. GetPixel := Get2BitPixel;
  715. end;
  716. 4:
  717. begin
  718. Mul := 17;
  719. GetPixel := Get4BitPixel;
  720. end;
  721. end;
  722. if Indexed then Mul := 1;
  723. for Y := 0 to Height - 1 do
  724. for X := 0 to Width - 1 do
  725. PByteArray(DataOut)[Y * Width + X] :=
  726. GetPixel(@PByteArray(DataIn)[Y * WidthBytes], X) * Mul;
  727. end;
  728. procedure TransformLOCOToRGB(Data: PByte; NumPixels, BytesPerPixel: LongInt);
  729. var
  730. I: LongInt;
  731. begin
  732. for I := 0 to NumPixels - 1 do
  733. begin
  734. if IHDR.BitDepth = 8 then
  735. begin
  736. PColor32Rec(Data).R := Byte(PColor32Rec(Data).R + PColor32Rec(Data).G);
  737. PColor32Rec(Data).B := Byte(PColor32Rec(Data).B + PColor32Rec(Data).G);
  738. end
  739. else
  740. begin
  741. PColor64Rec(Data).R := Word(PColor64Rec(Data).R + PColor64Rec(Data).G);
  742. PColor64Rec(Data).B := Word(PColor64Rec(Data).B + PColor64Rec(Data).G);
  743. end;
  744. Inc(Data, BytesPerPixel);
  745. end;
  746. end;
  747. begin
  748. Image.Width := SwapEndianLongWord(IHDR.Width);
  749. Image.Height := SwapEndianLongWord(IHDR.Height);
  750. Image.Format := ifUnknown;
  751. case IHDR.ColorType of
  752. 0:
  753. begin
  754. // Gray scale image
  755. case IHDR.BitDepth of
  756. 1, 2, 4, 8: Image.Format := ifGray8;
  757. 16: Image.Format := ifGray16;
  758. end;
  759. BitCount := IHDR.BitDepth;
  760. end;
  761. 2:
  762. begin
  763. // RGB image
  764. case IHDR.BitDepth of
  765. 8: Image.Format := ifR8G8B8;
  766. 16: Image.Format := ifR16G16B16;
  767. end;
  768. BitCount := IHDR.BitDepth * 3;
  769. end;
  770. 3:
  771. begin
  772. // Indexed image
  773. case IHDR.BitDepth of
  774. 1, 2, 4, 8: Image.Format := ifIndex8;
  775. end;
  776. BitCount := IHDR.BitDepth;
  777. end;
  778. 4:
  779. begin
  780. // Grayscale + alpha image
  781. case IHDR.BitDepth of
  782. 8: Image.Format := ifA8Gray8;
  783. 16: Image.Format := ifA16Gray16;
  784. end;
  785. BitCount := IHDR.BitDepth * 2;
  786. end;
  787. 6:
  788. begin
  789. // ARGB image
  790. case IHDR.BitDepth of
  791. 8: Image.Format := ifA8R8G8B8;
  792. 16: Image.Format := ifA16R16G16B16;
  793. end;
  794. BitCount := IHDR.BitDepth * 4;
  795. end;
  796. end;
  797. // Start decoding
  798. LineBuffer[True] := nil;
  799. LineBuffer[False] := nil;
  800. TotalBuffer := nil;
  801. ZeroLine := nil;
  802. BytesPerPixel := (BitCount + 7) div 8;
  803. ActLine := True;
  804. with Image do
  805. try
  806. BytesPerLine := (Width * BitCount + 7) div 8;
  807. SrcDataSize := Height * BytesPerLine;
  808. GetMem(Data, SrcDataSize);
  809. FillChar(Data^, SrcDataSize, 0);
  810. GetMem(ZeroLine, BytesPerLine);
  811. FillChar(ZeroLine^, BytesPerLine, 0);
  812. if IHDR.Interlacing = 1 then
  813. begin
  814. // Decode interlaced images
  815. TotalPos := 0;
  816. DecompressBuf(IDATStream.Memory, IDATStream.Size, 0,
  817. Pointer(TotalBuffer), TotalSize);
  818. GetMem(LineBuffer[True], BytesPerLine + 1);
  819. GetMem(LineBuffer[False], BytesPerLine + 1);
  820. for Pass := 0 to 6 do
  821. begin
  822. // Prepare next interlace run
  823. if Width <= ColumnStart[Pass] then
  824. Continue;
  825. InterlaceWidth := (Width + ColumnIncrement[Pass] - 1 -
  826. ColumnStart[Pass]) div ColumnIncrement[Pass];
  827. InterlaceLineBytes := (InterlaceWidth * BitCount + 7) shr 3;
  828. I := RowStart[Pass];
  829. FillChar(LineBuffer[True][0], BytesPerLine + 1, 0);
  830. FillChar(LineBuffer[False][0], BytesPerLine + 1, 0);
  831. while I < Height do
  832. begin
  833. // Copy line from decompressed data to working buffer
  834. Move(PByteArray(TotalBuffer)[TotalPos],
  835. LineBuffer[ActLine][0], InterlaceLineBytes + 1);
  836. Inc(TotalPos, InterlaceLineBytes + 1);
  837. // Swap red and blue channels if necessary
  838. if (IHDR.ColorType in [2, 6]) then
  839. SwapRGB(@LineBuffer[ActLine][1], InterlaceWidth, IHDR.BitDepth, BytesPerPixel);
  840. // Reverse-filter current scanline
  841. FilterScanline(LineBuffer[ActLine][0], BytesPerPixel,
  842. @LineBuffer[ActLine][1], @LineBuffer[not ActLine][1],
  843. @LineBuffer[ActLine][1], InterlaceLineBytes);
  844. // Decode Adam7 interlacing
  845. DecodeAdam7;
  846. ActLine := not ActLine;
  847. // Continue with next row in interlaced order
  848. Inc(I, RowIncrement[Pass]);
  849. end;
  850. end;
  851. end
  852. else
  853. begin
  854. // Decode non-interlaced images
  855. PrevLine := ZeroLine;
  856. DecompressBuf(IDATStream.Memory, IDATStream.Size, SrcDataSize + Height,
  857. Pointer(TotalBuffer), TotalSize);
  858. for I := 0 to Height - 1 do
  859. begin
  860. // Swap red and blue channels if necessary
  861. if IHDR.ColorType in [2, 6] then
  862. SwapRGB(@PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1], Width,
  863. IHDR.BitDepth, BytesPerPixel);
  864. // reverse-filter current scanline
  865. FilterScanline(PByteArray(TotalBuffer)[I * (BytesPerLine + 1)],
  866. BytesPerPixel, @PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1],
  867. PrevLine, @PByteArray(Data)[I * BytesPerLine], BytesPerLine);
  868. PrevLine := @PByteArray(Data)[I * BytesPerLine];
  869. end;
  870. end;
  871. Size := Width * Height * BytesPerPixel;
  872. if Size <> SrcDataSize then
  873. begin
  874. // If source data size is different from size of image in assigned
  875. // format we must convert it (it is in 1/2/4 bit count)
  876. GetMem(Bits, Size);
  877. case IHDR.ColorType of
  878. 0: Convert124To8(Data, Bits, Width, Height, BytesPerLine, False);
  879. 3: Convert124To8(Data, Bits, Width, Height, BytesPerLine, True);
  880. end;
  881. FreeMem(Data);
  882. end
  883. else
  884. begin
  885. // If source data size is the same as size of
  886. // image Bits in assigned format we simply copy pointer reference
  887. Bits := Data;
  888. end;
  889. // LOCO transformation was used too (only for color types 2 and 6)
  890. if (IHDR.Filter = 64) and (IHDR.ColorType in [2, 6]) then
  891. TransformLOCOToRGB(Bits, Width * Height, BytesPerPixel);
  892. // Images with 16 bit channels must be swapped because of PNG's big endianity
  893. if IHDR.BitDepth = 16 then
  894. SwapEndianWord(Bits, Width * Height * BytesPerPixel div SizeOf(Word));
  895. finally
  896. FreeMem(LineBuffer[True]);
  897. FreeMem(LineBuffer[False]);
  898. FreeMem(TotalBuffer);
  899. FreeMem(ZeroLine);
  900. end;
  901. end;
  902. {$IFDEF LINK_JNG}
  903. procedure TNGFileLoader.LoadImageFromJNGFrame(const JHDR: TJHDR; IDATStream,
  904. JDATStream, JDAAStream: TMemoryStream; var Image: TImageData);
  905. var
  906. AlphaImage: TImageData;
  907. FakeIHDR: TIHDR;
  908. FmtInfo: TImageFormatInfo;
  909. I: LongInt;
  910. AlphaPtr: PByte;
  911. GrayPtr: PWordRec;
  912. ColorPtr: PColor32Rec;
  913. procedure LoadJpegFromStream(Stream: TStream; var DestImage: TImageData);
  914. var
  915. JpegFormat: TCustomIOJpegFileFormat;
  916. Handle: TImagingHandle;
  917. DynImages: TDynImageDataArray;
  918. begin
  919. if JHDR.SampleDepth <> 12 then
  920. begin
  921. JpegFormat := TCustomIOJpegFileFormat.Create;
  922. JpegFormat.SetCustomIO(StreamIO);
  923. Stream.Position := 0;
  924. Handle := StreamIO.OpenRead(Pointer(Stream));
  925. try
  926. JpegFormat.LoadData(Handle, DynImages, True);
  927. DestImage := DynImages[0];
  928. finally
  929. StreamIO.Close(Handle);
  930. JpegFormat.Free;
  931. SetLength(DynImages, 0);
  932. end;
  933. end
  934. else
  935. NewImage(JHDR.Width, JHDR.Height, ifR8G8B8, DestImage);
  936. end;
  937. begin
  938. LoadJpegFromStream(JDATStream, Image);
  939. // If present separate alpha channel is processed
  940. if (JHDR.ColorType in [12, 14]) and (Image.Format in [ifGray8, ifR8G8B8]) then
  941. begin
  942. InitImage(AlphaImage);
  943. if JHDR.AlphaCompression = 0 then
  944. begin
  945. // Alpha channel is PNG compressed
  946. FakeIHDR.Width := JHDR.Width;
  947. FakeIHDR.Height := JHDR.Height;
  948. FakeIHDR.ColorType := 0;
  949. FakeIHDR.BitDepth := JHDR.AlphaSampleDepth;
  950. FakeIHDR.Filter := JHDR.AlphaFilter;
  951. FakeIHDR.Interlacing := JHDR.AlphaInterlacing;
  952. LoadImageFromPNGFrame(FakeIHDR, IDATStream, AlphaImage);
  953. end
  954. else
  955. begin
  956. // Alpha channel is JPEG compressed
  957. LoadJpegFromStream(JDAAStream, AlphaImage);
  958. end;
  959. // Check if alpha channel is the same size as image
  960. if (Image.Width <> AlphaImage.Width) and (Image.Height <> AlphaImage.Height) then
  961. ResizeImage(AlphaImage, Image.Width, Image.Height, rfNearest);
  962. // Check alpha channels data format
  963. GetImageFormatInfo(AlphaImage.Format, FmtInfo);
  964. if (FmtInfo.BytesPerPixel > 1) or (not FmtInfo.HasGrayChannel) then
  965. ConvertImage(AlphaImage, ifGray8);
  966. // Convert image to fromat with alpha channel
  967. if Image.Format = ifGray8 then
  968. ConvertImage(Image, ifA8Gray8)
  969. else
  970. ConvertImage(Image, ifA8R8G8B8);
  971. // Combine alpha channel with image
  972. AlphaPtr := AlphaImage.Bits;
  973. if Image.Format = ifA8Gray8 then
  974. begin
  975. GrayPtr := Image.Bits;
  976. for I := 0 to Image.Width * Image.Height - 1 do
  977. begin
  978. GrayPtr.High := AlphaPtr^;
  979. Inc(GrayPtr);
  980. Inc(AlphaPtr);
  981. end;
  982. end
  983. else
  984. begin
  985. ColorPtr := Image.Bits;
  986. for I := 0 to Image.Width * Image.Height - 1 do
  987. begin
  988. ColorPtr.A := AlphaPtr^;
  989. Inc(ColorPtr);
  990. Inc(AlphaPtr);
  991. end;
  992. end;
  993. FreeImage(AlphaImage);
  994. end;
  995. end;
  996. {$ENDIF}
  997. procedure TNGFileLoader.ApplyFrameSettings(Frame: TFrameInfo; var Image: TImageData);
  998. var
  999. FmtInfo: TImageFormatInfo;
  1000. BackGroundColor: TColor64Rec;
  1001. ColorKey: TColor64Rec;
  1002. Alphas: PByteArray;
  1003. AlphasSize: LongInt;
  1004. IsColorKeyPresent: Boolean;
  1005. IsBackGroundPresent: Boolean;
  1006. IsColorFormat: Boolean;
  1007. procedure ConverttRNS;
  1008. begin
  1009. if FmtInfo.IsIndexed then
  1010. begin
  1011. if Alphas = nil then
  1012. begin
  1013. GetMem(Alphas, Frame.TransparencySize);
  1014. Move(Frame.Transparency^, Alphas^, Frame.TransparencySize);
  1015. AlphasSize := Frame.TransparencySize;
  1016. end;
  1017. end
  1018. else
  1019. if not FmtInfo.HasAlphaChannel then
  1020. begin
  1021. FillChar(ColorKey, SizeOf(ColorKey), 0);
  1022. Move(Frame.Transparency^, ColorKey, Min(Frame.TransparencySize, SizeOf(ColorKey)));
  1023. if IsColorFormat then
  1024. SwapValues(ColorKey.R, ColorKey.B);
  1025. SwapEndianWord(@ColorKey, 3);
  1026. // 1/2/4 bit images were converted to 8 bit so we must convert color key too
  1027. if (not Frame.IsJNG) and (Frame.IHDR.ColorType in [0, 4]) then
  1028. case Frame.IHDR.BitDepth of
  1029. 1: ColorKey.B := Word(ColorKey.B * 255);
  1030. 2: ColorKey.B := Word(ColorKey.B * 85);
  1031. 4: ColorKey.B := Word(ColorKey.B * 17);
  1032. end;
  1033. IsColorKeyPresent := True;
  1034. end;
  1035. end;
  1036. procedure ConvertbKGD;
  1037. begin
  1038. FillChar(BackGroundColor, SizeOf(BackGroundColor), 0);
  1039. Move(Frame.Background^, BackGroundColor, Min(Frame.BackgroundSize,
  1040. SizeOf(BackGroundColor)));
  1041. if IsColorFormat then
  1042. SwapValues(BackGroundColor.R, BackGroundColor.B);
  1043. SwapEndianWord(@BackGroundColor, 3);
  1044. // 1/2/4 bit images were converted to 8 bit so we must convert back color too
  1045. if (not Frame.IsJNG) and (Frame.IHDR.ColorType in [0, 4]) then
  1046. case Frame.IHDR.BitDepth of
  1047. 1: BackGroundColor.B := Word(BackGroundColor.B * 255);
  1048. 2: BackGroundColor.B := Word(BackGroundColor.B * 85);
  1049. 4: BackGroundColor.B := Word(BackGroundColor.B * 17);
  1050. end;
  1051. IsBackGroundPresent := True;
  1052. end;
  1053. procedure ReconstructPalette;
  1054. var
  1055. I: LongInt;
  1056. begin
  1057. with Image do
  1058. begin
  1059. GetMem(Palette, FmtInfo.PaletteEntries * SizeOf(TColor32Rec));
  1060. FillChar(Palette^, FmtInfo.PaletteEntries * SizeOf(TColor32Rec), $FF);
  1061. // if RGB palette was loaded from file then use it
  1062. if Frame.Palette <> nil then
  1063. for I := 0 to Min(Frame.PaletteEntries, FmtInfo.PaletteEntries) - 1 do
  1064. with Palette[I] do
  1065. begin
  1066. R := Frame.Palette[I].B;
  1067. G := Frame.Palette[I].G;
  1068. B := Frame.Palette[I].R;
  1069. end;
  1070. // if palette alphas were loaded from file then use them
  1071. if Alphas <> nil then
  1072. for I := 0 to Min(AlphasSize, FmtInfo.PaletteEntries) - 1 do
  1073. Palette[I].A := Alphas[I];
  1074. end;
  1075. end;
  1076. procedure ApplyColorKey;
  1077. var
  1078. DestFmt: TImageFormat;
  1079. OldPixel, NewPixel: Pointer;
  1080. begin
  1081. case Image.Format of
  1082. ifGray8: DestFmt := ifA8Gray8;
  1083. ifGray16: DestFmt := ifA16Gray16;
  1084. ifR8G8B8: DestFmt := ifA8R8G8B8;
  1085. ifR16G16B16: DestFmt := ifA16R16G16B16;
  1086. else
  1087. DestFmt := ifUnknown;
  1088. end;
  1089. if DestFmt <> ifUnknown then
  1090. begin
  1091. if not IsBackGroundPresent then
  1092. BackGroundColor := ColorKey;
  1093. ConvertImage(Image, DestFmt);
  1094. OldPixel := @ColorKey;
  1095. NewPixel := @BackGroundColor;
  1096. // Now back color and color key must be converted to image's data format, looks ugly
  1097. case Image.Format of
  1098. ifA8Gray8:
  1099. begin
  1100. TColor32Rec(TInt64Rec(ColorKey).Low).B := Byte(ColorKey.B);
  1101. TColor32Rec(TInt64Rec(ColorKey).Low).G := $FF;
  1102. TColor32Rec(TInt64Rec(BackGroundColor).Low).B := Byte(BackGroundColor.B);
  1103. end;
  1104. ifA16Gray16:
  1105. begin
  1106. ColorKey.G := $FFFF;
  1107. end;
  1108. ifA8R8G8B8:
  1109. begin
  1110. TColor32Rec(TInt64Rec(ColorKey).Low).R := Byte(ColorKey.R);
  1111. TColor32Rec(TInt64Rec(ColorKey).Low).G := Byte(ColorKey.G);
  1112. TColor32Rec(TInt64Rec(ColorKey).Low).B := Byte(ColorKey.B);
  1113. TColor32Rec(TInt64Rec(ColorKey).Low).A := $FF;
  1114. TColor32Rec(TInt64Rec(BackGroundColor).Low).R := Byte(BackGroundColor.R);
  1115. TColor32Rec(TInt64Rec(BackGroundColor).Low).G := Byte(BackGroundColor.G);
  1116. TColor32Rec(TInt64Rec(BackGroundColor).Low).B := Byte(BackGroundColor.B);
  1117. end;
  1118. ifA16R16G16B16:
  1119. begin
  1120. ColorKey.A := $FFFF;
  1121. end;
  1122. end;
  1123. ReplaceColor(Image, 0, 0, Image.Width, Image.Height, OldPixel, NewPixel);
  1124. end;
  1125. end;
  1126. begin
  1127. Alphas := nil;
  1128. IsColorKeyPresent := False;
  1129. IsBackGroundPresent := False;
  1130. GetImageFormatInfo(Image.Format, FmtInfo);
  1131. IsColorFormat := (Frame.IsJNG and (Frame.JHDR.ColorType in [10, 14])) or
  1132. (not Frame.IsJNG and (Frame.IHDR.ColorType in [2, 6]));
  1133. // Convert some chunk data to useful format
  1134. if Frame.Transparency <> nil then
  1135. ConverttRNS;
  1136. if Frame.Background <> nil then
  1137. ConvertbKGD;
  1138. // Build palette for indexed images
  1139. if FmtInfo.IsIndexed then
  1140. ReconstructPalette;
  1141. // Apply color keying
  1142. if IsColorKeyPresent and not FmtInfo.HasAlphaChannel then
  1143. ApplyColorKey;
  1144. FreeMemNil(Alphas);
  1145. end;
  1146. { TNGFileSaver class implementation }
  1147. procedure TNGFileSaver.StoreImageToPNGFrame(const IHDR: TIHDR; Bits: Pointer;
  1148. FmtInfo: TImageFormatInfo; IDATStream: TMemoryStream);
  1149. var
  1150. TotalBuffer, CompBuffer, ZeroLine, PrevLine: Pointer;
  1151. FilterLines: array[0..4] of PByteArray;
  1152. TotalSize, CompSize, I, BytesPerLine, BytesPerPixel: LongInt;
  1153. Filter: Byte;
  1154. Adaptive: Boolean;
  1155. procedure FilterScanline(Filter: Byte; BytesPerPixel: LongInt; Line, PrevLine, Target: PByteArray);
  1156. var
  1157. I: LongInt;
  1158. begin
  1159. case Filter of
  1160. 0:
  1161. begin
  1162. // No filter
  1163. Move(Line^, Target^, BytesPerLine);
  1164. end;
  1165. 1:
  1166. begin
  1167. // Sub filter
  1168. Move(Line^, Target^, BytesPerPixel);
  1169. for I := BytesPerPixel to BytesPerLine - 1 do
  1170. Target[I] := (Line[I] - Line[I - BytesPerPixel]) and $FF;
  1171. end;
  1172. 2:
  1173. begin
  1174. // Up filter
  1175. for I := 0 to BytesPerLine - 1 do
  1176. Target[I] := (Line[I] - PrevLine[I]) and $FF;
  1177. end;
  1178. 3:
  1179. begin
  1180. // Average filter
  1181. for I := 0 to BytesPerPixel - 1 do
  1182. Target[I] := (Line[I] - PrevLine[I] shr 1) and $FF;
  1183. for I := BytesPerPixel to BytesPerLine - 1 do
  1184. Target[I] := (Line[I] - (Line[I - BytesPerPixel] + PrevLine[I]) shr 1) and $FF;
  1185. end;
  1186. 4:
  1187. begin
  1188. // Paeth filter
  1189. for I := 0 to BytesPerPixel - 1 do
  1190. Target[I] := (Line[I] - PaethPredictor(0, PrevLine[I], 0)) and $FF;
  1191. for I := BytesPerPixel to BytesPerLine - 1 do
  1192. Target[I] := (Line[I] - PaethPredictor(Line[I - BytesPerPixel], PrevLine[I], PrevLine[I - BytesPerPixel])) and $FF;
  1193. end;
  1194. end;
  1195. end;
  1196. procedure AdaptiveFilter(var Filter: Byte; BytesPerPixel: LongInt; Line, PrevLine, Target: PByteArray);
  1197. var
  1198. I, J, BestTest: LongInt;
  1199. Sums: array[0..4] of LongInt;
  1200. begin
  1201. // Compute the output scanline using all five filters,
  1202. // and select the filter that gives the smallest sum of
  1203. // absolute values of outputs
  1204. FillChar(Sums, SizeOf(Sums), 0);
  1205. BestTest := MaxInt;
  1206. for I := 0 to 4 do
  1207. begin
  1208. FilterScanline(I, BytesPerPixel, Line, PrevLine, FilterLines[I]);
  1209. for J := 0 to BytesPerLine - 1 do
  1210. Sums[I] := Sums[I] + Abs(ShortInt(FilterLines[I][J]));
  1211. if Sums[I] < BestTest then
  1212. begin
  1213. Filter := I;
  1214. BestTest := Sums[I];
  1215. end;
  1216. end;
  1217. Move(FilterLines[Filter]^, Target^, BytesPerLine);
  1218. end;
  1219. begin
  1220. // Select precompression filter and compression level
  1221. Adaptive := False;
  1222. Filter := 0;
  1223. case PreFilter of
  1224. 6:
  1225. if not ((IHDR.BitDepth < 8) or (IHDR.ColorType = 3))
  1226. then Adaptive := True;
  1227. 0..4: Filter := PreFilter;
  1228. else
  1229. if IHDR.ColorType in [2, 6] then
  1230. Filter := 4
  1231. end;
  1232. // Prepare data for compression
  1233. CompBuffer := nil;
  1234. FillChar(FilterLines, SizeOf(FilterLines), 0);
  1235. BytesPerPixel := FmtInfo.BytesPerPixel;
  1236. BytesPerLine := LongInt(IHDR.Width) * BytesPerPixel;
  1237. TotalSize := (BytesPerLine + 1) * LongInt(IHDR.Height);
  1238. GetMem(TotalBuffer, TotalSize);
  1239. GetMem(ZeroLine, BytesPerLine);
  1240. FillChar(ZeroLine^, BytesPerLine, 0);
  1241. if Adaptive then
  1242. for I := 0 to 4 do
  1243. GetMem(FilterLines[I], BytesPerLine);
  1244. PrevLine := ZeroLine;
  1245. try
  1246. // Process next scanlines
  1247. for I := 0 to IHDR.Height - 1 do
  1248. begin
  1249. // Filter scanline
  1250. if Adaptive then
  1251. AdaptiveFilter(Filter, BytesPerPixel, @PByteArray(Bits)[I * BytesPerLine],
  1252. PrevLine, @PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1])
  1253. else
  1254. FilterScanline(Filter, BytesPerPixel, @PByteArray(Bits)[I * BytesPerLine],
  1255. PrevLine, @PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1]);
  1256. PrevLine := @PByteArray(Bits)[I * BytesPerLine];
  1257. // Swap red and blue if necessary
  1258. if (IHDR.ColorType in [2, 6]) and not FmtInfo.IsRBSwapped then
  1259. SwapRGB(@PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1],
  1260. IHDR.Width, IHDR.BitDepth, FmtInfo.BytesPerPixel);
  1261. // Images with 16 bit channels must be swapped because of PNG's big endianess
  1262. if IHDR.BitDepth = 16 then
  1263. SwapEndianWord(@PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1],
  1264. BytesPerLine div SizeOf(Word));
  1265. // Set filter used for this scanline
  1266. PByteArray(TotalBuffer)[I * (BytesPerLine + 1)] := Filter;
  1267. end;
  1268. // Compress IDAT data
  1269. CompressBuf(TotalBuffer, TotalSize, CompBuffer, CompSize, CompressLevel);
  1270. // Write IDAT data to stream
  1271. IDATStream.WriteBuffer(CompBuffer^, CompSize);
  1272. finally
  1273. FreeMem(TotalBuffer);
  1274. FreeMem(CompBuffer);
  1275. FreeMem(ZeroLine);
  1276. if Adaptive then
  1277. for I := 0 to 4 do
  1278. FreeMem(FilterLines[I]);
  1279. end;
  1280. end;
  1281. {$IFDEF LINK_JNG}
  1282. procedure TNGFileSaver.StoreImageToJNGFrame(const JHDR: TJHDR;
  1283. const Image: TImageData; IDATStream, JDATStream,
  1284. JDAAStream: TMemoryStream);
  1285. var
  1286. ColorImage, AlphaImage: TImageData;
  1287. FmtInfo: TImageFormatInfo;
  1288. AlphaPtr: PByte;
  1289. GrayPtr: PWordRec;
  1290. ColorPtr: PColor32Rec;
  1291. I: LongInt;
  1292. FakeIHDR: TIHDR;
  1293. procedure SaveJpegToStream(Stream: TStream; const Image: TImageData);
  1294. var
  1295. JpegFormat: TCustomIOJpegFileFormat;
  1296. Handle: TImagingHandle;
  1297. DynImages: TDynImageDataArray;
  1298. begin
  1299. JpegFormat := TCustomIOJpegFileFormat.Create;
  1300. JpegFormat.SetCustomIO(StreamIO);
  1301. // Only JDAT stream can be saved progressive
  1302. if Stream = JDATStream then
  1303. JpegFormat.FProgressive := Progressive
  1304. else
  1305. JpegFormat.FProgressive := False;
  1306. JpegFormat.FQuality := Quality;
  1307. SetLength(DynImages, 1);
  1308. DynImages[0] := Image;
  1309. Handle := StreamIO.OpenWrite(Pointer(Stream));
  1310. try
  1311. JpegFormat.SaveData(Handle, DynImages, 0);
  1312. finally
  1313. StreamIO.Close(Handle);
  1314. SetLength(DynImages, 0);
  1315. JpegFormat.Free;
  1316. end;
  1317. end;
  1318. begin
  1319. GetImageFormatInfo(Image.Format, FmtInfo);
  1320. InitImage(ColorImage);
  1321. InitImage(AlphaImage);
  1322. if FmtInfo.HasAlphaChannel then
  1323. begin
  1324. // Create new image for alpha channel and color image without alpha
  1325. CloneImage(Image, ColorImage);
  1326. NewImage(Image.Width, Image.Height, ifGray8, AlphaImage);
  1327. case Image.Format of
  1328. ifA8Gray8: ConvertImage(ColorImage, ifGray8);
  1329. ifA8R8G8B8: ConvertImage(ColorImage, ifR8G8B8);
  1330. end;
  1331. // Store source image's alpha to separate image
  1332. AlphaPtr := AlphaImage.Bits;
  1333. if Image.Format = ifA8Gray8 then
  1334. begin
  1335. GrayPtr := Image.Bits;
  1336. for I := 0 to Image.Width * Image.Height - 1 do
  1337. begin
  1338. AlphaPtr^ := GrayPtr.High;
  1339. Inc(GrayPtr);
  1340. Inc(AlphaPtr);
  1341. end;
  1342. end
  1343. else
  1344. begin
  1345. ColorPtr := Image.Bits;
  1346. for I := 0 to Image.Width * Image.Height - 1 do
  1347. begin
  1348. AlphaPtr^ := ColorPtr.A;
  1349. Inc(ColorPtr);
  1350. Inc(AlphaPtr);
  1351. end;
  1352. end;
  1353. // Write color image to stream as JPEG
  1354. SaveJpegToStream(JDATStream, ColorImage);
  1355. if LossyAlpha then
  1356. begin
  1357. // Write alpha image to stream as JPEG
  1358. SaveJpegToStream(JDAAStream, AlphaImage);
  1359. end
  1360. else
  1361. begin
  1362. // Alpha channel is PNG compressed
  1363. FakeIHDR.Width := JHDR.Width;
  1364. FakeIHDR.Height := JHDR.Height;
  1365. FakeIHDR.ColorType := 0;
  1366. FakeIHDR.BitDepth := JHDR.AlphaSampleDepth;
  1367. FakeIHDR.Filter := JHDR.AlphaFilter;
  1368. FakeIHDR.Interlacing := JHDR.AlphaInterlacing;
  1369. GetImageFormatInfo(AlphaImage.Format, FmtInfo);
  1370. StoreImageToPNGFrame(FakeIHDR, AlphaImage.Bits, FmtInfo, IDATStream);
  1371. end;
  1372. FreeImage(ColorImage);
  1373. FreeImage(AlphaImage);
  1374. end
  1375. else
  1376. begin
  1377. // Simply write JPEG to stream
  1378. SaveJpegToStream(JDATStream, Image);
  1379. end;
  1380. end;
  1381. {$ENDIF}
  1382. procedure TNGFileSaver.AddFrame(const Image: TImageData; IsJNG: Boolean);
  1383. var
  1384. Frame: TFrameInfo;
  1385. FmtInfo: TImageFormatInfo;
  1386. procedure StorePalette;
  1387. var
  1388. Pal: PPalette24;
  1389. Alphas: PByteArray;
  1390. I, PalBytes: LongInt;
  1391. AlphasDiffer: Boolean;
  1392. begin
  1393. // Fill and save RGB part of palette to PLTE chunk
  1394. PalBytes := FmtInfo.PaletteEntries * SizeOf(TColor24Rec);
  1395. GetMem(Pal, PalBytes);
  1396. AlphasDiffer := False;
  1397. for I := 0 to FmtInfo.PaletteEntries - 1 do
  1398. begin
  1399. Pal[I].B := Image.Palette[I].R;
  1400. Pal[I].G := Image.Palette[I].G;
  1401. Pal[I].R := Image.Palette[I].B;
  1402. if Image.Palette[I].A < 255 then
  1403. AlphasDiffer := True;
  1404. end;
  1405. Frame.Palette := Pal;
  1406. Frame.PaletteEntries := FmtInfo.PaletteEntries;
  1407. // Fill and save alpha part (if there are any alphas < 255) of palette to tRNS chunk
  1408. if AlphasDiffer then
  1409. begin
  1410. PalBytes := FmtInfo.PaletteEntries * SizeOf(Byte);
  1411. GetMem(Alphas, PalBytes);
  1412. for I := 0 to FmtInfo.PaletteEntries - 1 do
  1413. Alphas[I] := Image.Palette[I].A;
  1414. Frame.Transparency := Alphas;
  1415. Frame.TransparencySize := PalBytes;
  1416. end;
  1417. end;
  1418. begin
  1419. // Add new frame
  1420. Frame := AddFrameInfo;
  1421. Frame.IsJNG := IsJNG;
  1422. with Frame do
  1423. begin
  1424. GetImageFormatInfo(Image.Format, FmtInfo);
  1425. if IsJNG then
  1426. begin
  1427. {$IFDEF LINK_JNG}
  1428. // Fill JNG header
  1429. JHDR.Width := Image.Width;
  1430. JHDR.Height := Image.Height;
  1431. case Image.Format of
  1432. ifGray8: JHDR.ColorType := 8;
  1433. ifR8G8B8: JHDR.ColorType := 10;
  1434. ifA8Gray8: JHDR.ColorType := 12;
  1435. ifA8R8G8B8: JHDR.ColorType := 14;
  1436. end;
  1437. JHDR.SampleDepth := 8; // 8-bit samples and quantization tables
  1438. JHDR.Compression := 8; // Huffman coding
  1439. JHDR.Interlacing := Iff(Progressive, 8, 0);
  1440. JHDR.AlphaSampleDepth := Iff(FmtInfo.HasAlphaChannel, 8, 0);
  1441. JHDR.AlphaCompression := Iff(LossyAlpha, 8, 0);
  1442. JHDR.AlphaFilter := 0;
  1443. JHDR.AlphaInterlacing := 0;
  1444. StoreImageToJNGFrame(JHDR, Image, IDATMemory, JDATMemory, JDAAMemory);
  1445. // Finally swap endian
  1446. SwapEndianLongWord(@JHDR, 2);
  1447. {$ENDIF}
  1448. end
  1449. else
  1450. begin
  1451. // Fill PNG header
  1452. IHDR.Width := Image.Width;
  1453. IHDR.Height := Image.Height;
  1454. IHDR.Compression := 0;
  1455. IHDR.Filter := 0;
  1456. IHDR.Interlacing := 0;
  1457. IHDR.BitDepth := FmtInfo.BytesPerPixel * 8;
  1458. // Select appropiate PNG color type and modify bitdepth
  1459. if FmtInfo.HasGrayChannel then
  1460. begin
  1461. IHDR.ColorType := 0;
  1462. if FmtInfo.HasAlphaChannel then
  1463. begin
  1464. IHDR.ColorType := 4;
  1465. IHDR.BitDepth := IHDR.BitDepth div 2;
  1466. end;
  1467. end
  1468. else
  1469. if FmtInfo.IsIndexed then
  1470. IHDR.ColorType := 3
  1471. else
  1472. if FmtInfo.HasAlphaChannel then
  1473. begin
  1474. IHDR.ColorType := 6;
  1475. IHDR.BitDepth := IHDR.BitDepth div 4;
  1476. end
  1477. else
  1478. begin
  1479. IHDR.ColorType := 2;
  1480. IHDR.BitDepth := IHDR.BitDepth div 3;
  1481. end;
  1482. // Compress PNG image and store it to stream
  1483. StoreImageToPNGFrame(IHDR, Image.Bits, FmtInfo, IDATMemory);
  1484. // Store palette if necesary
  1485. if FmtInfo.IsIndexed then
  1486. StorePalette;
  1487. // Finally swap endian
  1488. SwapEndianLongWord(@IHDR, 2);
  1489. end;
  1490. end;
  1491. end;
  1492. function TNGFileSaver.SaveFile(Handle: TImagingHandle): Boolean;
  1493. var
  1494. I: LongInt;
  1495. Chunk: TChunkHeader;
  1496. function CalcChunkCrc(const ChunkHdr: TChunkHeader; Data: Pointer;
  1497. Size: LongInt): LongWord;
  1498. begin
  1499. Result := $FFFFFFFF;
  1500. CalcCrc32(Result, @ChunkHdr.ChunkID, SizeOf(ChunkHdr.ChunkID));
  1501. CalcCrc32(Result, Data, Size);
  1502. Result := SwapEndianLongWord(Result xor $FFFFFFFF);
  1503. end;
  1504. procedure WriteChunk(var Chunk: TChunkHeader; ChunkData: Pointer);
  1505. var
  1506. ChunkCrc: LongWord;
  1507. SizeToWrite: LongInt;
  1508. begin
  1509. SizeToWrite := Chunk.DataSize;
  1510. Chunk.DataSize := SwapEndianLongWord(Chunk.DataSize);
  1511. ChunkCrc := CalcChunkCrc(Chunk, ChunkData, SizeToWrite);
  1512. GetIO.Write(Handle, @Chunk, SizeOf(Chunk));
  1513. if SizeToWrite <> 0 then
  1514. GetIO.Write(Handle, ChunkData, SizeToWrite);
  1515. GetIO.Write(Handle, @ChunkCrc, SizeOf(ChunkCrc));
  1516. end;
  1517. begin
  1518. Result := False;
  1519. begin
  1520. case FileType of
  1521. ngPNG: GetIO.Write(Handle, @PNGSignature, SizeOf(TChar8));
  1522. ngMNG: GetIO.Write(Handle, @MNGSignature, SizeOf(TChar8));
  1523. ngJNG: GetIO.Write(Handle, @JNGSignature, SizeOf(TChar8));
  1524. end;
  1525. if FileType = ngMNG then
  1526. begin
  1527. SwapEndianLongWord(@MHDR, SizeOf(MHDR) div SizeOf(LongWord));
  1528. Chunk.DataSize := SizeOf(MHDR);
  1529. Chunk.ChunkID := MHDRChunk;
  1530. WriteChunk(Chunk, @MHDR);
  1531. end;
  1532. for I := 0 to Length(Frames) - 1 do
  1533. with Frames[I] do
  1534. begin
  1535. if IsJNG then
  1536. begin
  1537. // Write JHDR chunk
  1538. Chunk.DataSize := SizeOf(JHDR);
  1539. Chunk.ChunkID := JHDRChunk;
  1540. WriteChunk(Chunk, @JHDR);
  1541. // Write JNG image data
  1542. Chunk.DataSize := JDATMemory.Size;
  1543. Chunk.ChunkID := JDATChunk;
  1544. WriteChunk(Chunk, JDATMemory.Memory);
  1545. // Write alpha channel if present
  1546. if JHDR.AlphaSampleDepth > 0 then
  1547. begin
  1548. if JHDR.AlphaCompression = 0 then
  1549. begin
  1550. // ALpha is PNG compressed
  1551. Chunk.DataSize := IDATMemory.Size;
  1552. Chunk.ChunkID := IDATChunk;
  1553. WriteChunk(Chunk, IDATMemory.Memory);
  1554. end
  1555. else
  1556. begin
  1557. // Alpha is JNG compressed
  1558. Chunk.DataSize := JDAAMemory.Size;
  1559. Chunk.ChunkID := JDAAChunk;
  1560. WriteChunk(Chunk, JDAAMemory.Memory);
  1561. end;
  1562. end;
  1563. // Write image end
  1564. Chunk.DataSize := 0;
  1565. Chunk.ChunkID := IENDChunk;
  1566. WriteChunk(Chunk, nil);
  1567. end
  1568. else
  1569. begin
  1570. // Write IHDR chunk
  1571. Chunk.DataSize := SizeOf(IHDR);
  1572. Chunk.ChunkID := IHDRChunk;
  1573. WriteChunk(Chunk, @IHDR);
  1574. // Write PLTE chunk if data is present
  1575. if Palette <> nil then
  1576. begin
  1577. Chunk.DataSize := PaletteEntries * SizeOf(TColor24Rec);
  1578. Chunk.ChunkID := PLTEChunk;
  1579. WriteChunk(Chunk, Palette);
  1580. end;
  1581. // Write tRNS chunk if data is present
  1582. if Transparency <> nil then
  1583. begin
  1584. Chunk.DataSize := TransparencySize;
  1585. Chunk.ChunkID := tRNSChunk;
  1586. WriteChunk(Chunk, Transparency);
  1587. end;
  1588. // Write PNG image data
  1589. Chunk.DataSize := IDATMemory.Size;
  1590. Chunk.ChunkID := IDATChunk;
  1591. WriteChunk(Chunk, IDATMemory.Memory);
  1592. // Write image end
  1593. Chunk.DataSize := 0;
  1594. Chunk.ChunkID := IENDChunk;
  1595. WriteChunk(Chunk, nil);
  1596. end;
  1597. end;
  1598. if FileType = ngMNG then
  1599. begin
  1600. Chunk.DataSize := 0;
  1601. Chunk.ChunkID := MENDChunk;
  1602. WriteChunk(Chunk, nil);
  1603. end;
  1604. end;
  1605. end;
  1606. procedure TNGFileSaver.SetFileOptions(FileFormat: TNetworkGraphicsFileFormat);
  1607. begin
  1608. PreFilter := FileFormat.FPreFilter;
  1609. CompressLevel := FileFormat.FCompressLevel;
  1610. LossyAlpha := FileFormat.FLossyAlpha;
  1611. Quality := FileFormat.FQuality;
  1612. Progressive := FileFormat.FProgressive;
  1613. end;
  1614. { TNetworkGraphicsFileFormat class implementation }
  1615. constructor TNetworkGraphicsFileFormat.Create;
  1616. begin
  1617. inherited Create;
  1618. FCanLoad := True;
  1619. FCanSave := True;
  1620. FIsMultiImageFormat := False;
  1621. FPreFilter := NGDefaultPreFilter;
  1622. FCompressLevel := NGDefaultCompressLevel;
  1623. FLossyAlpha := NGDefaultLossyAlpha;
  1624. FLossyCompression := NGDefaultLossyCompression;
  1625. FQuality := NGDefaultQuality;
  1626. FProgressive := NGDefaultProgressive;
  1627. end;
  1628. procedure TNetworkGraphicsFileFormat.CheckOptionsValidity;
  1629. begin
  1630. // Just check if save options has valid values
  1631. if not (FPreFilter in [0..6]) then
  1632. FPreFilter := NGDefaultPreFilter;
  1633. if not (FCompressLevel in [0..9]) then
  1634. FCompressLevel := NGDefaultCompressLevel;
  1635. if not (FQuality in [1..100]) then
  1636. FQuality := NGDefaultQuality;
  1637. end;
  1638. function TNetworkGraphicsFileFormat.GetSupportedFormats: TImageFormats;
  1639. begin
  1640. if FLossyCompression then
  1641. Result := NGLossyFormats
  1642. else
  1643. Result := NGLosslessFormats;
  1644. end;
  1645. procedure TNetworkGraphicsFileFormat.ConvertToSupported(var Image: TImageData;
  1646. const Info: TImageFormatInfo);
  1647. var
  1648. ConvFormat: TImageFormat;
  1649. begin
  1650. if not FLossyCompression then
  1651. begin
  1652. // Convert formats for lossless compression
  1653. if Info.HasGrayChannel then
  1654. begin
  1655. if Info.HasAlphaChannel then
  1656. begin
  1657. if Info.BytesPerPixel <= 2 then
  1658. // Convert <= 16bit grayscale images with alpha to ifA8Gray8
  1659. ConvFormat := ifA8Gray8
  1660. else
  1661. // Convert > 16bit grayscale images with alpha to ifA16Gray16
  1662. ConvFormat := ifA16Gray16
  1663. end
  1664. else
  1665. // Convert grayscale images without alpha to ifGray16
  1666. ConvFormat := ifGray16;
  1667. end
  1668. else
  1669. if Info.IsFloatingPoint then
  1670. // Convert floating point images to 64 bit ARGB (or RGB if no alpha)
  1671. ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16B16G16R16, ifB16G16R16)
  1672. else if Info.HasAlphaChannel or Info.IsSpecial then
  1673. // Convert all other images with alpha or special images to A8R8G8B8
  1674. ConvFormat := ifA8R8G8B8
  1675. else
  1676. // Convert images without alpha to R8G8B8
  1677. ConvFormat := ifR8G8B8;
  1678. end
  1679. else
  1680. begin
  1681. // Convert formats for lossy compression
  1682. if Info.HasGrayChannel then
  1683. ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8Gray8, ifGray8)
  1684. else
  1685. ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8R8G8B8, ifR8G8B8);
  1686. end;
  1687. ConvertImage(Image, ConvFormat);
  1688. end;
  1689. function TNetworkGraphicsFileFormat.TestFormat(Handle: TImagingHandle): Boolean;
  1690. var
  1691. ReadCount: LongInt;
  1692. Sig: TChar8;
  1693. begin
  1694. Result := False;
  1695. if Handle <> nil then
  1696. with GetIO do
  1697. begin
  1698. FillChar(Sig, SizeOf(Sig), 0);
  1699. ReadCount := Read(Handle, @Sig, SizeOf(Sig));
  1700. Seek(Handle, -ReadCount, smFromCurrent);
  1701. Result := (ReadCount = SizeOf(Sig)) and (Sig = FSignature);
  1702. end;
  1703. end;
  1704. { TPNGFileFormat class implementation }
  1705. constructor TPNGFileFormat.Create;
  1706. begin
  1707. inherited Create;
  1708. FName := SPNGFormatName;
  1709. AddMasks(SPNGMasks);
  1710. FSignature := PNGSignature;
  1711. RegisterOption(ImagingPNGPreFilter, @FPreFilter);
  1712. RegisterOption(ImagingPNGCompressLevel, @FCompressLevel);
  1713. end;
  1714. function TPNGFileFormat.LoadData(Handle: TImagingHandle;
  1715. var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
  1716. var
  1717. NGFileLoader: TNGFileLoader;
  1718. begin
  1719. Result := False;
  1720. NGFileLoader := TNGFileLoader.Create;
  1721. try
  1722. // Use NG file parser to load file
  1723. if NGFileLoader.LoadFile(Handle) and (Length(NGFileLoader.Frames) > 0) then
  1724. with NGFileLoader.Frames[0] do
  1725. begin
  1726. SetLength(Images, 1);
  1727. // Build actual image bits
  1728. if not IsJNG then
  1729. NGFileLoader.LoadImageFromPNGFrame(IHDR, IDATMemory, Images[0]);
  1730. // Build palette, aply color key or background
  1731. NGFileLoader.ApplyFrameSettings(NGFileLoader.Frames[0], Images[0]);
  1732. Result := True;
  1733. end;
  1734. finally
  1735. NGFileLoader.Free;
  1736. end;
  1737. end;
  1738. function TPNGFileFormat.SaveData(Handle: TImagingHandle;
  1739. const Images: TDynImageDataArray; Index: LongInt): Boolean;
  1740. var
  1741. ImageToSave: TImageData;
  1742. MustBeFreed: Boolean;
  1743. NGFileSaver: TNGFileSaver;
  1744. begin
  1745. // Make image PNG compatible, store it in saver, and save it to file
  1746. Result := MakeCompatible(Images[Index], ImageToSave, MustBeFreed);
  1747. if Result then
  1748. begin
  1749. NGFileSaver := TNGFileSaver.Create;
  1750. with NGFileSaver do
  1751. try
  1752. FileType := ngPNG;
  1753. SetFileOptions(Self);
  1754. AddFrame(ImageToSave, False);
  1755. SaveFile(Handle);
  1756. finally
  1757. // Free NG saver and compatible image
  1758. NGFileSaver.Free;
  1759. if MustBeFreed then
  1760. FreeImage(ImageToSave);
  1761. end;
  1762. end;
  1763. end;
  1764. {$IFDEF LINK_MNG}
  1765. { TMNGFileFormat class implementation }
  1766. constructor TMNGFileFormat.Create;
  1767. begin
  1768. inherited Create;
  1769. FName := SMNGFormatName;
  1770. FIsMultiImageFormat := True;
  1771. AddMasks(SMNGMasks);
  1772. FSignature := MNGSignature;
  1773. RegisterOption(ImagingMNGLossyCompression, @FLossyCompression);
  1774. RegisterOption(ImagingMNGLossyAlpha, @FLossyAlpha);
  1775. RegisterOption(ImagingMNGPreFilter, @FPreFilter);
  1776. RegisterOption(ImagingMNGCompressLevel, @FCompressLevel);
  1777. RegisterOption(ImagingMNGQuality, @FQuality);
  1778. RegisterOption(ImagingMNGProgressive, @FProgressive);
  1779. end;
  1780. function TMNGFileFormat.LoadData(Handle: TImagingHandle;
  1781. var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
  1782. var
  1783. NGFileLoader: TNGFileLoader;
  1784. I, Len: LongInt;
  1785. begin
  1786. Result := False;
  1787. NGFileLoader := TNGFileLoader.Create;
  1788. try
  1789. // Use NG file parser to load file
  1790. if NGFileLoader.LoadFile(Handle) then
  1791. begin
  1792. Len := Length(NGFileLoader.Frames);
  1793. if Len > 0 then
  1794. begin
  1795. SetLength(Images, Len);
  1796. for I := 0 to Len - 1 do
  1797. with NGFileLoader.Frames[I] do
  1798. begin
  1799. // Build actual image bits
  1800. if IsJNG then
  1801. NGFileLoader.LoadImageFromJNGFrame(JHDR, IDATMemory, JDATMemory, JDAAMemory, Images[I])
  1802. else
  1803. NGFileLoader.LoadImageFromPNGFrame(IHDR, IDATMemory, Images[I]);
  1804. // Build palette, aply color key or background
  1805. NGFileLoader.ApplyFrameSettings(NGFileLoader.Frames[I], Images[I]);
  1806. end;
  1807. end
  1808. else
  1809. begin
  1810. // Some MNG files (with BASI-IEND streams) dont have actual pixel data
  1811. SetLength(Images, 1);
  1812. with NGFileLoader.MHDR do
  1813. NewImage(FrameWidth, FrameWidth, ifDefault, Images[0]);
  1814. end;
  1815. Result := True;
  1816. end;
  1817. finally
  1818. NGFileLoader.Free;
  1819. end;
  1820. end;
  1821. function TMNGFileFormat.SaveData(Handle: TImagingHandle;
  1822. const Images: TDynImageDataArray; Index: LongInt): Boolean;
  1823. var
  1824. NGFileSaver: TNGFileSaver;
  1825. I, LargestWidth, LargestHeight: LongInt;
  1826. ImageToSave: TImageData;
  1827. MustBeFreed: Boolean;
  1828. begin
  1829. Result := False;
  1830. LargestWidth := 0;
  1831. LargestHeight := 0;
  1832. NGFileSaver := TNGFileSaver.Create;
  1833. NGFileSaver.FileType := ngMNG;
  1834. NGFileSaver.SetFileOptions(Self);
  1835. with NGFileSaver do
  1836. try
  1837. // Store all frames to be saved frames file saver
  1838. for I := FFirstIdx to FLastIdx do
  1839. begin
  1840. if MakeCompatible(Images[I], ImageToSave, MustBeFreed) then
  1841. try
  1842. // Add image as PNG or JNG frame
  1843. AddFrame(ImageToSave, FLossyCompression);
  1844. // Remember largest frame width and height
  1845. LargestWidth := Iff(LargestWidth < ImageToSave.Width, ImageToSave.Width, LargestWidth);
  1846. LargestHeight := Iff(LargestHeight < ImageToSave.Height, ImageToSave.Height, LargestHeight);
  1847. finally
  1848. if MustBeFreed then
  1849. FreeImage(ImageToSave);
  1850. end
  1851. else
  1852. Exit;
  1853. end;
  1854. // Fill MNG header
  1855. MHDR.FrameWidth := LargestWidth;
  1856. MHDR.FrameHeight := LargestHeight;
  1857. MHDR.TicksPerSecond := 0;
  1858. MHDR.NominalLayerCount := 0;
  1859. MHDR.NominalFrameCount := Length(Frames);
  1860. MHDR.NominalPlayTime := 0;
  1861. MHDR.SimplicityProfile := 473; // 111011001 binary, defines MNG-VLC with transparency and JNG support
  1862. // Finally save MNG file
  1863. SaveFile(Handle);
  1864. Result := True;
  1865. finally
  1866. NGFileSaver.Free;
  1867. end;
  1868. end;
  1869. {$ENDIF}
  1870. {$IFDEF LINK_JNG}
  1871. { TJNGFileFormat class implementation }
  1872. constructor TJNGFileFormat.Create;
  1873. begin
  1874. inherited Create;
  1875. FName := SJNGFormatName;
  1876. AddMasks(SJNGMasks);
  1877. FSignature := JNGSignature;
  1878. FLossyCompression := True;
  1879. RegisterOption(ImagingJNGLossyAlpha, @FLossyAlpha);
  1880. RegisterOption(ImagingJNGAlphaPreFilter, @FPreFilter);
  1881. RegisterOption(ImagingJNGAlphaCompressLevel, @FCompressLevel);
  1882. RegisterOption(ImagingJNGQuality, @FQuality);
  1883. RegisterOption(ImagingJNGProgressive, @FProgressive);
  1884. end;
  1885. function TJNGFileFormat.LoadData(Handle: TImagingHandle;
  1886. var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
  1887. var
  1888. NGFileLoader: TNGFileLoader;
  1889. begin
  1890. Result := False;
  1891. NGFileLoader := TNGFileLoader.Create;
  1892. try
  1893. // Use NG file parser to load file
  1894. if NGFileLoader.LoadFile(Handle) and (Length(NGFileLoader.Frames) > 0) then
  1895. with NGFileLoader.Frames[0] do
  1896. begin
  1897. SetLength(Images, 1);
  1898. // Build actual image bits
  1899. if IsJNG then
  1900. NGFileLoader.LoadImageFromJNGFrame(JHDR, IDATMemory, JDATMemory, JDAAMemory, Images[0]);
  1901. // Build palette, aply color key or background
  1902. NGFileLoader.ApplyFrameSettings(NGFileLoader.Frames[0], Images[0]);
  1903. Result := True;
  1904. end;
  1905. finally
  1906. NGFileLoader.Free;
  1907. end;
  1908. end;
  1909. function TJNGFileFormat.SaveData(Handle: TImagingHandle;
  1910. const Images: TDynImageDataArray; Index: LongInt): Boolean;
  1911. var
  1912. NGFileSaver: TNGFileSaver;
  1913. ImageToSave: TImageData;
  1914. MustBeFreed: Boolean;
  1915. begin
  1916. // Make image JNG compatible, store it in saver, and save it to file
  1917. Result := MakeCompatible(Images[Index], ImageToSave, MustBeFreed);
  1918. if Result then
  1919. begin
  1920. NGFileSaver := TNGFileSaver.Create;
  1921. with NGFileSaver do
  1922. try
  1923. FileType := ngJNG;
  1924. SetFileOptions(Self);
  1925. AddFrame(ImageToSave, True);
  1926. SaveFile(Handle);
  1927. finally
  1928. // Free NG saver and compatible image
  1929. NGFileSaver.Free;
  1930. if MustBeFreed then
  1931. FreeImage(ImageToSave);
  1932. end;
  1933. end;
  1934. end;
  1935. {$ENDIF}
  1936. initialization
  1937. RegisterImageFileFormat(TPNGFileFormat);
  1938. {$IFDEF LINK_MNG}
  1939. RegisterImageFileFormat(TMNGFileFormat);
  1940. {$ENDIF}
  1941. {$IFDEF LINK_JNG}
  1942. RegisterImageFileFormat(TJNGFileFormat);
  1943. {$ENDIF}
  1944. finalization
  1945. {
  1946. File Notes:
  1947. -- TODOS ----------------------------------------------------
  1948. - nothing now
  1949. -- 0.24.3 Changes/Bug Fixes ---------------------------------
  1950. - Changes for better thread safety.
  1951. -- 0.23 Changes/Bug Fixes -----------------------------------
  1952. - Added loading of global palettes and transparencies in MNG files
  1953. (and by doing so fixed crash when loading images with global PLTE or tRNS).
  1954. -- 0.21 Changes/Bug Fixes -----------------------------------
  1955. - Small changes in converting to supported formats.
  1956. - MakeCompatible method moved to base class, put ConvertToSupported here.
  1957. GetSupportedFormats removed, it is now set in constructor.
  1958. - Made public properties for options registered to SetOption/GetOption
  1959. functions.
  1960. - Changed extensions to filename masks.
  1961. - Changed SaveData, LoadData, and MakeCompatible methods according
  1962. to changes in base class in Imaging unit.
  1963. -- 0.17 Changes/Bug Fixes -----------------------------------
  1964. - MNG and JNG support added, PNG support redesigned to support NG file handlers
  1965. - added classes for working with NG file formats
  1966. - stuff from old ImagingPng unit added and that unit was deleted
  1967. - unit created and initial stuff added
  1968. -- 0.15 Changes/Bug Fixes -----------------------------------
  1969. - when saving indexed images save alpha to tRNS?
  1970. - added some defines and ifdefs to dzlib unit to allow choosing
  1971. impaszlib, fpc's paszlib, zlibex or other zlib implementation
  1972. - added colorkeying support
  1973. - fixed 16bit channel image handling - pixels were not swapped
  1974. - fixed arithmetic overflow (in paeth filter) in FPC
  1975. - data of unknown chunks are skipped and not needlesly loaded
  1976. -- 0.13 Changes/Bug Fixes -----------------------------------
  1977. - adaptive filtering added to PNG saving
  1978. - TPNGFileFormat class added
  1979. }
  1980. end.