ImagingNetworkGraphics.pas 68 KB

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