ImagingNetworkGraphics.pas 64 KB

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