Repo for the search and displace ingest module that takes odf, docx and pdf and transforms it into .md to be used with search and displace operations
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

2714 lines
84 KiB

3 years ago
  1. {
  2. Vampyre Imaging Library
  3. by Marek Mauder
  4. http://imaginglib.sourceforge.net
  5. The contents of this file are used with permission, subject to the Mozilla
  6. Public License Version 1.1 (the "License"); you may not use this file except
  7. in compliance with the License. You may obtain a copy of the License at
  8. http://www.mozilla.org/MPL/MPL-1.1.html
  9. Software distributed under the License is distributed on an "AS IS" basis,
  10. WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
  11. the specific language governing rights and limitations under the License.
  12. Alternatively, the contents of this file may be used under the terms of the
  13. GNU Lesser General Public License (the "LGPL License"), in which case the
  14. provisions of the LGPL License are applicable instead of those above.
  15. If you wish to allow use of your version of this file only under the terms
  16. of the LGPL License and not to allow others to use your version of this file
  17. under the MPL, indicate your decision by deleting the provisions above and
  18. replace them with the notice and other provisions required by the LGPL
  19. License. If you do not delete the provisions above, a recipient may use
  20. your version of this file under either the MPL or the LGPL License.
  21. For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
  22. }
  23. { This unit contains image format loaders/savers for Network Graphics image
  24. file formats PNG, MNG, and JNG.}
  25. unit ImagingNetworkGraphics;
  26. interface
  27. {$I ImagingOptions.inc}
  28. { If MNG support is enabled we must make sure PNG and JNG are enabled too.}
  29. {$IFNDEF DONT_LINK_MNG}
  30. {$UNDEF DONT_LINK_PNG}
  31. {$UNDEF DONT_LINK_JNG}
  32. {$ENDIF}
  33. uses
  34. Types, SysUtils, Classes, ImagingTypes, Imaging, ImagingUtility, ImagingFormats, dzlib;
  35. type
  36. { Basic class for Network Graphics file formats loaders/savers.}
  37. TNetworkGraphicsFileFormat = class(TImageFileFormat)
  38. protected
  39. FSignature: TChar8;
  40. FPreFilter: LongInt;
  41. FCompressLevel: LongInt;
  42. FLossyCompression: LongBool;
  43. FLossyAlpha: LongBool;
  44. FQuality: LongInt;
  45. FProgressive: LongBool;
  46. FZLibStategy: Integer;
  47. function GetSupportedFormats: TImageFormats; override;
  48. procedure ConvertToSupported(var Image: TImageData;
  49. const Info: TImageFormatInfo); override;
  50. procedure Define; override;
  51. public
  52. function TestFormat(Handle: TImagingHandle): Boolean; override;
  53. procedure CheckOptionsValidity; override;
  54. published
  55. { Sets precompression filter used when saving images with lossless compression.
  56. Allowed values are: 0 (none), 1 (sub), 2 (up), 3 (average), 4 (paeth),
  57. 5 (use 0 for indexed/gray images and 4 for RGB/ARGB images),
  58. 6 (adaptive filtering - use best filter for each scanline - very slow).
  59. Note that filters 3 and 4 are much slower than filters 1 and 2.
  60. Default value is 5.}
  61. property PreFilter: LongInt read FPreFilter write FPreFilter;
  62. { Sets ZLib compression level used when saving images with lossless compression.
  63. Allowed values are in range 0 (no compresstion) to 9 (best compression).
  64. Default value is 5.}
  65. property CompressLevel: LongInt read FCompressLevel write FCompressLevel;
  66. { Specifies whether MNG animation frames are saved with lossy or lossless
  67. compression. Lossless frames are saved as PNG images and lossy frames are
  68. saved as JNG images. Allowed values are 0 (False) and 1 (True).
  69. Default value is 0.}
  70. property LossyCompression: LongBool read FLossyCompression write FLossyCompression;
  71. { Defines whether alpha channel of lossy MNG frames or JNG images
  72. is lossy compressed too. Allowed values are 0 (False) and 1 (True).
  73. Default value is 0.}
  74. property LossyAlpha: LongBool read FLossyAlpha write FLossyAlpha;
  75. { Specifies compression quality used when saving lossy MNG frames or JNG images.
  76. For details look at ImagingJpegQuality option.}
  77. property Quality: LongInt read FQuality write FQuality;
  78. { Specifies whether images are saved in progressive format when saving lossy
  79. MNG frames or JNG images. For details look at ImagingJpegProgressive.}
  80. property Progressive: LongBool read FProgressive write FProgressive;
  81. end;
  82. { Class for loading Portable Network Graphics Images.
  83. Loads all types of this image format (all images in png test suite)
  84. and saves all types with bitcount >= 8 (non-interlaced only).
  85. Compression level and filtering can be set by options interface.
  86. Supported ancillary chunks (loading):
  87. tRNS, bKGD
  88. (for indexed images transparency contains alpha values for palette,
  89. RGB/Gray images with transparency are converted to formats with alpha
  90. and pixels with transparent color are replaced with background color
  91. with alpha = 0).}
  92. TPNGFileFormat = class(TNetworkGraphicsFileFormat)
  93. private
  94. FLoadAnimated: LongBool;
  95. protected
  96. procedure Define; override;
  97. function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
  98. OnlyFirstLevel: Boolean): Boolean; override;
  99. function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
  100. Index: LongInt): Boolean; override;
  101. published
  102. property LoadAnimated: LongBool read FLoadAnimated write FLoadAnimated;
  103. end;
  104. {$IFNDEF DONT_LINK_MNG}
  105. { Class for loading Multiple Network Graphics files.
  106. This format has complex animation capabilities but Imaging only
  107. extracts frames. Individual frames are stored as standard PNG or JNG
  108. images. Loads all types of these frames stored in IHDR-IEND and
  109. JHDR-IEND streams (Note that there are MNG chunks
  110. like BASI which define images but does not contain image data itself,
  111. those are ignored).
  112. Imaging saves MNG files as MNG-VLC (very low complexity) so it is basicaly
  113. an array of image frames without MNG animation chunks. Frames can be saved
  114. as lossless PNG or lossy JNG images (look at TPNGFileFormat and
  115. TJNGFileFormat for info). Every frame can be in different data format.
  116. Many frame compression settings can be modified by options interface.}
  117. TMNGFileFormat = class(TNetworkGraphicsFileFormat)
  118. protected
  119. procedure Define; override;
  120. function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
  121. OnlyFirstLevel: Boolean): Boolean; override;
  122. function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
  123. Index: LongInt): Boolean; override;
  124. end;
  125. {$ENDIF}
  126. {$IFNDEF DONT_LINK_JNG}
  127. { Class for loading JPEG Network Graphics Images.
  128. Loads all types of this image format (all images in jng test suite)
  129. and saves all types except 12 bit JPEGs.
  130. Alpha channel in JNG images is stored separately from color/gray data and
  131. can be lossy (as JPEG image) or lossless (as PNG image) compressed.
  132. Type of alpha compression, compression level and quality,
  133. and filtering can be set by options interface.
  134. Supported ancillary chunks (loading):
  135. tRNS, bKGD
  136. (Images with transparency are converted to formats with alpha
  137. and pixels with transparent color are replaced with background color
  138. with alpha = 0).}
  139. TJNGFileFormat = class(TNetworkGraphicsFileFormat)
  140. protected
  141. procedure Define; override;
  142. function LoadData(Handle: TImagingHandle; var Images: TDynImageDataArray;
  143. OnlyFirstLevel: Boolean): Boolean; override;
  144. function SaveData(Handle: TImagingHandle; const Images: TDynImageDataArray;
  145. Index: LongInt): Boolean; override;
  146. end;
  147. {$ENDIF}
  148. implementation
  149. uses
  150. {$IFNDEF DONT_LINK_JNG}
  151. ImagingJpeg, ImagingIO,
  152. {$ENDIF}
  153. ImagingCanvases;
  154. const
  155. NGDefaultPreFilter = 5;
  156. NGDefaultCompressLevel = 5;
  157. NGDefaultLossyAlpha = False;
  158. NGDefaultLossyCompression = False;
  159. NGDefaultProgressive = False;
  160. NGDefaultQuality = 90;
  161. NGLosslessFormats: TImageFormats = [ifIndex8, ifGray8, ifA8Gray8, ifGray16,
  162. ifA16Gray16, ifR8G8B8, ifA8R8G8B8, ifR16G16B16, ifA16R16G16B16, ifB16G16R16,
  163. ifA16B16G16R16, ifBinary];
  164. NGLossyFormats: TImageFormats = [ifGray8, ifA8Gray8, ifR8G8B8, ifA8R8G8B8];
  165. PNGDefaultLoadAnimated = True;
  166. NGDefaultZLibStartegy = 1; // Z_FILTERED
  167. SPNGFormatName = 'Portable Network Graphics';
  168. SPNGMasks = '*.png';
  169. SMNGFormatName = 'Multiple Network Graphics';
  170. SMNGMasks = '*.mng';
  171. SJNGFormatName = 'JPEG Network Graphics';
  172. SJNGMasks = '*.jng';
  173. resourcestring
  174. SErrorLoadingChunk = 'Error when reading %s chunk data. File may be corrupted.';
  175. type
  176. { Chunk header.}
  177. TChunkHeader = packed record
  178. DataSize: LongWord;
  179. ChunkID: TChar4;
  180. end;
  181. { IHDR chunk format - PNG header.}
  182. TIHDR = packed record
  183. Width: LongWord; // Image width
  184. Height: LongWord; // Image height
  185. BitDepth: Byte; // Bits per pixel or bits per sample (for truecolor)
  186. ColorType: Byte; // 0 = grayscale, 2 = truecolor, 3 = palette,
  187. // 4 = gray + alpha, 6 = truecolor + alpha
  188. Compression: Byte; // Compression type: 0 = ZLib
  189. Filter: Byte; // Used precompress filter
  190. Interlacing: Byte; // Used interlacing: 0 = no int, 1 = Adam7
  191. end;
  192. PIHDR = ^TIHDR;
  193. { MHDR chunk format - MNG header.}
  194. TMHDR = packed record
  195. FrameWidth: LongWord; // Frame width
  196. FrameHeight: LongWord; // Frame height
  197. TicksPerSecond: LongWord; // FPS of animation
  198. NominalLayerCount: LongWord; // Number of layers in file
  199. NominalFrameCount: LongWord; // Number of frames in file
  200. NominalPlayTime: LongWord; // Play time of animation in ticks
  201. SimplicityProfile: LongWord; // Defines which MNG features are used in this file
  202. end;
  203. PMHDR = ^TMHDR;
  204. { JHDR chunk format - JNG header.}
  205. TJHDR = packed record
  206. Width: LongWord; // Image width
  207. Height: LongWord; // Image height
  208. ColorType: Byte; // 8 = grayscale (Y), 10 = color (YCbCr),
  209. // 12 = gray + alpha (Y-alpha), 14 = color + alpha (YCbCr-alpha)
  210. SampleDepth: Byte; // 8, 12 or 20 (8 and 12 samples together) bit
  211. Compression: Byte; // Compression type: 8 = Huffman coding
  212. Interlacing: Byte; // 0 = single scan, 8 = progressive
  213. AlphaSampleDepth: Byte; // 0, 1, 2, 4, 8, 16 if alpha compression is 0 (PNG)
  214. // 8 if alpha compression is 8 (JNG)
  215. AlphaCompression: Byte; // 0 = PNG graysscale IDAT, 8 = grayscale 8-bit JPEG
  216. AlphaFilter: Byte; // 0 = PNG filter or no filter (JPEG)
  217. AlphaInterlacing: Byte; // 0 = non interlaced
  218. end;
  219. PJHDR = ^TJHDR;
  220. { acTL chunk format - APNG animation control.}
  221. TacTL = packed record
  222. NumFrames: LongWord; // Number of frames
  223. NumPlay: LongWord; // Number of times to loop the animation (0 = inf)
  224. end;
  225. PacTL =^TacTL;
  226. { fcTL chunk format - APNG frame control.}
  227. TfcTL = packed record
  228. SeqNumber: LongWord; // Sequence number of the animation chunk, starting from 0
  229. Width: LongWord; // Width of the following frame
  230. Height: LongWord; // Height of the following frame
  231. XOffset: LongWord; // X position at which to render the following frame
  232. YOffset: LongWord; // Y position at which to render the following frame
  233. DelayNumer: Word; // Frame delay fraction numerator
  234. DelayDenom: Word; // Frame delay fraction denominator
  235. DisposeOp: Byte; // Type of frame area disposal to be done after rendering this frame
  236. BlendOp: Byte; // Type of frame area rendering for this frame
  237. end;
  238. PfcTL = ^TfcTL;
  239. { pHYs chunk format - encodes the absolute or relative dimensions of pixels.}
  240. TpHYs = packed record
  241. PixelsPerUnitX: LongWord;
  242. PixelsPerUnitY: LongWord;
  243. UnitSpecifier: Byte;
  244. end;
  245. PpHYs = ^TpHYs;
  246. const
  247. { PNG file identifier.}
  248. PNGSignature: TChar8 = #$89'PNG'#$0D#$0A#$1A#$0A;
  249. { MNG file identifier.}
  250. MNGSignature: TChar8 = #$8A'MNG'#$0D#$0A#$1A#$0A;
  251. { JNG file identifier.}
  252. JNGSignature: TChar8 = #$8B'JNG'#$0D#$0A#$1A#$0A;
  253. { Constants for chunk identifiers and signature identifiers.
  254. They are in big-endian format.}
  255. IHDRChunk: TChar4 = 'IHDR';
  256. IENDChunk: TChar4 = 'IEND';
  257. MHDRChunk: TChar4 = 'MHDR';
  258. MENDChunk: TChar4 = 'MEND';
  259. JHDRChunk: TChar4 = 'JHDR';
  260. IDATChunk: TChar4 = 'IDAT';
  261. JDATChunk: TChar4 = 'JDAT';
  262. JDAAChunk: TChar4 = 'JDAA';
  263. JSEPChunk: TChar4 = 'JSEP';
  264. PLTEChunk: TChar4 = 'PLTE';
  265. BACKChunk: TChar4 = 'BACK';
  266. DEFIChunk: TChar4 = 'DEFI';
  267. TERMChunk: TChar4 = 'TERM';
  268. tRNSChunk: TChar4 = 'tRNS';
  269. bKGDChunk: TChar4 = 'bKGD';
  270. gAMAChunk: TChar4 = 'gAMA';
  271. acTLChunk: TChar4 = 'acTL';
  272. fcTLChunk: TChar4 = 'fcTL';
  273. fdATChunk: TChar4 = 'fdAT';
  274. pHYsChunk: TChar4 = 'pHYs';
  275. { APNG frame dispose operations.}
  276. DisposeOpNone = 0;
  277. DisposeOpBackground = 1;
  278. DisposeOpPrevious = 2;
  279. { APNG frame blending modes}
  280. BlendOpSource = 0;
  281. BlendOpOver = 1;
  282. { Interlace start and offsets.}
  283. RowStart: array[0..6] of LongInt = (0, 0, 4, 0, 2, 0, 1);
  284. ColumnStart: array[0..6] of LongInt = (0, 4, 0, 2, 0, 1, 0);
  285. RowIncrement: array[0..6] of LongInt = (8, 8, 8, 4, 4, 2, 2);
  286. ColumnIncrement: array[0..6] of LongInt = (8, 8, 4, 4, 2, 2, 1);
  287. type
  288. { Helper class that holds information about MNG frame in PNG or JNG format.}
  289. TFrameInfo = class
  290. public
  291. Index: Integer;
  292. FrameWidth, FrameHeight: LongInt;
  293. IsJpegFrame: Boolean;
  294. IHDR: TIHDR;
  295. JHDR: TJHDR;
  296. fcTL: TfcTL;
  297. pHYs: TpHYs;
  298. Palette: PPalette24;
  299. PaletteEntries: LongInt;
  300. Transparency: Pointer;
  301. TransparencySize: LongInt;
  302. Background: Pointer;
  303. BackgroundSize: LongInt;
  304. IDATMemory: TMemoryStream;
  305. JDATMemory: TMemoryStream;
  306. JDAAMemory: TMemoryStream;
  307. constructor Create(AIndex: Integer);
  308. destructor Destroy; override;
  309. procedure AssignSharedProps(Source: TFrameInfo);
  310. end;
  311. { Defines type of Network Graphics file.}
  312. TNGFileType = (ngPNG, ngAPNG, ngMNG, ngJNG);
  313. TNGFileHandler = class
  314. public
  315. FileFormat: TNetworkGraphicsFileFormat;
  316. FileType: TNGFileType;
  317. Frames: array of TFrameInfo;
  318. MHDR: TMHDR; // Main header for MNG files
  319. acTL: TacTL; // Global anim control for APNG files
  320. GlobalPalette: PPalette24;
  321. GlobalPaletteEntries: LongInt;
  322. GlobalTransparency: Pointer;
  323. GlobalTransparencySize: LongInt;
  324. constructor Create(AFileFormat: TNetworkGraphicsFileFormat);
  325. destructor Destroy; override;
  326. procedure Clear;
  327. function GetLastFrame: TFrameInfo;
  328. function AddFrameInfo: TFrameInfo;
  329. procedure LoadMetaData;
  330. end;
  331. { Network Graphics file parser and frame converter.}
  332. TNGFileLoader = class(TNGFileHandler)
  333. public
  334. function LoadFile(Handle: TImagingHandle): Boolean;
  335. procedure LoadImageFromPNGFrame(FrameWidth, FrameHeight: LongInt; const IHDR: TIHDR; IDATStream: TMemoryStream; var Image: TImageData);
  336. {$IFNDEF DONT_LINK_JNG}
  337. procedure LoadImageFromJNGFrame(FrameWidth, FrameHeight: LongInt; const JHDR: TJHDR; IDATStream, JDATStream, JDAAStream: TMemoryStream; var Image: TImageData);
  338. {$ENDIF}
  339. procedure ApplyFrameSettings(Frame: TFrameInfo; var Image: TImageData);
  340. end;
  341. TNGFileSaver = class(TNGFileHandler)
  342. public
  343. PreFilter: LongInt;
  344. CompressLevel: LongInt;
  345. LossyAlpha: Boolean;
  346. Quality: LongInt;
  347. Progressive: Boolean;
  348. ZLibStrategy: Integer;
  349. function SaveFile(Handle: TImagingHandle): Boolean;
  350. procedure AddFrame(const Image: TImageData; IsJpegFrame: Boolean);
  351. procedure StoreImageToPNGFrame(const IHDR: TIHDR; Bits: Pointer; FmtInfo: TImageFormatInfo; IDATStream: TMemoryStream);
  352. {$IFNDEF DONT_LINK_JNG}
  353. procedure StoreImageToJNGFrame(const JHDR: TJHDR; const Image: TImageData; IDATStream, JDATStream, JDAAStream: TMemoryStream);
  354. {$ENDIF}
  355. procedure SetFileOptions;
  356. end;
  357. {$IFNDEF DONT_LINK_JNG}
  358. TCustomIOJpegFileFormat = class(TJpegFileFormat)
  359. protected
  360. FCustomIO: TIOFunctions;
  361. procedure SetJpegIO(const JpegIO: TIOFunctions); override;
  362. procedure SetCustomIO(const CustomIO: TIOFunctions);
  363. end;
  364. {$ENDIF}
  365. TAPNGAnimator = class
  366. public
  367. class procedure Animate(var Images: TDynImageDataArray; const acTL: TacTL; const SrcFrames: array of TFrameInfo);
  368. end;
  369. { Helper routines }
  370. function PaethPredictor(A, B, C: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
  371. var
  372. P, PA, PB, PC: LongInt;
  373. begin
  374. P := A + B - C;
  375. PA := Abs(P - A);
  376. PB := Abs(P - B);
  377. PC := Abs(P - C);
  378. if (PA <= PB) and (PA <= PC) then
  379. Result := A
  380. else
  381. if PB <= PC then
  382. Result := B
  383. else
  384. Result := C;
  385. end;
  386. procedure SwapRGB(Line: PByte; Width, SampleDepth, BytesPerPixel: LongInt);
  387. var
  388. I: LongInt;
  389. Tmp: Word;
  390. begin
  391. case SampleDepth of
  392. 8:
  393. for I := 0 to Width - 1 do
  394. with PColor24Rec(Line)^ do
  395. begin
  396. Tmp := R;
  397. R := B;
  398. B := Tmp;
  399. Inc(Line, BytesPerPixel);
  400. end;
  401. 16:
  402. for I := 0 to Width - 1 do
  403. with PColor48Rec(Line)^ do
  404. begin
  405. Tmp := R;
  406. R := B;
  407. B := Tmp;
  408. Inc(Line, BytesPerPixel);
  409. end;
  410. end;
  411. end;
  412. {$IFNDEF DONT_LINK_JNG}
  413. { TCustomIOJpegFileFormat class implementation }
  414. procedure TCustomIOJpegFileFormat.SetCustomIO(const CustomIO: TIOFunctions);
  415. begin
  416. FCustomIO := CustomIO;
  417. end;
  418. procedure TCustomIOJpegFileFormat.SetJpegIO(const JpegIO: TIOFunctions);
  419. begin
  420. inherited SetJpegIO(FCustomIO);
  421. end;
  422. {$ENDIF}
  423. { TFrameInfo class implementation }
  424. constructor TFrameInfo.Create(AIndex: Integer);
  425. begin
  426. Index := AIndex;
  427. IDATMemory := TMemoryStream.Create;
  428. JDATMemory := TMemoryStream.Create;
  429. JDAAMemory := TMemoryStream.Create;
  430. end;
  431. destructor TFrameInfo.Destroy;
  432. begin
  433. FreeMem(Palette);
  434. FreeMem(Transparency);
  435. FreeMem(Background);
  436. IDATMemory.Free;
  437. JDATMemory.Free;
  438. JDAAMemory.Free;
  439. inherited Destroy;
  440. end;
  441. procedure TFrameInfo.AssignSharedProps(Source: TFrameInfo);
  442. begin
  443. IHDR := Source.IHDR;
  444. JHDR := Source.JHDR;
  445. PaletteEntries := Source.PaletteEntries;
  446. GetMem(Palette, PaletteEntries * SizeOf(TColor24Rec));
  447. Move(Source.Palette^, Palette^, PaletteEntries * SizeOf(TColor24Rec));
  448. TransparencySize := Source.TransparencySize;
  449. GetMem(Transparency, TransparencySize);
  450. Move(Source.Transparency^, Transparency^, TransparencySize);
  451. end;
  452. { TNGFileHandler class implementation}
  453. destructor TNGFileHandler.Destroy;
  454. begin
  455. Clear;
  456. inherited Destroy;
  457. end;
  458. procedure TNGFileHandler.Clear;
  459. var
  460. I: LongInt;
  461. begin
  462. for I := 0 to Length(Frames) - 1 do
  463. Frames[I].Free;
  464. SetLength(Frames, 0);
  465. FreeMemNil(GlobalPalette);
  466. GlobalPaletteEntries := 0;
  467. FreeMemNil(GlobalTransparency);
  468. GlobalTransparencySize := 0;
  469. end;
  470. constructor TNGFileHandler.Create(AFileFormat: TNetworkGraphicsFileFormat);
  471. begin
  472. FileFormat := AFileFormat;
  473. end;
  474. function TNGFileHandler.GetLastFrame: TFrameInfo;
  475. var
  476. Len: LongInt;
  477. begin
  478. Len := Length(Frames);
  479. if Len > 0 then
  480. Result := Frames[Len - 1]
  481. else
  482. Result := nil;
  483. end;
  484. procedure TNGFileHandler.LoadMetaData;
  485. var
  486. I: Integer;
  487. Delay, Denom: Integer;
  488. begin
  489. if FileType = ngAPNG then
  490. begin
  491. // Num plays of APNG animation
  492. FileFormat.FMetadata.SetMetaItem(SMetaAnimationLoops, acTL.NumPlay);
  493. end;
  494. for I := 0 to High(Frames) do
  495. begin
  496. if Frames[I].pHYs.UnitSpecifier = 1 then
  497. begin
  498. // Store physical pixel dimensions, in PNG stored as pixels per meter DPM
  499. FileFormat.FMetadata.SetPhysicalPixelSize(ruDpm, Frames[I].pHYs.PixelsPerUnitX,
  500. Frames[I].pHYs.PixelsPerUnitY);
  501. end;
  502. if FileType = ngAPNG then
  503. begin
  504. // Store frame delay of APNG file frame
  505. Denom := Frames[I].fcTL.DelayDenom;
  506. if Denom = 0 then
  507. Denom := 100;
  508. Delay := Round(1000 * (Frames[I].fcTL.DelayNumer / Denom));
  509. FileFormat.FMetadata.SetMetaItem(SMetaFrameDelay, Delay, I);
  510. end;
  511. end;
  512. end;
  513. function TNGFileHandler.AddFrameInfo: TFrameInfo;
  514. var
  515. Len: LongInt;
  516. begin
  517. Len := Length(Frames);
  518. SetLength(Frames, Len + 1);
  519. Result := TFrameInfo.Create(Len);
  520. Frames[Len] := Result;
  521. end;
  522. { TNGFileLoader class implementation}
  523. function TNGFileLoader.LoadFile(Handle: TImagingHandle): Boolean;
  524. var
  525. Sig: TChar8;
  526. Chunk: TChunkHeader;
  527. ChunkData: Pointer;
  528. ChunkCrc: LongWord;
  529. procedure ReadChunk;
  530. begin
  531. GetIO.Read(Handle, @Chunk, SizeOf(Chunk));
  532. Chunk.DataSize := SwapEndianLongWord(Chunk.DataSize);
  533. end;
  534. procedure ReadChunkData;
  535. var
  536. ReadBytes: LongWord;
  537. begin
  538. FreeMemNil(ChunkData);
  539. GetMem(ChunkData, Chunk.DataSize);
  540. ReadBytes := GetIO.Read(Handle, ChunkData, Chunk.DataSize);
  541. GetIO.Read(Handle, @ChunkCrc, SizeOf(ChunkCrc));
  542. if ReadBytes <> Chunk.DataSize then
  543. RaiseImaging(SErrorLoadingChunk, [string(Chunk.ChunkID)]);
  544. end;
  545. procedure SkipChunkData;
  546. begin
  547. GetIO.Seek(Handle, Chunk.DataSize + SizeOf(ChunkCrc), smFromCurrent);
  548. end;
  549. procedure StartNewPNGImage;
  550. var
  551. Frame: TFrameInfo;
  552. begin
  553. ReadChunkData;
  554. if Chunk.ChunkID = fcTLChunk then
  555. begin
  556. if (Length(Frames) = 1) and (Frames[0].IDATMemory.Size = 0) then
  557. begin
  558. // First fcTL chunk maybe for first IDAT frame which is alredy created
  559. Frame := Frames[0];
  560. end
  561. else
  562. begin
  563. // Subsequent APNG frames with data in fdAT
  564. Frame := AddFrameInfo;
  565. // Copy some shared props from first frame (IHDR is the same for all APNG frames, palette etc)
  566. Frame.AssignSharedProps(Frames[0]);
  567. end;
  568. Frame.fcTL := PfcTL(ChunkData)^;
  569. SwapEndianLongWord(@Frame.fcTL, 5);
  570. Frame.fcTL.DelayNumer := SwapEndianWord(Frame.fcTL.DelayNumer);
  571. Frame.fcTL.DelayDenom := SwapEndianWord(Frame.fcTL.DelayDenom);
  572. Frame.FrameWidth := Frame.fcTL.Width;
  573. Frame.FrameHeight := Frame.fcTL.Height;
  574. end
  575. else
  576. begin
  577. // This is frame defined by IHDR chunk
  578. Frame := AddFrameInfo;
  579. Frame.IHDR := PIHDR(ChunkData)^;
  580. SwapEndianLongWord(@Frame.IHDR, 2);
  581. Frame.FrameWidth := Frame.IHDR.Width;
  582. Frame.FrameHeight := Frame.IHDR.Height;
  583. end;
  584. Frame.IsJpegFrame := False;
  585. end;
  586. procedure StartNewJNGImage;
  587. var
  588. Frame: TFrameInfo;
  589. begin
  590. ReadChunkData;
  591. Frame := AddFrameInfo;
  592. Frame.IsJpegFrame := True;
  593. Frame.JHDR := PJHDR(ChunkData)^;
  594. SwapEndianLongWord(@Frame.JHDR, 2);
  595. Frame.FrameWidth := Frame.JHDR.Width;
  596. Frame.FrameHeight := Frame.JHDR.Height;
  597. end;
  598. procedure AppendIDAT;
  599. begin
  600. ReadChunkData;
  601. // Append current IDAT/fdAT chunk to storage stream
  602. if Chunk.ChunkID = IDATChunk then
  603. GetLastFrame.IDATMemory.Write(ChunkData^, Chunk.DataSize)
  604. else if Chunk.ChunkID = fdATChunk then
  605. GetLastFrame.IDATMemory.Write(PByteArray(ChunkData)[4], Chunk.DataSize - SizeOf(LongWord));
  606. end;
  607. procedure AppendJDAT;
  608. begin
  609. ReadChunkData;
  610. // Append current JDAT chunk to storage stream
  611. GetLastFrame.JDATMemory.Write(ChunkData^, Chunk.DataSize);
  612. end;
  613. procedure AppendJDAA;
  614. begin
  615. ReadChunkData;
  616. // Append current JDAA chunk to storage stream
  617. GetLastFrame.JDAAMemory.Write(ChunkData^, Chunk.DataSize);
  618. end;
  619. procedure LoadPLTE;
  620. begin
  621. ReadChunkData;
  622. if GetLastFrame = nil then
  623. begin
  624. // Load global palette
  625. GetMem(GlobalPalette, Chunk.DataSize);
  626. Move(ChunkData^, GlobalPalette^, Chunk.DataSize);
  627. GlobalPaletteEntries := Chunk.DataSize div 3;
  628. end
  629. else if GetLastFrame.Palette = nil then
  630. begin
  631. if (Chunk.DataSize = 0) and (GlobalPalette <> nil) then
  632. begin
  633. // Use global palette
  634. GetMem(GetLastFrame.Palette, GlobalPaletteEntries * SizeOf(TColor24Rec));
  635. Move(GlobalPalette^, GetLastFrame.Palette^, GlobalPaletteEntries * SizeOf(TColor24Rec));
  636. GetLastFrame.PaletteEntries := GlobalPaletteEntries;
  637. end
  638. else
  639. begin
  640. // Load pal from PLTE chunk
  641. GetMem(GetLastFrame.Palette, Chunk.DataSize);
  642. Move(ChunkData^, GetLastFrame.Palette^, Chunk.DataSize);
  643. GetLastFrame.PaletteEntries := Chunk.DataSize div 3;
  644. end;
  645. end;
  646. end;
  647. procedure LoadtRNS;
  648. begin
  649. ReadChunkData;
  650. if GetLastFrame = nil then
  651. begin
  652. // Load global transparency
  653. GetMem(GlobalTransparency, Chunk.DataSize);
  654. Move(ChunkData^, GlobalTransparency^, Chunk.DataSize);
  655. GlobalTransparencySize := Chunk.DataSize;
  656. end
  657. else if GetLastFrame.Transparency = nil then
  658. begin
  659. if (Chunk.DataSize = 0) and (GlobalTransparency <> nil) then
  660. begin
  661. // Use global transparency
  662. GetMem(GetLastFrame.Transparency, GlobalTransparencySize);
  663. Move(GlobalTransparency^, GetLastFrame.Transparency^, Chunk.DataSize);
  664. GetLastFrame.TransparencySize := GlobalTransparencySize;
  665. end
  666. else
  667. begin
  668. // Load pal from tRNS chunk
  669. GetMem(GetLastFrame.Transparency, Chunk.DataSize);
  670. Move(ChunkData^, GetLastFrame.Transparency^, Chunk.DataSize);
  671. GetLastFrame.TransparencySize := Chunk.DataSize;
  672. end;
  673. end;
  674. end;
  675. procedure LoadbKGD;
  676. begin
  677. ReadChunkData;
  678. if GetLastFrame.Background = nil then
  679. begin
  680. GetMem(GetLastFrame.Background, Chunk.DataSize);
  681. Move(ChunkData^, GetLastFrame.Background^, Chunk.DataSize);
  682. GetLastFrame.BackgroundSize := Chunk.DataSize;
  683. end;
  684. end;
  685. procedure HandleacTL;
  686. begin
  687. FileType := ngAPNG;
  688. ReadChunkData;
  689. acTL := PacTL(ChunkData)^;
  690. SwapEndianLongWord(@acTL, SizeOf(acTL) div SizeOf(LongWord));
  691. end;
  692. procedure LoadpHYs;
  693. begin
  694. ReadChunkData;
  695. with GetLastFrame do
  696. begin
  697. pHYs := PpHYs(ChunkData)^;
  698. SwapEndianLongWord(@pHYs, SizeOf(pHYs) div SizeOf(LongWord));
  699. end;
  700. end;
  701. begin
  702. Result := False;
  703. Clear;
  704. ChunkData := nil;
  705. with GetIO do
  706. try
  707. Read(Handle, @Sig, SizeOf(Sig));
  708. // Set file type according to the signature
  709. if Sig = PNGSignature then FileType := ngPNG
  710. else if Sig = MNGSignature then FileType := ngMNG
  711. else if Sig = JNGSignature then FileType := ngJNG
  712. else Exit;
  713. if FileType = ngMNG then
  714. begin
  715. // Store MNG header if present
  716. ReadChunk;
  717. ReadChunkData;
  718. MHDR := PMHDR(ChunkData)^;
  719. SwapEndianLongWord(@MHDR, SizeOf(MHDR) div SizeOf(LongWord));
  720. end;
  721. // Read chunks until ending chunk or EOF is reached
  722. repeat
  723. ReadChunk;
  724. if (Chunk.ChunkID = IHDRChunk) or (Chunk.ChunkID = fcTLChunk) then StartNewPNGImage
  725. else if Chunk.ChunkID = JHDRChunk then StartNewJNGImage
  726. else if (Chunk.ChunkID = IDATChunk) or (Chunk.ChunkID = fdATChunk) then AppendIDAT
  727. else if Chunk.ChunkID = JDATChunk then AppendJDAT
  728. else if Chunk.ChunkID = JDAAChunk then AppendJDAA
  729. else if Chunk.ChunkID = PLTEChunk then LoadPLTE
  730. else if Chunk.ChunkID = tRNSChunk then LoadtRNS
  731. else if Chunk.ChunkID = bKGDChunk then LoadbKGD
  732. else if Chunk.ChunkID = acTLChunk then HandleacTL
  733. else if Chunk.ChunkID = pHYsChunk then LoadpHYs
  734. else SkipChunkData;
  735. until Eof(Handle) or (Chunk.ChunkID = MENDChunk) or
  736. ((FileType <> ngMNG) and (Chunk.ChunkID = IENDChunk));
  737. Result := True;
  738. finally
  739. FreeMemNil(ChunkData);
  740. end;
  741. end;
  742. procedure TNGFileLoader.LoadImageFromPNGFrame(FrameWidth, FrameHeight: LongInt; const IHDR: TIHDR;
  743. IDATStream: TMemoryStream; var Image: TImageData);
  744. type
  745. TGetPixelFunc = function(Line: PByteArray; X: LongInt): Byte;
  746. var
  747. LineBuffer: array[Boolean] of PByteArray;
  748. ActLine: Boolean;
  749. Data, TotalBuffer, ZeroLine, PrevLine: Pointer;
  750. BitCount, TotalSize, TotalPos, BytesPerPixel, I, Pass,
  751. SrcDataSize, BytesPerLine, InterlaceLineBytes, InterlaceWidth: LongInt;
  752. Info: TImageFormatInfo;
  753. procedure DecodeAdam7;
  754. const
  755. BitTable: array[1..8] of LongInt = ($1, $3, 0, $F, 0, 0, 0, $FF);
  756. StartBit: array[1..8] of LongInt = (7, 6, 0, 4, 0, 0, 0, 0);
  757. var
  758. Src, Dst, Dst2: PByte;
  759. CurBit, Col: LongInt;
  760. begin
  761. Src := @LineBuffer[ActLine][1];
  762. Col := ColumnStart[Pass];
  763. with Image do
  764. case BitCount of
  765. 1, 2, 4:
  766. begin
  767. Dst := @PByteArray(Data)[I * BytesPerLine];
  768. repeat
  769. CurBit := StartBit[BitCount];
  770. repeat
  771. Dst2 := @PByteArray(Dst)[(BitCount * Col) shr 3];
  772. Dst2^ := Dst2^ or ((Src^ shr CurBit) and BitTable[BitCount])
  773. shl (StartBit[BitCount] - (Col * BitCount mod 8));
  774. Inc(Col, ColumnIncrement[Pass]);
  775. Dec(CurBit, BitCount);
  776. until CurBit < 0;
  777. Inc(Src);
  778. until Col >= Width;
  779. end;
  780. else
  781. begin
  782. Dst := @PByteArray(Data)[I * BytesPerLine + Col * BytesPerPixel];
  783. repeat
  784. CopyPixel(Src, Dst, BytesPerPixel);
  785. Inc(Dst, BytesPerPixel);
  786. Inc(Src, BytesPerPixel);
  787. Inc(Dst, ColumnIncrement[Pass] * BytesPerPixel - BytesPerPixel);
  788. Inc(Col, ColumnIncrement[Pass]);
  789. until Col >= Width;
  790. end;
  791. end;
  792. end;
  793. procedure FilterScanline(Filter: Byte; BytesPerPixel: LongInt; Line, PrevLine, Target: PByteArray;
  794. BytesPerLine: LongInt);
  795. var
  796. I: LongInt;
  797. begin
  798. case Filter of
  799. 0:
  800. begin
  801. // No filter
  802. Move(Line^, Target^, BytesPerLine);
  803. end;
  804. 1:
  805. begin
  806. // Sub filter
  807. Move(Line^, Target^, BytesPerPixel);
  808. for I := BytesPerPixel to BytesPerLine - 1 do
  809. Target[I] := (Line[I] + Target[I - BytesPerPixel]) and $FF;
  810. end;
  811. 2:
  812. begin
  813. // Up filter
  814. for I := 0 to BytesPerLine - 1 do
  815. Target[I] := (Line[I] + PrevLine[I]) and $FF;
  816. end;
  817. 3:
  818. begin
  819. // Average filter
  820. for I := 0 to BytesPerPixel - 1 do
  821. Target[I] := (Line[I] + PrevLine[I] shr 1) and $FF;
  822. for I := BytesPerPixel to BytesPerLine - 1 do
  823. Target[I] := (Line[I] + (Target[I - BytesPerPixel] + PrevLine[I]) shr 1) and $FF;
  824. end;
  825. 4:
  826. begin
  827. // Paeth filter
  828. for I := 0 to BytesPerPixel - 1 do
  829. Target[I] := (Line[I] + PaethPredictor(0, PrevLine[I], 0)) and $FF;
  830. for I := BytesPerPixel to BytesPerLine - 1 do
  831. Target[I] := (Line[I] + PaethPredictor(Target[I - BytesPerPixel], PrevLine[I], PrevLine[I - BytesPerPixel])) and $FF;
  832. end;
  833. end;
  834. end;
  835. procedure TransformLOCOToRGB(Data: PByte; NumPixels, BytesPerPixel: LongInt);
  836. var
  837. I: LongInt;
  838. begin
  839. for I := 0 to NumPixels - 1 do
  840. begin
  841. if IHDR.BitDepth = 8 then
  842. begin
  843. PColor32Rec(Data).R := Byte(PColor32Rec(Data).R + PColor32Rec(Data).G);
  844. PColor32Rec(Data).B := Byte(PColor32Rec(Data).B + PColor32Rec(Data).G);
  845. end
  846. else
  847. begin
  848. PColor64Rec(Data).R := Word(PColor64Rec(Data).R + PColor64Rec(Data).G);
  849. PColor64Rec(Data).B := Word(PColor64Rec(Data).B + PColor64Rec(Data).G);
  850. end;
  851. Inc(Data, BytesPerPixel);
  852. end;
  853. end;
  854. function CheckBinaryPalette: Boolean;
  855. begin
  856. with GetLastFrame do
  857. Result := (PaletteEntries = 2) and
  858. (Palette[0].R = 0) and (Palette[0].G = 0) and (Palette[0].B = 0) and
  859. (Palette[1].R = 255) and (Palette[1].G = 255) and (Palette[1].B = 255);
  860. end;
  861. begin
  862. Image.Width := FrameWidth;
  863. Image.Height := FrameHeight;
  864. Image.Format := ifUnknown;
  865. case IHDR.ColorType of
  866. 0:
  867. begin
  868. // Gray scale image
  869. case IHDR.BitDepth of
  870. 1: Image.Format := ifBinary;
  871. 2, 4, 8: Image.Format := ifGray8;
  872. 16: Image.Format := ifGray16;
  873. end;
  874. BitCount := IHDR.BitDepth;
  875. end;
  876. 2:
  877. begin
  878. // RGB image
  879. case IHDR.BitDepth of
  880. 8: Image.Format := ifR8G8B8;
  881. 16: Image.Format := ifR16G16B16;
  882. end;
  883. BitCount := IHDR.BitDepth * 3;
  884. end;
  885. 3:
  886. begin
  887. // Indexed image
  888. if (IHDR.BitDepth = 1) and CheckBinaryPalette then
  889. Image.Format := ifBinary
  890. else
  891. Image.Format := ifIndex8;
  892. BitCount := IHDR.BitDepth;
  893. end;
  894. 4:
  895. begin
  896. // Grayscale + alpha image
  897. case IHDR.BitDepth of
  898. 8: Image.Format := ifA8Gray8;
  899. 16: Image.Format := ifA16Gray16;
  900. end;
  901. BitCount := IHDR.BitDepth * 2;
  902. end;
  903. 6:
  904. begin
  905. // ARGB image
  906. case IHDR.BitDepth of
  907. 8: Image.Format := ifA8R8G8B8;
  908. 16: Image.Format := ifA16R16G16B16;
  909. end;
  910. BitCount := IHDR.BitDepth * 4;
  911. end;
  912. end;
  913. GetImageFormatInfo(Image.Format, Info);
  914. BytesPerPixel := (BitCount + 7) div 8;
  915. LineBuffer[True] := nil;
  916. LineBuffer[False] := nil;
  917. TotalBuffer := nil;
  918. ZeroLine := nil;
  919. ActLine := True;
  920. // Start decoding
  921. with Image do
  922. try
  923. BytesPerLine := (Width * BitCount + 7) div 8;
  924. SrcDataSize := Height * BytesPerLine;
  925. GetMem(Data, SrcDataSize);
  926. FillChar(Data^, SrcDataSize, 0);
  927. GetMem(ZeroLine, BytesPerLine);
  928. FillChar(ZeroLine^, BytesPerLine, 0);
  929. if IHDR.Interlacing = 1 then
  930. begin
  931. // Decode interlaced images
  932. TotalPos := 0;
  933. DecompressBuf(IDATStream.Memory, IDATStream.Size, 0,
  934. Pointer(TotalBuffer), TotalSize);
  935. GetMem(LineBuffer[True], BytesPerLine + 1);
  936. GetMem(LineBuffer[False], BytesPerLine + 1);
  937. for Pass := 0 to 6 do
  938. begin
  939. // Prepare next interlace run
  940. if Width <= ColumnStart[Pass] then
  941. Continue;
  942. InterlaceWidth := (Width + ColumnIncrement[Pass] - 1 -
  943. ColumnStart[Pass]) div ColumnIncrement[Pass];
  944. InterlaceLineBytes := (InterlaceWidth * BitCount + 7) shr 3;
  945. I := RowStart[Pass];
  946. FillChar(LineBuffer[True][0], BytesPerLine + 1, 0);
  947. FillChar(LineBuffer[False][0], BytesPerLine + 1, 0);
  948. while I < Height do
  949. begin
  950. // Copy line from decompressed data to working buffer
  951. Move(PByteArray(TotalBuffer)[TotalPos],
  952. LineBuffer[ActLine][0], InterlaceLineBytes + 1);
  953. Inc(TotalPos, InterlaceLineBytes + 1);
  954. // Swap red and blue channels if necessary
  955. if (IHDR.ColorType in [2, 6]) then
  956. SwapRGB(@LineBuffer[ActLine][1], InterlaceWidth, IHDR.BitDepth, BytesPerPixel);
  957. // Reverse-filter current scanline
  958. FilterScanline(LineBuffer[ActLine][0], BytesPerPixel,
  959. @LineBuffer[ActLine][1], @LineBuffer[not ActLine][1],
  960. @LineBuffer[ActLine][1], InterlaceLineBytes);
  961. // Decode Adam7 interlacing
  962. DecodeAdam7;
  963. ActLine := not ActLine;
  964. // Continue with next row in interlaced order
  965. Inc(I, RowIncrement[Pass]);
  966. end;
  967. end;
  968. end
  969. else
  970. begin
  971. // Decode non-interlaced images
  972. PrevLine := ZeroLine;
  973. DecompressBuf(IDATStream.Memory, IDATStream.Size, SrcDataSize + Height,
  974. Pointer(TotalBuffer), TotalSize);
  975. for I := 0 to Height - 1 do
  976. begin
  977. // Swap red and blue channels if necessary
  978. if IHDR.ColorType in [2, 6] then
  979. SwapRGB(@PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1], Width,
  980. IHDR.BitDepth, BytesPerPixel);
  981. // reverse-filter current scanline
  982. FilterScanline(PByteArray(TotalBuffer)[I * (BytesPerLine + 1)],
  983. BytesPerPixel, @PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1],
  984. PrevLine, @PByteArray(Data)[I * BytesPerLine], BytesPerLine);
  985. PrevLine := @PByteArray(Data)[I * BytesPerLine];
  986. end;
  987. end;
  988. Size := Info.GetPixelsSize(Info.Format, Width, Height);
  989. if Size <> SrcDataSize then
  990. begin
  991. // If source data size is different from size of image in assigned
  992. // format we must convert it (it is in 1/2/4 bit count)
  993. GetMem(Bits, Size);
  994. case IHDR.BitDepth of
  995. 1:
  996. begin
  997. // Convert only indexed, keep black and white in ifBinary
  998. if IHDR.ColorType <> 0 then
  999. Convert1To8(Data, Bits, Width, Height, BytesPerLine, False);
  1000. end;
  1001. 2: Convert2To8(Data, Bits, Width, Height, BytesPerLine, IHDR.ColorType = 0);
  1002. 4: Convert4To8(Data, Bits, Width, Height, BytesPerLine, IHDR.ColorType = 0);
  1003. end;
  1004. FreeMem(Data);
  1005. end
  1006. else
  1007. begin
  1008. // If source data size is the same as size of
  1009. // image Bits in assigned format we simply copy pointer reference
  1010. Bits := Data;
  1011. end;
  1012. // LOCO transformation was used too (only for color types 2 and 6)
  1013. if (IHDR.Filter = 64) and (IHDR.ColorType in [2, 6]) then
  1014. TransformLOCOToRGB(Bits, Width * Height, BytesPerPixel);
  1015. // Images with 16 bit channels must be swapped because of PNG's big endianity
  1016. if IHDR.BitDepth = 16 then
  1017. SwapEndianWord(Bits, Width * Height * BytesPerPixel div SizeOf(Word));
  1018. finally
  1019. FreeMem(LineBuffer[True]);
  1020. FreeMem(LineBuffer[False]);
  1021. FreeMem(TotalBuffer);
  1022. FreeMem(ZeroLine);
  1023. end;
  1024. end;
  1025. {$IFNDEF DONT_LINK_JNG}
  1026. procedure TNGFileLoader.LoadImageFromJNGFrame(FrameWidth, FrameHeight: LongInt; const JHDR: TJHDR; IDATStream,
  1027. JDATStream, JDAAStream: TMemoryStream; var Image: TImageData);
  1028. var
  1029. AlphaImage: TImageData;
  1030. FakeIHDR: TIHDR;
  1031. FmtInfo: TImageFormatInfo;
  1032. I: LongInt;
  1033. AlphaPtr: PByte;
  1034. GrayPtr: PWordRec;
  1035. ColorPtr: PColor32Rec;
  1036. procedure LoadJpegFromStream(Stream: TStream; var DestImage: TImageData);
  1037. var
  1038. JpegFormat: TCustomIOJpegFileFormat;
  1039. Handle: TImagingHandle;
  1040. DynImages: TDynImageDataArray;
  1041. begin
  1042. if JHDR.SampleDepth <> 12 then
  1043. begin
  1044. JpegFormat := TCustomIOJpegFileFormat.Create;
  1045. JpegFormat.SetCustomIO(StreamIO);
  1046. Stream.Position := 0;
  1047. Handle := StreamIO.Open(Pointer(Stream), omReadOnly);
  1048. try
  1049. JpegFormat.LoadData(Handle, DynImages, True);
  1050. DestImage := DynImages[0];
  1051. finally
  1052. StreamIO.Close(Handle);
  1053. JpegFormat.Free;
  1054. SetLength(DynImages, 0);
  1055. end;
  1056. end
  1057. else
  1058. NewImage(FrameWidth, FrameHeight, ifR8G8B8, DestImage);
  1059. end;
  1060. begin
  1061. LoadJpegFromStream(JDATStream, Image);
  1062. // If present separate alpha channel is processed
  1063. if (JHDR.ColorType in [12, 14]) and (Image.Format in [ifGray8, ifR8G8B8]) then
  1064. begin
  1065. InitImage(AlphaImage);
  1066. if JHDR.AlphaCompression = 0 then
  1067. begin
  1068. // Alpha channel is PNG compressed
  1069. FakeIHDR.Width := JHDR.Width;
  1070. FakeIHDR.Height := JHDR.Height;
  1071. FakeIHDR.ColorType := 0;
  1072. FakeIHDR.BitDepth := JHDR.AlphaSampleDepth;
  1073. FakeIHDR.Filter := JHDR.AlphaFilter;
  1074. FakeIHDR.Interlacing := JHDR.AlphaInterlacing;
  1075. LoadImageFromPNGFrame(FrameWidth, FrameHeight, FakeIHDR, IDATStream, AlphaImage);
  1076. end
  1077. else
  1078. begin
  1079. // Alpha channel is JPEG compressed
  1080. LoadJpegFromStream(JDAAStream, AlphaImage);
  1081. end;
  1082. // Check if alpha channel is the same size as image
  1083. if (Image.Width <> AlphaImage.Width) and (Image.Height <> AlphaImage.Height) then
  1084. ResizeImage(AlphaImage, Image.Width, Image.Height, rfNearest);
  1085. // Check alpha channels data format
  1086. GetImageFormatInfo(AlphaImage.Format, FmtInfo);
  1087. if (FmtInfo.BytesPerPixel > 1) or (not FmtInfo.HasGrayChannel) then
  1088. ConvertImage(AlphaImage, ifGray8);
  1089. // Convert image to fromat with alpha channel
  1090. if Image.Format = ifGray8 then
  1091. ConvertImage(Image, ifA8Gray8)
  1092. else
  1093. ConvertImage(Image, ifA8R8G8B8);
  1094. // Combine alpha channel with image
  1095. AlphaPtr := AlphaImage.Bits;
  1096. if Image.Format = ifA8Gray8 then
  1097. begin
  1098. GrayPtr := Image.Bits;
  1099. for I := 0 to Image.Width * Image.Height - 1 do
  1100. begin
  1101. GrayPtr.High := AlphaPtr^;
  1102. Inc(GrayPtr);
  1103. Inc(AlphaPtr);
  1104. end;
  1105. end
  1106. else
  1107. begin
  1108. ColorPtr := Image.Bits;
  1109. for I := 0 to Image.Width * Image.Height - 1 do
  1110. begin
  1111. ColorPtr.A := AlphaPtr^;
  1112. Inc(ColorPtr);
  1113. Inc(AlphaPtr);
  1114. end;
  1115. end;
  1116. FreeImage(AlphaImage);
  1117. end;
  1118. end;
  1119. {$ENDIF}
  1120. procedure TNGFileLoader.ApplyFrameSettings(Frame: TFrameInfo; var Image: TImageData);
  1121. var
  1122. FmtInfo: TImageFormatInfo;
  1123. BackGroundColor: TColor64Rec;
  1124. ColorKey: TColor64Rec;
  1125. Alphas: PByteArray;
  1126. AlphasSize: LongInt;
  1127. IsColorKeyPresent: Boolean;
  1128. IsBackGroundPresent: Boolean;
  1129. IsColorFormat: Boolean;
  1130. procedure ConverttRNS;
  1131. begin
  1132. if FmtInfo.IsIndexed then
  1133. begin
  1134. if Alphas = nil then
  1135. begin
  1136. GetMem(Alphas, Frame.TransparencySize);
  1137. Move(Frame.Transparency^, Alphas^, Frame.TransparencySize);
  1138. AlphasSize := Frame.TransparencySize;
  1139. end;
  1140. end
  1141. else if not FmtInfo.HasAlphaChannel then
  1142. begin
  1143. FillChar(ColorKey, SizeOf(ColorKey), 0);
  1144. Move(Frame.Transparency^, ColorKey, Min(Frame.TransparencySize, SizeOf(ColorKey)));
  1145. if IsColorFormat then
  1146. SwapValues(ColorKey.R, ColorKey.B);
  1147. SwapEndianWord(@ColorKey, 3);
  1148. // 1/2/4 bit images were converted to 8 bit so we must convert color key too
  1149. if (not Frame.IsJpegFrame) and (Frame.IHDR.ColorType in [0, 4]) then
  1150. case Frame.IHDR.BitDepth of
  1151. 1: ColorKey.B := Word(ColorKey.B * 255);
  1152. 2: ColorKey.B := Word(ColorKey.B * 85);
  1153. 4: ColorKey.B := Word(ColorKey.B * 17);
  1154. end;
  1155. IsColorKeyPresent := True;
  1156. end;
  1157. end;
  1158. procedure ConvertbKGD;
  1159. begin
  1160. FillChar(BackGroundColor, SizeOf(BackGroundColor), 0);
  1161. Move(Frame.Background^, BackGroundColor, Min(Frame.BackgroundSize, SizeOf(BackGroundColor)));
  1162. if IsColorFormat then
  1163. SwapValues(BackGroundColor.R, BackGroundColor.B);
  1164. SwapEndianWord(@BackGroundColor, 3);
  1165. // 1/2/4 bit images were converted to 8 bit so we must convert back color too
  1166. if (not Frame.IsJpegFrame) and (Frame.IHDR.ColorType in [0, 4]) then
  1167. case Frame.IHDR.BitDepth of
  1168. 1: BackGroundColor.B := Word(BackGroundColor.B * 255);
  1169. 2: BackGroundColor.B := Word(BackGroundColor.B * 85);
  1170. 4: BackGroundColor.B := Word(BackGroundColor.B * 17);
  1171. end;
  1172. IsBackGroundPresent := True;
  1173. end;
  1174. procedure ReconstructPalette;
  1175. var
  1176. I: LongInt;
  1177. begin
  1178. with Image do
  1179. begin
  1180. GetMem(Palette, FmtInfo.PaletteEntries * SizeOf(TColor32Rec));
  1181. FillChar(Palette^, FmtInfo.PaletteEntries * SizeOf(TColor32Rec), $FF);
  1182. // if RGB palette was loaded from file then use it
  1183. if Frame.Palette <> nil then
  1184. for I := 0 to Min(Frame.PaletteEntries, FmtInfo.PaletteEntries) - 1 do
  1185. with Palette[I] do
  1186. begin
  1187. R := Frame.Palette[I].B;
  1188. G := Frame.Palette[I].G;
  1189. B := Frame.Palette[I].R;
  1190. end;
  1191. // if palette alphas were loaded from file then use them
  1192. if Alphas <> nil then
  1193. begin
  1194. for I := 0 to Min(AlphasSize, FmtInfo.PaletteEntries) - 1 do
  1195. Palette[I].A := Alphas[I];
  1196. end;
  1197. end;
  1198. end;
  1199. procedure ApplyColorKey;
  1200. var
  1201. DestFmt: TImageFormat;
  1202. Col32, Bkg32: TColor32Rec;
  1203. OldPixel, NewPixel: Pointer;
  1204. begin
  1205. case Image.Format of
  1206. ifGray8: DestFmt := ifA8Gray8;
  1207. ifGray16: DestFmt := ifA16Gray16;
  1208. ifR8G8B8: DestFmt := ifA8R8G8B8;
  1209. ifR16G16B16: DestFmt := ifA16R16G16B16;
  1210. else
  1211. DestFmt := ifUnknown;
  1212. end;
  1213. if DestFmt <> ifUnknown then
  1214. begin
  1215. if not IsBackGroundPresent then
  1216. BackGroundColor := ColorKey;
  1217. ConvertImage(Image, DestFmt);
  1218. // Now back color and color key must be converted to image's data format, looks ugly
  1219. case Image.Format of
  1220. ifA8Gray8:
  1221. begin
  1222. Col32 := Color32(0, 0, $FF, Byte(ColorKey.B));
  1223. Bkg32 := Color32(0, 0, 0, Byte(BackGroundColor.B));
  1224. end;
  1225. ifA16Gray16:
  1226. begin
  1227. ColorKey.G := $FFFF;
  1228. end;
  1229. ifA8R8G8B8:
  1230. begin
  1231. Col32 := Color32($FF, Byte(ColorKey.R), Byte(ColorKey.G), Byte(ColorKey.B));
  1232. Bkg32 := Color32(0, Byte(BackGroundColor.R), Byte(BackGroundColor.G), Byte(BackGroundColor.B));
  1233. end;
  1234. ifA16R16G16B16:
  1235. begin
  1236. ColorKey.A := $FFFF;
  1237. end;
  1238. end;
  1239. if Image.Format in [ifA8Gray8, ifA8R8G8B8] then
  1240. begin
  1241. OldPixel := @Col32;
  1242. NewPixel := @Bkg32;
  1243. end
  1244. else
  1245. begin
  1246. OldPixel := @ColorKey;
  1247. NewPixel := @BackGroundColor;
  1248. end;
  1249. ReplaceColor(Image, 0, 0, Image.Width, Image.Height, OldPixel, NewPixel);
  1250. end;
  1251. end;
  1252. begin
  1253. Alphas := nil;
  1254. IsColorKeyPresent := False;
  1255. IsBackGroundPresent := False;
  1256. GetImageFormatInfo(Image.Format, FmtInfo);
  1257. IsColorFormat := (Frame.IsJpegFrame and (Frame.JHDR.ColorType in [10, 14])) or
  1258. (not Frame.IsJpegFrame and (Frame.IHDR.ColorType in [2, 6]));
  1259. // Convert some chunk data to useful format
  1260. if Frame.TransparencySize > 0 then
  1261. ConverttRNS;
  1262. if Frame.BackgroundSize > 0 then
  1263. ConvertbKGD;
  1264. // Build palette for indexed images
  1265. if FmtInfo.IsIndexed then
  1266. ReconstructPalette;
  1267. // Apply color keying
  1268. if IsColorKeyPresent and not FmtInfo.HasAlphaChannel then
  1269. ApplyColorKey;
  1270. FreeMemNil(Alphas);
  1271. end;
  1272. { TNGFileSaver class implementation }
  1273. procedure TNGFileSaver.StoreImageToPNGFrame(const IHDR: TIHDR; Bits: Pointer;
  1274. FmtInfo: TImageFormatInfo; IDATStream: TMemoryStream);
  1275. var
  1276. TotalBuffer, CompBuffer, ZeroLine, PrevLine: Pointer;
  1277. FilterLines: array[0..4] of PByteArray;
  1278. TotalSize, CompSize, I, BytesPerLine, BytesPerPixel: LongInt;
  1279. Filter: Byte;
  1280. Adaptive: Boolean;
  1281. procedure FilterScanline(Filter: Byte; BytesPerPixel: LongInt; Line, PrevLine, Target: PByteArray);
  1282. var
  1283. I: LongInt;
  1284. begin
  1285. case Filter of
  1286. 0:
  1287. begin
  1288. // No filter
  1289. Move(Line^, Target^, BytesPerLine);
  1290. end;
  1291. 1:
  1292. begin
  1293. // Sub filter
  1294. Move(Line^, Target^, BytesPerPixel);
  1295. for I := BytesPerPixel to BytesPerLine - 1 do
  1296. Target[I] := (Line[I] - Line[I - BytesPerPixel]) and $FF;
  1297. end;
  1298. 2:
  1299. begin
  1300. // Up filter
  1301. for I := 0 to BytesPerLine - 1 do
  1302. Target[I] := (Line[I] - PrevLine[I]) and $FF;
  1303. end;
  1304. 3:
  1305. begin
  1306. // Average filter
  1307. for I := 0 to BytesPerPixel - 1 do
  1308. Target[I] := (Line[I] - PrevLine[I] shr 1) and $FF;
  1309. for I := BytesPerPixel to BytesPerLine - 1 do
  1310. Target[I] := (Line[I] - (Line[I - BytesPerPixel] + PrevLine[I]) shr 1) and $FF;
  1311. end;
  1312. 4:
  1313. begin
  1314. // Paeth filter
  1315. for I := 0 to BytesPerPixel - 1 do
  1316. Target[I] := (Line[I] - PaethPredictor(0, PrevLine[I], 0)) and $FF;
  1317. for I := BytesPerPixel to BytesPerLine - 1 do
  1318. Target[I] := (Line[I] - PaethPredictor(Line[I - BytesPerPixel], PrevLine[I], PrevLine[I - BytesPerPixel])) and $FF;
  1319. end;
  1320. end;
  1321. end;
  1322. procedure AdaptiveFilter(var Filter: Byte; BytesPerPixel: LongInt; Line, PrevLine, Target: PByteArray);
  1323. var
  1324. I, J, BestTest: LongInt;
  1325. Sums: array[0..4] of LongInt;
  1326. begin
  1327. // Compute the output scanline using all five filters,
  1328. // and select the filter that gives the smallest sum of
  1329. // absolute values of outputs
  1330. FillChar(Sums, SizeOf(Sums), 0);
  1331. BestTest := MaxInt;
  1332. for I := 0 to 4 do
  1333. begin
  1334. FilterScanline(I, BytesPerPixel, Line, PrevLine, FilterLines[I]);
  1335. for J := 0 to BytesPerLine - 1 do
  1336. Sums[I] := Sums[I] + Abs(ShortInt(FilterLines[I][J]));
  1337. if Sums[I] < BestTest then
  1338. begin
  1339. Filter := I;
  1340. BestTest := Sums[I];
  1341. end;
  1342. end;
  1343. Move(FilterLines[Filter]^, Target^, BytesPerLine);
  1344. end;
  1345. begin
  1346. // Select precompression filter and compression level
  1347. Adaptive := False;
  1348. Filter := 0;
  1349. case PreFilter of
  1350. 6:
  1351. if not ((IHDR.BitDepth < 8) or (IHDR.ColorType = 3)) then
  1352. Adaptive := True;
  1353. 0..4: Filter := PreFilter;
  1354. else
  1355. if IHDR.ColorType in [2, 6] then
  1356. Filter := 4
  1357. end;
  1358. // Prepare data for compression
  1359. CompBuffer := nil;
  1360. FillChar(FilterLines, SizeOf(FilterLines), 0);
  1361. BytesPerPixel := Max(1, FmtInfo.BytesPerPixel);
  1362. BytesPerLine := FmtInfo.GetPixelsSize(FmtInfo.Format, LongInt(IHDR.Width), 1);
  1363. TotalSize := (BytesPerLine + 1) * LongInt(IHDR.Height);
  1364. GetMem(TotalBuffer, TotalSize);
  1365. GetMem(ZeroLine, BytesPerLine);
  1366. FillChar(ZeroLine^, BytesPerLine, 0);
  1367. PrevLine := ZeroLine;
  1368. if Adaptive then
  1369. begin
  1370. for I := 0 to 4 do
  1371. GetMem(FilterLines[I], BytesPerLine);
  1372. end;
  1373. try
  1374. // Process next scanlines
  1375. for I := 0 to IHDR.Height - 1 do
  1376. begin
  1377. // Filter scanline
  1378. if Adaptive then
  1379. begin
  1380. AdaptiveFilter(Filter, BytesPerPixel, @PByteArray(Bits)[I * BytesPerLine],
  1381. PrevLine, @PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1]);
  1382. end
  1383. else
  1384. begin
  1385. FilterScanline(Filter, BytesPerPixel, @PByteArray(Bits)[I * BytesPerLine],
  1386. PrevLine, @PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1]);
  1387. end;
  1388. PrevLine := @PByteArray(Bits)[I * BytesPerLine];
  1389. // Swap red and blue if necessary
  1390. if (IHDR.ColorType in [2, 6]) and not FmtInfo.IsRBSwapped then
  1391. begin
  1392. SwapRGB(@PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1],
  1393. IHDR.Width, IHDR.BitDepth, BytesPerPixel);
  1394. end;
  1395. // Images with 16 bit channels must be swapped because of PNG's big endianess
  1396. if IHDR.BitDepth = 16 then
  1397. begin
  1398. SwapEndianWord(@PByteArray(TotalBuffer)[I * (BytesPerLine + 1) + 1],
  1399. BytesPerLine div SizeOf(Word));
  1400. end;
  1401. // Set filter used for this scanline
  1402. PByteArray(TotalBuffer)[I * (BytesPerLine + 1)] := Filter;
  1403. end;
  1404. // Compress IDAT data
  1405. CompressBuf(TotalBuffer, TotalSize, CompBuffer, CompSize,
  1406. CompressLevel, ZLibStrategy);
  1407. // Write IDAT data to stream
  1408. IDATStream.WriteBuffer(CompBuffer^, CompSize);
  1409. finally
  1410. FreeMem(TotalBuffer);
  1411. FreeMem(CompBuffer);
  1412. FreeMem(ZeroLine);
  1413. if Adaptive then
  1414. for I := 0 to 4 do
  1415. FreeMem(FilterLines[I]);
  1416. end;
  1417. end;
  1418. {$IFNDEF DONT_LINK_JNG}
  1419. procedure TNGFileSaver.StoreImageToJNGFrame(const JHDR: TJHDR;
  1420. const Image: TImageData; IDATStream, JDATStream,
  1421. JDAAStream: TMemoryStream);
  1422. var
  1423. ColorImage, AlphaImage: TImageData;
  1424. FmtInfo: TImageFormatInfo;
  1425. AlphaPtr: PByte;
  1426. GrayPtr: PWordRec;
  1427. ColorPtr: PColor32Rec;
  1428. I: LongInt;
  1429. FakeIHDR: TIHDR;
  1430. procedure SaveJpegToStream(Stream: TStream; const Image: TImageData);
  1431. var
  1432. JpegFormat: TCustomIOJpegFileFormat;
  1433. Handle: TImagingHandle;
  1434. DynImages: TDynImageDataArray;
  1435. begin
  1436. JpegFormat := TCustomIOJpegFileFormat.Create;
  1437. JpegFormat.SetCustomIO(StreamIO);
  1438. // Only JDAT stream can be saved progressive
  1439. if Stream = JDATStream then
  1440. JpegFormat.FProgressive := Progressive
  1441. else
  1442. JpegFormat.FProgressive := False;
  1443. JpegFormat.FQuality := Quality;
  1444. SetLength(DynImages, 1);
  1445. DynImages[0] := Image;
  1446. Handle := StreamIO.Open(Pointer(Stream), omCreate);
  1447. try
  1448. JpegFormat.SaveData(Handle, DynImages, 0);
  1449. finally
  1450. StreamIO.Close(Handle);
  1451. SetLength(DynImages, 0);
  1452. JpegFormat.Free;
  1453. end;
  1454. end;
  1455. begin
  1456. GetImageFormatInfo(Image.Format, FmtInfo);
  1457. InitImage(ColorImage);
  1458. InitImage(AlphaImage);
  1459. if FmtInfo.HasAlphaChannel then
  1460. begin
  1461. // Create new image for alpha channel and color image without alpha
  1462. CloneImage(Image, ColorImage);
  1463. NewImage(Image.Width, Image.Height, ifGray8, AlphaImage);
  1464. case Image.Format of
  1465. ifA8Gray8: ConvertImage(ColorImage, ifGray8);
  1466. ifA8R8G8B8: ConvertImage(ColorImage, ifR8G8B8);
  1467. end;
  1468. // Store source image's alpha to separate image
  1469. AlphaPtr := AlphaImage.Bits;
  1470. if Image.Format = ifA8Gray8 then
  1471. begin
  1472. GrayPtr := Image.Bits;
  1473. for I := 0 to Image.Width * Image.Height - 1 do
  1474. begin
  1475. AlphaPtr^ := GrayPtr.High;
  1476. Inc(GrayPtr);
  1477. Inc(AlphaPtr);
  1478. end;
  1479. end
  1480. else
  1481. begin
  1482. ColorPtr := Image.Bits;
  1483. for I := 0 to Image.Width * Image.Height - 1 do
  1484. begin
  1485. AlphaPtr^ := ColorPtr.A;
  1486. Inc(ColorPtr);
  1487. Inc(AlphaPtr);
  1488. end;
  1489. end;
  1490. // Write color image to stream as JPEG
  1491. SaveJpegToStream(JDATStream, ColorImage);
  1492. if LossyAlpha then
  1493. begin
  1494. // Write alpha image to stream as JPEG
  1495. SaveJpegToStream(JDAAStream, AlphaImage);
  1496. end
  1497. else
  1498. begin
  1499. // Alpha channel is PNG compressed
  1500. FakeIHDR.Width := JHDR.Width;
  1501. FakeIHDR.Height := JHDR.Height;
  1502. FakeIHDR.ColorType := 0;
  1503. FakeIHDR.BitDepth := JHDR.AlphaSampleDepth;
  1504. FakeIHDR.Filter := JHDR.AlphaFilter;
  1505. FakeIHDR.Interlacing := JHDR.AlphaInterlacing;
  1506. GetImageFormatInfo(AlphaImage.Format, FmtInfo);
  1507. StoreImageToPNGFrame(FakeIHDR, AlphaImage.Bits, FmtInfo, IDATStream);
  1508. end;
  1509. FreeImage(ColorImage);
  1510. FreeImage(AlphaImage);
  1511. end
  1512. else
  1513. begin
  1514. // Simply write JPEG to stream
  1515. SaveJpegToStream(JDATStream, Image);
  1516. end;
  1517. end;
  1518. {$ENDIF}
  1519. procedure TNGFileSaver.AddFrame(const Image: TImageData; IsJpegFrame: Boolean);
  1520. var
  1521. Frame: TFrameInfo;
  1522. FmtInfo: TImageFormatInfo;
  1523. Index: Integer;
  1524. procedure StorePalette;
  1525. var
  1526. Pal: PPalette24;
  1527. Alphas: PByteArray;
  1528. I, PalBytes: LongInt;
  1529. AlphasDiffer: Boolean;
  1530. begin
  1531. // Fill and save RGB part of palette to PLTE chunk
  1532. PalBytes := FmtInfo.PaletteEntries * SizeOf(TColor24Rec);
  1533. GetMem(Pal, PalBytes);
  1534. AlphasDiffer := False;
  1535. for I := 0 to FmtInfo.PaletteEntries - 1 do
  1536. begin
  1537. Pal[I].B := Image.Palette[I].R;
  1538. Pal[I].G := Image.Palette[I].G;
  1539. Pal[I].R := Image.Palette[I].B;
  1540. if Image.Palette[I].A < 255 then
  1541. AlphasDiffer := True;
  1542. end;
  1543. Frame.Palette := Pal;
  1544. Frame.PaletteEntries := FmtInfo.PaletteEntries;
  1545. // Fill and save alpha part (if there are any alphas < 255) of palette to tRNS chunk
  1546. if AlphasDiffer then
  1547. begin
  1548. PalBytes := FmtInfo.PaletteEntries * SizeOf(Byte);
  1549. GetMem(Alphas, PalBytes);
  1550. for I := 0 to FmtInfo.PaletteEntries - 1 do
  1551. Alphas[I] := Image.Palette[I].A;
  1552. Frame.Transparency := Alphas;
  1553. Frame.TransparencySize := PalBytes;
  1554. end;
  1555. end;
  1556. procedure FillFrameControlChunk(const IHDR: TIHDR; var fcTL: TfcTL);
  1557. var
  1558. Delay: Integer;
  1559. begin
  1560. fcTL.SeqNumber := 0; // Decided when writing to file
  1561. fcTL.Width := IHDR.Width;
  1562. fcTL.Height := IHDR.Height;
  1563. fcTL.XOffset := 0;
  1564. fcTL.YOffset := 0;
  1565. fcTL.DelayNumer := 1;
  1566. fcTL.DelayDenom := 3;
  1567. if FileFormat.FMetadata.HasMetaItemForSaving(SMetaFrameDelay, Index) then
  1568. begin
  1569. // Metadata contains frame delay information in milliseconds
  1570. Delay := FileFormat.FMetadata.MetaItemsForSavingMulti[SMetaFrameDelay, Index];
  1571. fcTL.DelayNumer := Delay;
  1572. fcTL.DelayDenom := 1000;
  1573. end;
  1574. fcTL.DisposeOp := DisposeOpNone;
  1575. fcTL.BlendOp := BlendOpSource;
  1576. SwapEndianLongWord(@fcTL, 5);
  1577. fcTL.DelayNumer := SwapEndianWord(fcTL.DelayNumer);
  1578. fcTL.DelayDenom := SwapEndianWord(fcTL.DelayDenom);
  1579. end;
  1580. begin
  1581. // Add new frame
  1582. Frame := AddFrameInfo;
  1583. Frame.IsJpegFrame := IsJpegFrame;
  1584. Index := Length(Frames) - 1;
  1585. with Frame do
  1586. begin
  1587. GetImageFormatInfo(Image.Format, FmtInfo);
  1588. if IsJpegFrame then
  1589. begin
  1590. {$IFNDEF DONT_LINK_JNG}
  1591. // Fill JNG header
  1592. JHDR.Width := Image.Width;
  1593. JHDR.Height := Image.Height;
  1594. case Image.Format of
  1595. ifGray8: JHDR.ColorType := 8;
  1596. ifR8G8B8: JHDR.ColorType := 10;
  1597. ifA8Gray8: JHDR.ColorType := 12;
  1598. ifA8R8G8B8: JHDR.ColorType := 14;
  1599. end;
  1600. JHDR.SampleDepth := 8; // 8-bit samples and quantization tables
  1601. JHDR.Compression := 8; // Huffman coding
  1602. JHDR.Interlacing := Iff(Progressive, 8, 0);
  1603. JHDR.AlphaSampleDepth := Iff(FmtInfo.HasAlphaChannel, 8, 0);
  1604. JHDR.AlphaCompression := Iff(LossyAlpha, 8, 0);
  1605. JHDR.AlphaFilter := 0;
  1606. JHDR.AlphaInterlacing := 0;
  1607. StoreImageToJNGFrame(JHDR, Image, IDATMemory, JDATMemory, JDAAMemory);
  1608. // Finally swap endian
  1609. SwapEndianLongWord(@JHDR, 2);
  1610. {$ENDIF}
  1611. end
  1612. else
  1613. begin
  1614. // Fill PNG header
  1615. IHDR.Width := Image.Width;
  1616. IHDR.Height := Image.Height;
  1617. IHDR.Compression := 0;
  1618. IHDR.Filter := 0;
  1619. IHDR.Interlacing := 0;
  1620. IHDR.BitDepth := FmtInfo.BytesPerPixel * 8;
  1621. // Select appropiate PNG color type and modify bitdepth
  1622. if FmtInfo.HasGrayChannel then
  1623. begin
  1624. IHDR.ColorType := 0;
  1625. if FmtInfo.HasAlphaChannel then
  1626. begin
  1627. IHDR.ColorType := 4;
  1628. IHDR.BitDepth := IHDR.BitDepth div 2;
  1629. end;
  1630. end
  1631. else if FmtInfo.Format = ifBinary then
  1632. begin
  1633. IHDR.ColorType := 0;
  1634. IHDR.BitDepth := 1;
  1635. end
  1636. else if FmtInfo.IsIndexed then
  1637. IHDR.ColorType := 3
  1638. else if FmtInfo.HasAlphaChannel then
  1639. begin
  1640. IHDR.ColorType := 6;
  1641. IHDR.BitDepth := IHDR.BitDepth div 4;
  1642. end
  1643. else
  1644. begin
  1645. IHDR.ColorType := 2;
  1646. IHDR.BitDepth := IHDR.BitDepth div 3;
  1647. end;
  1648. if FileType = ngAPNG then
  1649. begin
  1650. // Fill fcTL chunk of APNG file
  1651. FillFrameControlChunk(IHDR, fcTL);
  1652. end;
  1653. // Compress PNG image and store it to stream
  1654. StoreImageToPNGFrame(IHDR, Image.Bits, FmtInfo, IDATMemory);
  1655. // Store palette if necesary
  1656. if FmtInfo.IsIndexed then
  1657. StorePalette;
  1658. // Finally swap endian
  1659. SwapEndianLongWord(@IHDR, 2);
  1660. end;
  1661. end;
  1662. end;
  1663. function TNGFileSaver.SaveFile(Handle: TImagingHandle): Boolean;
  1664. var
  1665. I: LongInt;
  1666. Chunk: TChunkHeader;
  1667. SeqNo: LongWord;
  1668. function GetNextSeqNo: LongWord;
  1669. begin
  1670. // Seq numbers of fcTL and fdAT are "interleaved" as they share the counter.
  1671. // Example: first fcTL for IDAT has seq=0, next is fcTL for seond frame with
  1672. // seq=1, then first fdAT with seq=2, fcTL seq=3, fdAT=4, ...
  1673. Result := SwapEndianLongWord(SeqNo);
  1674. Inc(SeqNo);
  1675. end;
  1676. function CalcChunkCrc(const ChunkHdr: TChunkHeader; Data: Pointer;
  1677. Size: LongInt): LongWord;
  1678. begin
  1679. Result := $FFFFFFFF;
  1680. CalcCrc32(Result, @ChunkHdr.ChunkID, SizeOf(ChunkHdr.ChunkID));
  1681. CalcCrc32(Result, Data, Size);
  1682. Result := SwapEndianLongWord(Result xor $FFFFFFFF);
  1683. end;
  1684. procedure WriteChunk(var Chunk: TChunkHeader; ChunkData: Pointer);
  1685. var
  1686. ChunkCrc: LongWord;
  1687. SizeToWrite: LongInt;
  1688. begin
  1689. SizeToWrite := Chunk.DataSize;
  1690. Chunk.DataSize := SwapEndianLongWord(Chunk.DataSize);
  1691. ChunkCrc := CalcChunkCrc(Chunk, ChunkData, SizeToWrite);
  1692. GetIO.Write(Handle, @Chunk, SizeOf(Chunk));
  1693. if SizeToWrite <> 0 then
  1694. GetIO.Write(Handle, ChunkData, SizeToWrite);
  1695. GetIO.Write(Handle, @ChunkCrc, SizeOf(ChunkCrc));
  1696. end;
  1697. procedure WritefdAT(Frame: TFrameInfo);
  1698. var
  1699. ChunkCrc: LongWord;
  1700. ChunkSeqNo: LongWord;
  1701. begin
  1702. Chunk.ChunkID := fdATChunk;
  1703. ChunkSeqNo := GetNextSeqNo;
  1704. // fdAT saves seq number LongWord before compressed pixels
  1705. Chunk.DataSize := Frame.IDATMemory.Size + SizeOf(LongWord);
  1706. Chunk.DataSize := SwapEndianLongWord(Chunk.DataSize);
  1707. // Calc CRC
  1708. ChunkCrc := $FFFFFFFF;
  1709. CalcCrc32(ChunkCrc, @Chunk.ChunkID, SizeOf(Chunk.ChunkID));
  1710. CalcCrc32(ChunkCrc, @ChunkSeqNo, SizeOf(ChunkSeqNo));
  1711. CalcCrc32(ChunkCrc, Frame.IDATMemory.Memory, Frame.IDATMemory.Size);
  1712. ChunkCrc := SwapEndianLongWord(ChunkCrc xor $FFFFFFFF);
  1713. // Write out all fdAT data
  1714. GetIO.Write(Handle, @Chunk, SizeOf(Chunk));
  1715. GetIO.Write(Handle, @ChunkSeqNo, SizeOf(ChunkSeqNo));
  1716. GetIO.Write(Handle, Frame.IDATMemory.Memory, Frame.IDATMemory.Size);
  1717. GetIO.Write(Handle, @ChunkCrc, SizeOf(ChunkCrc));
  1718. end;
  1719. procedure WriteGlobalMetaDataChunks(Frame: TFrameInfo);
  1720. var
  1721. XRes, YRes: Single;
  1722. begin
  1723. if FileFormat.FMetadata.GetPhysicalPixelSize(ruDpm, XRes, YRes, True) then
  1724. begin
  1725. // Save pHYs chunk
  1726. Frame.pHYs.UnitSpecifier := 1;
  1727. // PNG stores physical resolution as dots per meter
  1728. Frame.pHYs.PixelsPerUnitX := Round(XRes);
  1729. Frame.pHYs.PixelsPerUnitY := Round(YRes);
  1730. Chunk.DataSize := SizeOf(Frame.pHYs);
  1731. Chunk.ChunkID := pHYsChunk;
  1732. SwapEndianLongWord(@Frame.pHYs, SizeOf(Frame.pHYs) div SizeOf(LongWord));
  1733. WriteChunk(Chunk, @Frame.pHYs);
  1734. end;
  1735. end;
  1736. procedure WritePNGMainImageChunks(Frame: TFrameInfo);
  1737. begin
  1738. with Frame do
  1739. begin
  1740. // Write IHDR chunk
  1741. Chunk.DataSize := SizeOf(IHDR);
  1742. Chunk.ChunkID := IHDRChunk;
  1743. WriteChunk(Chunk, @IHDR);
  1744. // Write PLTE chunk if data is present
  1745. if Palette <> nil then
  1746. begin
  1747. Chunk.DataSize := PaletteEntries * SizeOf(TColor24Rec);
  1748. Chunk.ChunkID := PLTEChunk;
  1749. WriteChunk(Chunk, Palette);
  1750. end;
  1751. // Write tRNS chunk if data is present
  1752. if Transparency <> nil then
  1753. begin
  1754. Chunk.DataSize := TransparencySize;
  1755. Chunk.ChunkID := tRNSChunk;
  1756. WriteChunk(Chunk, Transparency);
  1757. end;
  1758. end;
  1759. // Write metadata related chunks
  1760. WriteGlobalMetaDataChunks(Frame);
  1761. end;
  1762. begin
  1763. Result := False;
  1764. SeqNo := 0;
  1765. case FileType of
  1766. ngPNG, ngAPNG: GetIO.Write(Handle, @PNGSignature, SizeOf(TChar8));
  1767. ngMNG: GetIO.Write(Handle, @MNGSignature, SizeOf(TChar8));
  1768. ngJNG: GetIO.Write(Handle, @JNGSignature, SizeOf(TChar8));
  1769. end;
  1770. if FileType = ngMNG then
  1771. begin
  1772. // MNG - main header before frames
  1773. SwapEndianLongWord(@MHDR, SizeOf(MHDR) div SizeOf(LongWord));
  1774. Chunk.DataSize := SizeOf(MHDR);
  1775. Chunk.ChunkID := MHDRChunk;
  1776. WriteChunk(Chunk, @MHDR);
  1777. end
  1778. else if FileType = ngAPNG then
  1779. begin
  1780. // APNG - IHDR and global chunks for all frames, then acTL chunk, then frames
  1781. // (fcTL+IDAT, fcTL+fdAT, fcTL+fdAT, fcTL+fdAT, ....)
  1782. WritePNGMainImageChunks(Frames[0]);
  1783. // Animation control chunk
  1784. acTL.NumFrames := Length(Frames);
  1785. if FileFormat.FMetadata.HasMetaItemForSaving(SMetaAnimationLoops) then
  1786. begin
  1787. // Number of plays of APNG animation
  1788. acTL.NumPlay:= FileFormat.FMetadata.MetaItemsForSaving[SMetaAnimationLoops];
  1789. end
  1790. else
  1791. acTL.NumPlay := 0;
  1792. SwapEndianLongWord(@acTL, SizeOf(acTL) div SizeOf(LongWord));
  1793. Chunk.DataSize := SizeOf(acTL);
  1794. Chunk.ChunkID := acTLChunk;
  1795. WriteChunk(Chunk, @acTL);
  1796. end;
  1797. for I := 0 to Length(Frames) - 1 do
  1798. with Frames[I] do
  1799. begin
  1800. if IsJpegFrame then
  1801. begin
  1802. // Write JHDR chunk
  1803. Chunk.DataSize := SizeOf(JHDR);
  1804. Chunk.ChunkID := JHDRChunk;
  1805. WriteChunk(Chunk, @JHDR);
  1806. // Write metadata related chunks
  1807. WriteGlobalMetaDataChunks(Frames[I]);
  1808. // Write JNG image data
  1809. Chunk.DataSize := JDATMemory.Size;
  1810. Chunk.ChunkID := JDATChunk;
  1811. WriteChunk(Chunk, JDATMemory.Memory);
  1812. // Write alpha channel if present
  1813. if JHDR.AlphaSampleDepth > 0 then
  1814. begin
  1815. if JHDR.AlphaCompression = 0 then
  1816. begin
  1817. // Alpha is PNG compressed
  1818. Chunk.DataSize := IDATMemory.Size;
  1819. Chunk.ChunkID := IDATChunk;
  1820. WriteChunk(Chunk, IDATMemory.Memory);
  1821. end
  1822. else
  1823. begin
  1824. // Alpha is JNG compressed
  1825. Chunk.DataSize := JDAAMemory.Size;
  1826. Chunk.ChunkID := JDAAChunk;
  1827. WriteChunk(Chunk, JDAAMemory.Memory);
  1828. end;
  1829. end;
  1830. // Write image end
  1831. Chunk.DataSize := 0;
  1832. Chunk.ChunkID := IENDChunk;
  1833. WriteChunk(Chunk, nil);
  1834. end
  1835. else if FileType <> ngAPNG then
  1836. begin
  1837. // Regular PNG frame (single PNG image or MNG frame)
  1838. WritePNGMainImageChunks(Frames[I]);
  1839. // Write PNG image data
  1840. Chunk.DataSize := IDATMemory.Size;
  1841. Chunk.ChunkID := IDATChunk;
  1842. WriteChunk(Chunk, IDATMemory.Memory);
  1843. // Write image end
  1844. Chunk.DataSize := 0;
  1845. Chunk.ChunkID := IENDChunk;
  1846. WriteChunk(Chunk, nil);
  1847. end
  1848. else if FileType = ngAPNG then
  1849. begin
  1850. // APNG frame - Write fcTL before frame data
  1851. Chunk.DataSize := SizeOf(fcTL);
  1852. Chunk.ChunkID := fcTLChunk;
  1853. fcTl.SeqNumber := GetNextSeqNo;
  1854. WriteChunk(Chunk, @fcTL);
  1855. // Write data - IDAT for first frame and fdAT for following ones
  1856. if I = 0 then
  1857. begin
  1858. Chunk.DataSize := IDATMemory.Size;
  1859. Chunk.ChunkID := IDATChunk;
  1860. WriteChunk(Chunk, IDATMemory.Memory);
  1861. end
  1862. else
  1863. WritefdAT(Frames[I]);
  1864. // Write image end after last frame
  1865. if I = Length(Frames) - 1 then
  1866. begin
  1867. Chunk.DataSize := 0;
  1868. Chunk.ChunkID := IENDChunk;
  1869. WriteChunk(Chunk, nil);
  1870. end;
  1871. end;
  1872. end;
  1873. if FileType = ngMNG then
  1874. begin
  1875. Chunk.DataSize := 0;
  1876. Chunk.ChunkID := MENDChunk;
  1877. WriteChunk(Chunk, nil);
  1878. end;
  1879. end;
  1880. procedure TNGFileSaver.SetFileOptions;
  1881. begin
  1882. PreFilter := FileFormat.FPreFilter;
  1883. CompressLevel := FileFormat.FCompressLevel;
  1884. LossyAlpha := FileFormat.FLossyAlpha;
  1885. Quality := FileFormat.FQuality;
  1886. Progressive := FileFormat.FProgressive;
  1887. ZLibStrategy := FileFormat.FZLibStategy;
  1888. end;
  1889. { TAPNGAnimator class implementation }
  1890. class procedure TAPNGAnimator.Animate(var Images: TDynImageDataArray;
  1891. const acTL: TacTL; const SrcFrames: array of TFrameInfo);
  1892. var
  1893. I, SrcIdx, Offset, Len: Integer;
  1894. DestFrames: TDynImageDataArray;
  1895. SrcCanvas, DestCanvas: TImagingCanvas;
  1896. PreviousCache: TImageData;
  1897. DestFormat: TImageFormat;
  1898. FormatInfo: TImageFormatInfo;
  1899. AnimatingNeeded, BlendingNeeded: Boolean;
  1900. procedure CheckFrames;
  1901. var
  1902. I: Integer;
  1903. begin
  1904. for I := 0 to Len - 1 do
  1905. with SrcFrames[I] do
  1906. begin
  1907. if (FrameWidth <> Integer(IHDR.Width)) or (FrameHeight <> Integer(IHDR.Height)) or (Len <> Integer(acTL.NumFrames)) or
  1908. (not ((fcTL.DisposeOp = DisposeOpNone) and (fcTL.BlendOp = BlendOpSource)) and
  1909. not ((fcTL.DisposeOp = DisposeOpBackground) and (fcTL.BlendOp = BlendOpSource)) and
  1910. not ((fcTL.DisposeOp = DisposeOpBackground) and (fcTL.BlendOp = BlendOpOver))) then
  1911. begin
  1912. AnimatingNeeded := True;
  1913. end;
  1914. if fcTL.BlendOp = BlendOpOver then
  1915. BlendingNeeded := True;
  1916. if AnimatingNeeded and BlendingNeeded then
  1917. Exit;
  1918. end;
  1919. end;
  1920. begin
  1921. AnimatingNeeded := False;
  1922. BlendingNeeded := False;
  1923. Len := Length(SrcFrames);
  1924. CheckFrames;
  1925. if (Len = 0) or not AnimatingNeeded then
  1926. Exit;
  1927. if (Len = Integer(acTL.NumFrames) + 1) and (SrcFrames[0].fcTL.Width = 0) then
  1928. begin
  1929. // If default image (stored in IDAT chunk) isn't part of animation we ignore it
  1930. Offset := 1;
  1931. Len := Len - 1;
  1932. end
  1933. else
  1934. Offset := 0;
  1935. DestFormat := Images[0].Format;
  1936. GetImageFormatInfo(DestFormat, FormatInfo);
  1937. if BlendingNeeded and FormatInfo.IsIndexed then // alpha blending needed -> destination cannot be indexed
  1938. DestFormat := ifA8R8G8B8;
  1939. SetLength(DestFrames, Len);
  1940. DestCanvas := ImagingCanvases.FindBestCanvasForImage(DestFormat).Create;
  1941. SrcCanvas := ImagingCanvases.FindBestCanvasForImage(Images[0]).Create;
  1942. InitImage(PreviousCache);
  1943. NewImage(SrcFrames[0].IHDR.Width, SrcFrames[0].IHDR.Height, DestFormat, PreviousCache);
  1944. for I := 0 to Len - 1 do
  1945. begin
  1946. SrcIdx := I + Offset;
  1947. NewImage(SrcFrames[SrcIdx].IHDR.Width, SrcFrames[SrcIdx].IHDR.Height,
  1948. DestFormat, DestFrames[I]);
  1949. if DestFrames[I].Format = ifIndex8 then
  1950. Move(Images[SrcIdx].Palette^, DestFrames[I].Palette^, 256 * SizeOf(TColor32));
  1951. DestCanvas.CreateForData(@DestFrames[I]);
  1952. if (SrcFrames[SrcIdx].fcTL.DisposeOp = DisposeOpPrevious) and (SrcFrames[SrcIdx - 1].fcTL.DisposeOp <> DisposeOpPrevious) then
  1953. begin
  1954. // Cache current output buffer so we may return to it later (previous dispose op)
  1955. CopyRect(DestFrames[I - 1], 0, 0, DestFrames[I - 1].Width, DestFrames[I - 1].Height,
  1956. PreviousCache, 0, 0);
  1957. end;
  1958. if (I = 0) or (SrcIdx = 0) then
  1959. begin
  1960. // Clear whole frame with transparent black color (default for first frame)
  1961. DestCanvas.FillColor32 := pcClear;
  1962. DestCanvas.Clear;
  1963. end
  1964. else if SrcFrames[SrcIdx - 1].fcTL.DisposeOp = DisposeOpBackground then
  1965. begin
  1966. // Restore background color (clear) on previous frame's area and leave previous content outside of it
  1967. CopyRect(DestFrames[I - 1], 0, 0, DestFrames[I - 1].Width, DestFrames[I - 1].Height,
  1968. DestFrames[I], 0, 0);
  1969. DestCanvas.FillColor32 := pcClear;
  1970. DestCanvas.FillRect(BoundsToRect(SrcFrames[SrcIdx - 1].fcTL.XOffset, SrcFrames[SrcIdx - 1].fcTL.YOffset,
  1971. SrcFrames[SrcIdx - 1].FrameWidth, SrcFrames[SrcIdx - 1].FrameHeight));
  1972. end
  1973. else if SrcFrames[SrcIdx - 1].fcTL.DisposeOp = DisposeOpNone then
  1974. begin
  1975. // Clone previous frame - no change to output buffer
  1976. CopyRect(DestFrames[I - 1], 0, 0, DestFrames[I - 1].Width, DestFrames[I - 1].Height,
  1977. DestFrames[I], 0, 0);
  1978. end
  1979. else if SrcFrames[SrcIdx - 1].fcTL.DisposeOp = DisposeOpPrevious then
  1980. begin
  1981. // Revert to previous frame (cached, can't just restore DestFrames[I - 2])
  1982. CopyRect(PreviousCache, 0, 0, PreviousCache.Width, PreviousCache.Height,
  1983. DestFrames[I], 0, 0);
  1984. end;
  1985. // Copy pixels or alpha blend them over
  1986. if SrcFrames[SrcIdx].fcTL.BlendOp = BlendOpSource then
  1987. begin
  1988. CopyRect(Images[SrcIdx], 0, 0, Images[SrcIdx].Width, Images[SrcIdx].Height,
  1989. DestFrames[I], SrcFrames[SrcIdx].fcTL.XOffset, SrcFrames[SrcIdx].fcTL.YOffset);
  1990. end
  1991. else if SrcFrames[SrcIdx].fcTL.BlendOp = BlendOpOver then
  1992. begin
  1993. SrcCanvas.CreateForData(@Images[SrcIdx]);
  1994. SrcCanvas.DrawAlpha(SrcCanvas.ClipRect, DestCanvas,
  1995. SrcFrames[SrcIdx].fcTL.XOffset, SrcFrames[SrcIdx].fcTL.YOffset);
  1996. end;
  1997. FreeImage(Images[SrcIdx]);
  1998. end;
  1999. DestCanvas.Free;
  2000. SrcCanvas.Free;
  2001. FreeImage(PreviousCache);
  2002. // Assign dest frames to final output images
  2003. Images := DestFrames;
  2004. end;
  2005. { TNetworkGraphicsFileFormat class implementation }
  2006. procedure TNetworkGraphicsFileFormat.Define;
  2007. begin
  2008. inherited;
  2009. FFeatures := [ffLoad, ffSave];
  2010. FPreFilter := NGDefaultPreFilter;
  2011. FCompressLevel := NGDefaultCompressLevel;
  2012. FLossyAlpha := NGDefaultLossyAlpha;
  2013. FLossyCompression := NGDefaultLossyCompression;
  2014. FQuality := NGDefaultQuality;
  2015. FProgressive := NGDefaultProgressive;
  2016. FZLibStategy := NGDefaultZLibStartegy;
  2017. end;
  2018. procedure TNetworkGraphicsFileFormat.CheckOptionsValidity;
  2019. begin
  2020. // Just check if save options has valid values
  2021. if not (FPreFilter in [0..6]) then
  2022. FPreFilter := NGDefaultPreFilter;
  2023. if not (FCompressLevel in [0..9]) then
  2024. FCompressLevel := NGDefaultCompressLevel;
  2025. if not (FQuality in [1..100]) then
  2026. FQuality := NGDefaultQuality;
  2027. end;
  2028. function TNetworkGraphicsFileFormat.GetSupportedFormats: TImageFormats;
  2029. begin
  2030. if FLossyCompression then
  2031. Result := NGLossyFormats
  2032. else
  2033. Result := NGLosslessFormats;
  2034. end;
  2035. procedure TNetworkGraphicsFileFormat.ConvertToSupported(var Image: TImageData;
  2036. const Info: TImageFormatInfo);
  2037. var
  2038. ConvFormat: TImageFormat;
  2039. begin
  2040. if not FLossyCompression then
  2041. begin
  2042. // Convert formats for lossless compression
  2043. if Info.HasGrayChannel then
  2044. begin
  2045. if Info.HasAlphaChannel then
  2046. begin
  2047. if Info.BytesPerPixel <= 2 then
  2048. // Convert <= 16bit grayscale images with alpha to ifA8Gray8
  2049. ConvFormat := ifA8Gray8
  2050. else
  2051. // Convert > 16bit grayscale images with alpha to ifA16Gray16
  2052. ConvFormat := ifA16Gray16
  2053. end
  2054. else
  2055. // Convert grayscale images without alpha to ifGray16
  2056. ConvFormat := ifGray16;
  2057. end
  2058. else
  2059. if Info.IsFloatingPoint then
  2060. // Convert floating point images to 64 bit ARGB (or RGB if no alpha)
  2061. ConvFormat := IffFormat(Info.HasAlphaChannel, ifA16B16G16R16, ifB16G16R16)
  2062. else if Info.HasAlphaChannel or Info.IsSpecial then
  2063. // Convert all other images with alpha or special images to A8R8G8B8
  2064. ConvFormat := ifA8R8G8B8
  2065. else
  2066. // Convert images without alpha to R8G8B8
  2067. ConvFormat := ifR8G8B8;
  2068. end
  2069. else
  2070. begin
  2071. // Convert formats for lossy compression
  2072. if Info.HasGrayChannel then
  2073. ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8Gray8, ifGray8)
  2074. else
  2075. ConvFormat := IffFormat(Info.HasAlphaChannel, ifA8R8G8B8, ifR8G8B8);
  2076. end;
  2077. ConvertImage(Image, ConvFormat);
  2078. end;
  2079. function TNetworkGraphicsFileFormat.TestFormat(Handle: TImagingHandle): Boolean;
  2080. var
  2081. ReadCount: LongInt;
  2082. Sig: TChar8;
  2083. begin
  2084. Result := False;
  2085. if Handle <> nil then
  2086. with GetIO do
  2087. begin
  2088. FillChar(Sig, SizeOf(Sig), 0);
  2089. ReadCount := Read(Handle, @Sig, SizeOf(Sig));
  2090. Seek(Handle, -ReadCount, smFromCurrent);
  2091. Result := (ReadCount = SizeOf(Sig)) and (Sig = FSignature);
  2092. end;
  2093. end;
  2094. { TPNGFileFormat class implementation }
  2095. procedure TPNGFileFormat.Define;
  2096. begin
  2097. inherited;
  2098. FName := SPNGFormatName;
  2099. FFeatures := FFeatures + [ffMultiImage];
  2100. FLoadAnimated := PNGDefaultLoadAnimated;
  2101. AddMasks(SPNGMasks);
  2102. FSignature := PNGSignature;
  2103. RegisterOption(ImagingPNGPreFilter, @FPreFilter);
  2104. RegisterOption(ImagingPNGCompressLevel, @FCompressLevel);
  2105. RegisterOption(ImagingPNGLoadAnimated, @FLoadAnimated);
  2106. RegisterOption(ImagingPNGZLibStrategy, @FZLibStategy);
  2107. end;
  2108. function TPNGFileFormat.LoadData(Handle: TImagingHandle;
  2109. var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
  2110. var
  2111. I, Len: LongInt;
  2112. NGFileLoader: TNGFileLoader;
  2113. begin
  2114. Result := False;
  2115. NGFileLoader := TNGFileLoader.Create(Self);
  2116. try
  2117. // Use NG file parser to load file
  2118. if NGFileLoader.LoadFile(Handle) and (Length(NGFileLoader.Frames) > 0) then
  2119. begin
  2120. Len := Length(NGFileLoader.Frames);
  2121. SetLength(Images, Len);
  2122. for I := 0 to Len - 1 do
  2123. with NGFileLoader.Frames[I] do
  2124. begin
  2125. // Build actual image bits
  2126. if not IsJpegFrame then
  2127. NGFileLoader.LoadImageFromPNGFrame(FrameWidth, FrameHeight, IHDR, IDATMemory, Images[I]);
  2128. // Build palette, aply color key or background
  2129. NGFileLoader.ApplyFrameSettings(NGFileLoader.Frames[I], Images[I]);
  2130. Result := True;
  2131. end;
  2132. // Animate APNG images
  2133. if (NGFileLoader.FileType = ngAPNG) and FLoadAnimated then
  2134. TAPNGAnimator.Animate(Images, NGFileLoader.acTL, NGFileLoader.Frames);
  2135. end;
  2136. finally
  2137. NGFileLoader.LoadMetaData; // Store metadata
  2138. NGFileLoader.Free;
  2139. end;
  2140. end;
  2141. function TPNGFileFormat.SaveData(Handle: TImagingHandle;
  2142. const Images: TDynImageDataArray; Index: LongInt): Boolean;
  2143. var
  2144. I: Integer;
  2145. ImageToSave: TImageData;
  2146. MustBeFreed: Boolean;
  2147. NGFileSaver: TNGFileSaver;
  2148. DefaultFormat: TImageFormat;
  2149. Screen: TImageData;
  2150. AnimWidth, AnimHeight: Integer;
  2151. begin
  2152. Result := False;
  2153. DefaultFormat := ifDefault;
  2154. AnimWidth := 0;
  2155. AnimHeight := 0;
  2156. NGFileSaver := TNGFileSaver.Create(Self);
  2157. // Save images with more frames as APNG format
  2158. if Length(Images) > 1 then
  2159. begin
  2160. NGFileSaver.FileType := ngAPNG;
  2161. // Get max dimensions of frames
  2162. AnimWidth := Images[FFirstIdx].Width;
  2163. AnimHeight := Images[FFirstIdx].Height;
  2164. for I := FFirstIdx + 1 to FLastIdx do
  2165. begin
  2166. AnimWidth := Max(AnimWidth, Images[I].Width);
  2167. AnimHeight := Max(AnimHeight, Images[I].Height);
  2168. end;
  2169. end
  2170. else
  2171. NGFileSaver.FileType := ngPNG;
  2172. NGFileSaver.SetFileOptions;
  2173. with NGFileSaver do
  2174. try
  2175. // Store all frames to be saved frames file saver
  2176. for I := FFirstIdx to FLastIdx do
  2177. begin
  2178. if MakeCompatible(Images[I], ImageToSave, MustBeFreed) then
  2179. try
  2180. if FileType = ngAPNG then
  2181. begin
  2182. // IHDR chunk is shared for all frames so all frames must have the
  2183. // same data format as the first image.
  2184. if I = FFirstIdx then
  2185. begin
  2186. DefaultFormat := ImageToSave.Format;
  2187. // Subsequenet frames may be bigger than the first one.
  2188. // APNG doens't support this - max allowed size is what's written in
  2189. // IHDR - size of main/default/first image. If some frame is
  2190. // bigger than the first one we need to resize (create empty bigger
  2191. // image and copy) the first frame so all following frames could fit to
  2192. // its area.
  2193. if (ImageToSave.Width <> AnimWidth) or (ImageToSave.Height <> AnimHeight) then
  2194. begin
  2195. InitImage(Screen);
  2196. NewImage(AnimWidth, AnimHeight, ImageToSave.Format, Screen);
  2197. CopyRect(ImageToSave, 0, 0, ImageToSave.Width, ImageToSave.Height, Screen, 0, 0);
  2198. if MustBeFreed then
  2199. FreeImage(ImageToSave);
  2200. ImageToSave := Screen;
  2201. end;
  2202. end
  2203. else if ImageToSave.Format <> DefaultFormat then
  2204. begin
  2205. if MustBeFreed then
  2206. ConvertImage(ImageToSave, DefaultFormat)
  2207. else
  2208. begin
  2209. CloneImage(Images[I], ImageToSave);
  2210. ConvertImage(ImageToSave, DefaultFormat);
  2211. MustBeFreed := True;
  2212. end;
  2213. end;
  2214. end;
  2215. // Add image as PNG frame
  2216. AddFrame(ImageToSave, False);
  2217. finally
  2218. if MustBeFreed then
  2219. FreeImage(ImageToSave);
  2220. end
  2221. else
  2222. Exit;
  2223. end;
  2224. // Finally save PNG file
  2225. SaveFile(Handle);
  2226. Result := True;
  2227. finally
  2228. NGFileSaver.Free;
  2229. end;
  2230. end;
  2231. {$IFNDEF DONT_LINK_MNG}
  2232. { TMNGFileFormat class implementation }
  2233. procedure TMNGFileFormat.Define;
  2234. begin
  2235. inherited;
  2236. FName := SMNGFormatName;
  2237. FFeatures := FFeatures + [ffMultiImage];
  2238. AddMasks(SMNGMasks);
  2239. FSignature := MNGSignature;
  2240. RegisterOption(ImagingMNGLossyCompression, @FLossyCompression);
  2241. RegisterOption(ImagingMNGLossyAlpha, @FLossyAlpha);
  2242. RegisterOption(ImagingMNGPreFilter, @FPreFilter);
  2243. RegisterOption(ImagingMNGCompressLevel, @FCompressLevel);
  2244. RegisterOption(ImagingMNGQuality, @FQuality);
  2245. RegisterOption(ImagingMNGProgressive, @FProgressive);
  2246. end;
  2247. function TMNGFileFormat.LoadData(Handle: TImagingHandle;
  2248. var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
  2249. var
  2250. NGFileLoader: TNGFileLoader;
  2251. I, Len: LongInt;
  2252. begin
  2253. Result := False;
  2254. NGFileLoader := TNGFileLoader.Create(Self);
  2255. try
  2256. // Use NG file parser to load file
  2257. if NGFileLoader.LoadFile(Handle) then
  2258. begin
  2259. Len := Length(NGFileLoader.Frames);
  2260. if Len > 0 then
  2261. begin
  2262. SetLength(Images, Len);
  2263. for I := 0 to Len - 1 do
  2264. with NGFileLoader.Frames[I] do
  2265. begin
  2266. // Build actual image bits
  2267. if IsJpegFrame then
  2268. NGFileLoader.LoadImageFromJNGFrame(FrameWidth, FrameHeight, JHDR, IDATMemory, JDATMemory, JDAAMemory, Images[I])
  2269. else
  2270. NGFileLoader.LoadImageFromPNGFrame(FrameWidth, FrameHeight, IHDR, IDATMemory, Images[I]);
  2271. // Build palette, aply color key or background
  2272. NGFileLoader.ApplyFrameSettings(NGFileLoader.Frames[I], Images[I]);
  2273. end;
  2274. end
  2275. else
  2276. begin
  2277. // Some MNG files (with BASI-IEND streams) dont have actual pixel data
  2278. SetLength(Images, 1);
  2279. NewImage(NGFileLoader.MHDR.FrameWidth, NGFileLoader.MHDR.FrameWidth, ifDefault, Images[0]);
  2280. end;
  2281. Result := True;
  2282. end;
  2283. finally
  2284. NGFileLoader.LoadMetaData; // Store metadata
  2285. NGFileLoader.Free;
  2286. end;
  2287. end;
  2288. function TMNGFileFormat.SaveData(Handle: TImagingHandle;
  2289. const Images: TDynImageDataArray; Index: LongInt): Boolean;
  2290. var
  2291. NGFileSaver: TNGFileSaver;
  2292. I, LargestWidth, LargestHeight: LongInt;
  2293. ImageToSave: TImageData;
  2294. MustBeFreed: Boolean;
  2295. begin
  2296. Result := False;
  2297. LargestWidth := 0;
  2298. LargestHeight := 0;
  2299. NGFileSaver := TNGFileSaver.Create(Self);
  2300. NGFileSaver.FileType := ngMNG;
  2301. NGFileSaver.SetFileOptions;
  2302. with NGFileSaver do
  2303. try
  2304. // Store all frames to be saved frames file saver
  2305. for I := FFirstIdx to FLastIdx do
  2306. begin
  2307. if MakeCompatible(Images[I], ImageToSave, MustBeFreed) then
  2308. try
  2309. // Add image as PNG or JNG frame
  2310. AddFrame(ImageToSave, FLossyCompression);
  2311. // Remember largest frame width and height
  2312. LargestWidth := Iff(LargestWidth < ImageToSave.Width, ImageToSave.Width, LargestWidth);
  2313. LargestHeight := Iff(LargestHeight < ImageToSave.Height, ImageToSave.Height, LargestHeight);
  2314. finally
  2315. if MustBeFreed then
  2316. FreeImage(ImageToSave);
  2317. end
  2318. else
  2319. Exit;
  2320. end;
  2321. // Fill MNG header
  2322. MHDR.FrameWidth := LargestWidth;
  2323. MHDR.FrameHeight := LargestHeight;
  2324. MHDR.TicksPerSecond := 0;
  2325. MHDR.NominalLayerCount := 0;
  2326. MHDR.NominalFrameCount := Length(Frames);
  2327. MHDR.NominalPlayTime := 0;
  2328. MHDR.SimplicityProfile := 473; // 111011001 binary, defines MNG-VLC with transparency and JNG support
  2329. // Finally save MNG file
  2330. SaveFile(Handle);
  2331. Result := True;
  2332. finally
  2333. NGFileSaver.Free;
  2334. end;
  2335. end;
  2336. {$ENDIF}
  2337. {$IFNDEF DONT_LINK_JNG}
  2338. { TJNGFileFormat class implementation }
  2339. procedure TJNGFileFormat.Define;
  2340. begin
  2341. inherited;
  2342. FName := SJNGFormatName;
  2343. AddMasks(SJNGMasks);
  2344. FSignature := JNGSignature;
  2345. FLossyCompression := True;
  2346. RegisterOption(ImagingJNGLossyAlpha, @FLossyAlpha);
  2347. RegisterOption(ImagingJNGAlphaPreFilter, @FPreFilter);
  2348. RegisterOption(ImagingJNGAlphaCompressLevel, @FCompressLevel);
  2349. RegisterOption(ImagingJNGQuality, @FQuality);
  2350. RegisterOption(ImagingJNGProgressive, @FProgressive);
  2351. end;
  2352. function TJNGFileFormat.LoadData(Handle: TImagingHandle;
  2353. var Images: TDynImageDataArray; OnlyFirstLevel: Boolean): Boolean;
  2354. var
  2355. NGFileLoader: TNGFileLoader;
  2356. begin
  2357. Result := False;
  2358. NGFileLoader := TNGFileLoader.Create(Self);
  2359. try
  2360. // Use NG file parser to load file
  2361. if NGFileLoader.LoadFile(Handle) and (Length(NGFileLoader.Frames) > 0) then
  2362. with NGFileLoader.Frames[0] do
  2363. begin
  2364. SetLength(Images, 1);
  2365. // Build actual image bits
  2366. if IsJpegFrame then
  2367. NGFileLoader.LoadImageFromJNGFrame(FrameWidth, FrameHeight, JHDR, IDATMemory, JDATMemory, JDAAMemory, Images[0]);
  2368. // Build palette, aply color key or background
  2369. NGFileLoader.ApplyFrameSettings(NGFileLoader.Frames[0], Images[0]);
  2370. Result := True;
  2371. end;
  2372. finally
  2373. NGFileLoader.LoadMetaData; // Store metadata
  2374. NGFileLoader.Free;
  2375. end;
  2376. end;
  2377. function TJNGFileFormat.SaveData(Handle: TImagingHandle;
  2378. const Images: TDynImageDataArray; Index: LongInt): Boolean;
  2379. var
  2380. NGFileSaver: TNGFileSaver;
  2381. ImageToSave: TImageData;
  2382. MustBeFreed: Boolean;
  2383. begin
  2384. // Make image JNG compatible, store it in saver, and save it to file
  2385. Result := MakeCompatible(Images[Index], ImageToSave, MustBeFreed);
  2386. if Result then
  2387. begin
  2388. NGFileSaver := TNGFileSaver.Create(Self);
  2389. with NGFileSaver do
  2390. try
  2391. FileType := ngJNG;
  2392. SetFileOptions;
  2393. AddFrame(ImageToSave, True);
  2394. SaveFile(Handle);
  2395. finally
  2396. // Free NG saver and compatible image
  2397. NGFileSaver.Free;
  2398. if MustBeFreed then
  2399. FreeImage(ImageToSave);
  2400. end;
  2401. end;
  2402. end;
  2403. {$ENDIF}
  2404. initialization
  2405. RegisterImageFileFormat(TPNGFileFormat);
  2406. {$IFNDEF DONT_LINK_MNG}
  2407. RegisterImageFileFormat(TMNGFileFormat);
  2408. {$ENDIF}
  2409. {$IFNDEF DONT_LINK_JNG}
  2410. RegisterImageFileFormat(TJNGFileFormat);
  2411. {$ENDIF}
  2412. finalization
  2413. {
  2414. File Notes:
  2415. -- TODOS ----------------------------------------------------
  2416. - nothing now
  2417. -- 0.77 Changes/Bug Fixes -----------------------------------
  2418. - Reads and writes APNG animation loop count metadata.
  2419. - Writes frame delays of APNG from metadata.
  2420. - Fixed color keys in 8bit depth PNG/MNG loading.
  2421. - Fixed needless (and sometimes buggy) conversion to format with alpha
  2422. channel in FPC (GetMem(0) <> nil!).
  2423. - Added support for optional ZLib compression strategy.
  2424. - Added loading and saving of ifBinary (1bit black and white)
  2425. format images. During loading grayscale 1bpp and indexed 1bpp
  2426. (with only black and white colors in palette) are treated as ifBinary.
  2427. ifBinary are saved as 1bpp grayscale PNGs.
  2428. -- 0.26.5 Changes/Bug Fixes ---------------------------------
  2429. - Reads frame delays from APNG files into metadata.
  2430. - Added loading and saving of metadata from these chunks: pHYs.
  2431. - Simplified decoding of 1/2/4 bit images a bit (less code).
  2432. -- 0.26.3 Changes/Bug Fixes ---------------------------------
  2433. - Added APNG saving support.
  2434. - Added APNG support to NG loader and animating to PNG loader.
  2435. -- 0.26.1 Changes/Bug Fixes ---------------------------------
  2436. - Changed file format conditional compilation to reflect changes
  2437. in LINK symbols.
  2438. -- 0.24.3 Changes/Bug Fixes ---------------------------------
  2439. - Changes for better thread safety.
  2440. -- 0.23 Changes/Bug Fixes -----------------------------------
  2441. - Added loading of global palettes and transparencies in MNG files
  2442. (and by doing so fixed crash when loading images with global PLTE or tRNS).
  2443. -- 0.21 Changes/Bug Fixes -----------------------------------
  2444. - Small changes in converting to supported formats.
  2445. - MakeCompatible method moved to base class, put ConvertToSupported here.
  2446. GetSupportedFormats removed, it is now set in constructor.
  2447. - Made public properties for options registered to SetOption/GetOption
  2448. functions.
  2449. - Changed extensions to filename masks.
  2450. - Changed SaveData, LoadData, and MakeCompatible methods according
  2451. to changes in base class in Imaging unit.
  2452. -- 0.17 Changes/Bug Fixes -----------------------------------
  2453. - MNG and JNG support added, PNG support redesigned to support NG file handlers
  2454. - added classes for working with NG file formats
  2455. - stuff from old ImagingPng unit added and that unit was deleted
  2456. - unit created and initial stuff added
  2457. -- 0.15 Changes/Bug Fixes -----------------------------------
  2458. - when saving indexed images save alpha to tRNS?
  2459. - added some defines and ifdefs to dzlib unit to allow choosing
  2460. impaszlib, fpc's paszlib, zlibex or other zlib implementation
  2461. - added colorkeying support
  2462. - fixed 16bit channel image handling - pixels were not swapped
  2463. - fixed arithmetic overflow (in paeth filter) in FPC
  2464. - data of unknown chunks are skipped and not needlesly loaded
  2465. -- 0.13 Changes/Bug Fixes -----------------------------------
  2466. - adaptive filtering added to PNG saving
  2467. - TPNGFileFormat class added
  2468. }
  2469. end.