ImagingNetworkGraphics.pas 65 KB

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