DEADSOFTWARE

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