ImagingNetworkGraphics.pas 67 KB

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