DEADSOFTWARE

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