2 $Id: ImagingNetworkGraphics.pas 171 2009-09-02 01:34:19Z galfar $
3 Vampyre Imaging Library
5 http://imaginglib.sourceforge.net
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
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.
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.
26 For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
29 { This unit contains image format loaders/savers for Network Graphics image
30 file formats PNG, MNG, and JNG.}
31 unit ImagingNetworkGraphics
;
35 {$I ImagingOptions.inc}
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}
44 Types
, SysUtils
, Classes
, ImagingTypes
, Imaging
, ImagingUtility
, ImagingFormats
, dzlib
;
47 { Basic class for Network Graphics file formats loaders/savers.}
48 TNetworkGraphicsFileFormat
= class(TImageFileFormat
)
52 FCompressLevel
: LongInt;
53 FLossyCompression
: LongBool;
54 FLossyAlpha
: LongBool;
56 FProgressive
: LongBool;
57 function GetSupportedFormats
: TImageFormats
; override;
58 procedure ConvertToSupported(var Image
: TImageData
;
59 const Info
: TImageFormatInfo
); override;
61 constructor Create
; override;
62 function TestFormat(Handle
: TImagingHandle
): Boolean; override;
63 procedure CheckOptionsValidity
; override;
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.
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).
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).
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).
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
;
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.
98 Supported ancillary chunks (loading):
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
104 TPNGFileFormat
= class(TNetworkGraphicsFileFormat
)
106 FLoadAnimated
: LongBool;
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;
113 constructor Create
; override;
115 property LoadAnimated
: LongBool read FLoadAnimated write FLoadAnimated
;
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,
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.
131 Many frame compression settings can be modified by options interface.}
132 TMNGFileFormat
= class(TNetworkGraphicsFileFormat
)
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;
139 constructor Create
; override;
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.
152 Supported ancillary chunks (loading):
154 (Images with transparency are converted to formats with alpha
155 and pixels with transparent color are replaced with background color
157 TJNGFileFormat
= class(TNetworkGraphicsFileFormat
)
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;
164 constructor Create
; override;
172 {$IFNDEF DONT_LINK_JNG}
173 ImagingJpeg
, ImagingIO
,
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
,
187 NGLossyFormats
: TImageFormats
= [ifGray8
, ifA8Gray8
, ifR8G8B8
, ifA8R8G8B8
];
188 PNGDefaultLoadAnimated
= True;
190 SPNGFormatName
= 'Portable Network Graphics';
192 SMNGFormatName
= 'Multiple Network Graphics';
194 SJNGFormatName
= 'JPEG Network Graphics';
198 SErrorLoadingChunk
= 'Error when reading %s chunk data. File may be corrupted.';
202 TChunkHeader
= packed record
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
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
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
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)
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
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;
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';
300 { APNG frame dispose operations.}
302 DisposeOpBackground
= 1;
303 DisposeOpPrevious
= 2;
305 { APNG frame blending modes}
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);
316 { Helper class that holds information about MNG frame in PNG or JNG format.}
317 TFrameInfo
= class(TObject
)
319 FrameWidth
, FrameHeight
: LongInt;
320 IsJpegFrame
: Boolean;
325 PaletteEntries
: LongInt;
326 Transparency
: Pointer;
327 TransparencySize
: LongInt;
329 BackgroundSize
: LongInt;
330 IDATMemory
: TMemoryStream
;
331 JDATMemory
: TMemoryStream
;
332 JDAAMemory
: TMemoryStream
;
334 destructor Destroy
; override;
335 procedure AssignSharedProps(Source
: TFrameInfo
);
338 { Defines type of Network Graphics file.}
339 TNGFileType
= (ngPNG
, ngAPNG
, ngMNG
, ngJNG
);
341 TNGFileHandler
= class(TObject
)
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;
353 function GetLastFrame
: TFrameInfo
;
354 function AddFrameInfo
: TFrameInfo
;
357 { Network Graphics file parser and frame converter.}
358 TNGFileLoader
= class(TNGFileHandler
)
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
);
365 procedure ApplyFrameSettings(Frame
: TFrameInfo
; var Image
: TImageData
);
368 TNGFileSaver
= class(TNGFileHandler
)
371 CompressLevel
: 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
);
381 procedure SetFileOptions(FileFormat
: TNetworkGraphicsFileFormat
);
384 {$IFNDEF DONT_LINK_JNG}
385 TCustomIOJpegFileFormat
= class(TJpegFileFormat
)
387 FCustomIO
: TIOFunctions
;
388 procedure SetJpegIO(const JpegIO
: TIOFunctions
); override;
389 procedure SetCustomIO(const CustomIO
: TIOFunctions
);
393 TAPNGAnimator
= class
395 class procedure Animate(var Images
: TDynImageDataArray
; const acTL
: TacTL
; const SrcFrames
: array of TFrameInfo
);
400 function PaethPredictor(A
, B
, C
: LongInt): LongInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
402 P
, PA
, PB
, PC
: LongInt;
408 if (PA
<= PB
) and (PA
<= PC
) then
417 procedure SwapRGB(Line
: PByte; Width
, SampleDepth
, BytesPerPixel
: LongInt);
424 for I
:= 0 to Width
- 1 do
425 with PColor24Rec(Line
)^ do
430 Inc(Line
, BytesPerPixel
);
433 for I
:= 0 to Width
- 1 do
434 with PColor48Rec(Line
)^ do
439 Inc(Line
, BytesPerPixel
);
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);
453 function Get1BitPixel(Line
: PByteArray
; X
: LongInt): Byte;
455 Result
:= (Line
[X
shr 3] and Mask1
[X
and 7]) shr
459 function Get2BitPixel(Line
: PByteArray
; X
: LongInt): Byte;
461 Result
:= (Line
[X
shr 2] and Mask2
[X
and 3]) shr
465 function Get4BitPixel(Line
: PByteArray
; X
: LongInt): Byte;
467 Result
:= (Line
[X
shr 1] and Mask4
[X
and 1]) shr
471 {$IFNDEF DONT_LINK_JNG}
473 { TCustomIOJpegFileFormat class implementation }
475 procedure TCustomIOJpegFileFormat
.SetCustomIO(const CustomIO
: TIOFunctions
);
477 FCustomIO
:= CustomIO
;
480 procedure TCustomIOJpegFileFormat
.SetJpegIO(const JpegIO
: TIOFunctions
);
482 inherited SetJpegIO(FCustomIO
);
487 { TFrameInfo class implementation }
489 constructor TFrameInfo
.Create
;
491 IDATMemory
:= TMemoryStream
.Create
;
492 JDATMemory
:= TMemoryStream
.Create
;
493 JDAAMemory
:= TMemoryStream
.Create
;
496 destructor TFrameInfo
.Destroy
;
499 FreeMem(Transparency
);
507 procedure TFrameInfo
.AssignSharedProps(Source
: TFrameInfo
);
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
);
519 { TNGFileHandler class implementation}
521 destructor TNGFileHandler
.Destroy
;
527 procedure TNGFileHandler
.Clear
;
531 for I
:= 0 to Length(Frames
) - 1 do
533 SetLength(Frames
, 0);
534 FreeMemNil(GlobalPalette
);
535 GlobalPaletteEntries
:= 0;
536 FreeMemNil(GlobalTransparency
);
537 GlobalTransparencySize
:= 0;
540 function TNGFileHandler
.GetLastFrame
: TFrameInfo
;
544 Len
:= Length(Frames
);
546 Result
:= Frames
[Len
- 1]
551 function TNGFileHandler
.AddFrameInfo
: TFrameInfo
;
555 Len
:= Length(Frames
);
556 SetLength(Frames
, Len
+ 1);
557 Result
:= TFrameInfo
.Create
;
558 Frames
[Len
] := Result
;
561 { TNGFileLoader class implementation}
563 function TNGFileLoader
.LoadFile(Handle
: TImagingHandle
): Boolean;
572 GetIO
.Read(Handle
, @Chunk
, SizeOf(Chunk
));
573 Chunk
.DataSize
:= SwapEndianLongWord(Chunk
.DataSize
);
576 procedure ReadChunkData
;
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
)]);
588 procedure SkipChunkData
;
590 GetIO
.Seek(Handle
, Chunk
.DataSize
+ SizeOf(ChunkCrc
), smFromCurrent
);
593 procedure StartNewPNGImage
;
599 if Chunk
.ChunkID
= fcTLChunk
then
601 if (Length(Frames
) = 1) and (Frames
[0].IDATMemory
.Size
= 0) then
603 // First fcTL chunk maybe for first IDAT frame which is alredy created
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]);
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
;
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
;
629 Frame
.IsJpegFrame
:= False;
632 procedure StartNewJNGImage
;
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
;
645 procedure AppendIDAT
;
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));
655 procedure AppendJDAT
;
658 // Append current JDAT chunk to storage stream
659 GetLastFrame
.JDATMemory
.Write(ChunkData
^, Chunk
.DataSize
);
662 procedure AppendJDAA
;
665 // Append current JDAA chunk to storage stream
666 GetLastFrame
.JDAAMemory
.Write(ChunkData
^, Chunk
.DataSize
);
672 if GetLastFrame
= nil then
674 // Load global palette
675 GetMem(GlobalPalette
, Chunk
.DataSize
);
676 Move(ChunkData
^, GlobalPalette
^, Chunk
.DataSize
);
677 GlobalPaletteEntries
:= Chunk
.DataSize
div 3;
679 else if GetLastFrame
.Palette
= nil then
681 if (Chunk
.DataSize
= 0) and (GlobalPalette
<> nil) then
683 // Use global palette
684 GetMem(GetLastFrame
.Palette
, GlobalPaletteEntries
* SizeOf(TColor24Rec
));
685 Move(GlobalPalette
^, GetLastFrame
.Palette
^, GlobalPaletteEntries
* SizeOf(TColor24Rec
));
686 GetLastFrame
.PaletteEntries
:= GlobalPaletteEntries
;
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;
701 if GetLastFrame
= nil then
703 // Load global transparency
704 GetMem(GlobalTransparency
, Chunk
.DataSize
);
705 Move(ChunkData
^, GlobalTransparency
^, Chunk
.DataSize
);
706 GlobalTransparencySize
:= Chunk
.DataSize
;
708 else if GetLastFrame
.Transparency
= nil then
710 if (Chunk
.DataSize
= 0) and (GlobalTransparency
<> nil) then
712 // Use global transparency
713 GetMem(GetLastFrame
.Transparency
, GlobalTransparencySize
);
714 Move(GlobalTransparency
^, GetLastFrame
.Transparency
^, Chunk
.DataSize
);
715 GetLastFrame
.TransparencySize
:= GlobalTransparencySize
;
719 // Load pal from tRNS chunk
720 GetMem(GetLastFrame
.Transparency
, Chunk
.DataSize
);
721 Move(ChunkData
^, GetLastFrame
.Transparency
^, Chunk
.DataSize
);
722 GetLastFrame
.TransparencySize
:= Chunk
.DataSize
;
730 if GetLastFrame
.Background
= nil then
732 GetMem(GetLastFrame
.Background
, Chunk
.DataSize
);
733 Move(ChunkData
^, GetLastFrame
.Background
^, Chunk
.DataSize
);
734 GetLastFrame
.BackgroundSize
:= Chunk
.DataSize
;
738 procedure HandleacTL
;
742 acTL
:= PacTL(ChunkData
)^;
743 SwapEndianLongWord(@acTL
, SizeOf(acTL
) div SizeOf(LongWord));
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
759 if FileType
= ngMNG
then
761 // Store MNG header if present
764 MHDR
:= PMHDR(ChunkData
)^;
765 SwapEndianLongWord(@MHDR
, SizeOf(MHDR
) div SizeOf(LongWord));
768 // Read chunks until ending chunk or EOF is reached
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
781 until Eof(Handle
) or (Chunk
.ChunkID
= MENDChunk
) or
782 ((FileType
<> ngMNG
) and (Chunk
.ChunkID
= IENDChunk
));
786 FreeMemNil(ChunkData
);
790 procedure TNGFileLoader
.LoadImageFromPNGFrame(FrameWidth
, FrameHeight
: LongInt; const IHDR
: TIHDR
;
791 IDATStream
: TMemoryStream
; var Image
: TImageData
);
793 TGetPixelFunc
= function(Line
: PByteArray
; X
: LongInt): Byte;
795 LineBuffer
: array[Boolean] of PByteArray
;
797 Data
, TotalBuffer
, ZeroLine
, PrevLine
: Pointer;
798 BitCount
, TotalSize
, TotalPos
, BytesPerPixel
, I
, Pass
,
799 SrcDataSize
, BytesPerLine
, InterlaceLineBytes
, InterlaceWidth
: LongInt;
801 procedure DecodeAdam7
;
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);
806 Src
, Dst
, Dst2
: PByte;
807 CurBit
, Col
: LongInt;
809 Src
:= @LineBuffer
[ActLine
][1];
810 Col
:= ColumnStart
[Pass
];
815 Dst
:= @PByteArray(Data
)[I
* BytesPerLine
];
817 CurBit
:= StartBit
[BitCount
];
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
);
830 Dst
:= @PByteArray(Data
)[I
* BytesPerLine
+ Col
* BytesPerPixel
];
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
]);
842 procedure FilterScanline(Filter
: Byte; BytesPerPixel
: LongInt; Line
, PrevLine
, Target
: PByteArray
;
843 BytesPerLine
: LongInt);
851 Move(Line
^, Target
^, BytesPerLine
);
856 Move(Line
^, Target
^, BytesPerPixel
);
857 for I
:= BytesPerPixel
to BytesPerLine
- 1 do
858 Target
[I
] := (Line
[I
] + Target
[I
- BytesPerPixel
]) and $FF;
863 for I
:= 0 to BytesPerLine
- 1 do
864 Target
[I
] := (Line
[I
] + PrevLine
[I
]) and $FF;
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;
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;
885 procedure Convert124To8(DataIn
: Pointer; DataOut
: Pointer; Width
, Height
,
886 WidthBytes
: LongInt; Indexed
: Boolean);
889 GetPixel
: TGetPixelFunc
;
891 GetPixel
:= Get1BitPixel
;
893 case IHDR
.BitDepth
of
897 GetPixel
:= Get2BitPixel
;
902 GetPixel
:= Get4BitPixel
;
905 if Indexed
then Mul
:= 1;
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
;
913 procedure TransformLOCOToRGB(Data
: PByte; NumPixels
, BytesPerPixel
: LongInt);
917 for I
:= 0 to NumPixels
- 1 do
919 if IHDR
.BitDepth
= 8 then
921 PColor32Rec(Data
).R
:= Byte(PColor32Rec(Data
).R
+ PColor32Rec(Data
).G
);
922 PColor32Rec(Data
).B
:= Byte(PColor32Rec(Data
).B
+ PColor32Rec(Data
).G
);
926 PColor64Rec(Data
).R
:= Word(PColor64Rec(Data
).R
+ PColor64Rec(Data
).G
);
927 PColor64Rec(Data
).B
:= Word(PColor64Rec(Data
).B
+ PColor64Rec(Data
).G
);
929 Inc(Data
, BytesPerPixel
);
934 Image
.Width
:= FrameWidth
;
935 Image
.Height
:= FrameHeight
;
936 Image
.Format
:= ifUnknown
;
938 case IHDR
.ColorType
of
942 case IHDR
.BitDepth
of
943 1, 2, 4, 8: Image
.Format
:= ifGray8
;
944 16: Image
.Format
:= ifGray16
;
946 BitCount
:= IHDR
.BitDepth
;
951 case IHDR
.BitDepth
of
952 8: Image
.Format
:= ifR8G8B8
;
953 16: Image
.Format
:= ifR16G16B16
;
955 BitCount
:= IHDR
.BitDepth
* 3;
960 case IHDR
.BitDepth
of
961 1, 2, 4, 8: Image
.Format
:= ifIndex8
;
963 BitCount
:= IHDR
.BitDepth
;
967 // Grayscale + alpha image
968 case IHDR
.BitDepth
of
969 8: Image
.Format
:= ifA8Gray8
;
970 16: Image
.Format
:= ifA16Gray16
;
972 BitCount
:= IHDR
.BitDepth
* 2;
977 case IHDR
.BitDepth
of
978 8: Image
.Format
:= ifA8R8G8B8
;
979 16: Image
.Format
:= ifA16R16G16B16
;
981 BitCount
:= IHDR
.BitDepth
* 4;
986 LineBuffer
[True] := nil;
987 LineBuffer
[False] := nil;
990 BytesPerPixel
:= (BitCount
+ 7) div 8;
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);
1001 if IHDR
.Interlacing
= 1 then
1003 // Decode interlaced images
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
1011 // Prepare next interlace run
1012 if Width
<= ColumnStart
[Pass
] then
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);
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
1035 ActLine
:= not ActLine
;
1036 // Continue with next row in interlaced order
1037 Inc(I
, RowIncrement
[Pass
]);
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
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
];
1061 Size
:= Width
* Height
* BytesPerPixel
;
1063 if Size
<> SrcDataSize
then
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)
1068 case IHDR
.ColorType
of
1069 0: Convert124To8(Data
, Bits
, Width
, Height
, BytesPerLine
, False);
1070 3: Convert124To8(Data
, Bits
, Width
, Height
, BytesPerLine
, True);
1076 // If source data size is the same as size of
1077 // image Bits in assigned format we simply copy pointer reference
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
);
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));
1089 FreeMem(LineBuffer
[True]);
1090 FreeMem(LineBuffer
[False]);
1091 FreeMem(TotalBuffer
);
1096 {$IFNDEF DONT_LINK_JNG}
1098 procedure TNGFileLoader
.LoadImageFromJNGFrame(FrameWidth
, FrameHeight
: LongInt; const JHDR
: TJHDR
; IDATStream
,
1099 JDATStream
, JDAAStream
: TMemoryStream
; var Image
: TImageData
);
1101 AlphaImage
: TImageData
;
1103 FmtInfo
: TImageFormatInfo
;
1107 ColorPtr
: PColor32Rec
;
1109 procedure LoadJpegFromStream(Stream
: TStream
; var DestImage
: TImageData
);
1111 JpegFormat
: TCustomIOJpegFileFormat
;
1112 Handle
: TImagingHandle
;
1113 DynImages
: TDynImageDataArray
;
1115 if JHDR
.SampleDepth
<> 12 then
1117 JpegFormat
:= TCustomIOJpegFileFormat
.Create
;
1118 JpegFormat
.SetCustomIO(StreamIO
);
1119 Stream
.Position
:= 0;
1120 Handle
:= StreamIO
.OpenRead(Pointer(Stream
));
1122 JpegFormat
.LoadData(Handle
, DynImages
, True);
1123 DestImage
:= DynImages
[0];
1125 StreamIO
.Close(Handle
);
1127 SetLength(DynImages
, 0);
1131 NewImage(FrameWidth
, FrameHeight
, ifR8G8B8
, DestImage
);
1135 LoadJpegFromStream(JDATStream
, Image
);
1137 // If present separate alpha channel is processed
1138 if (JHDR
.ColorType
in [12, 14]) and (Image
.Format
in [ifGray8
, ifR8G8B8
]) then
1140 InitImage(AlphaImage
);
1141 if JHDR
.AlphaCompression
= 0 then
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
;
1151 LoadImageFromPNGFrame(FrameWidth
, FrameHeight
, FakeIHDR
, IDATStream
, AlphaImage
);
1155 // Alpha channel is JPEG compressed
1156 LoadJpegFromStream(JDAAStream
, AlphaImage
);
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
);
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
);
1168 // Convert image to fromat with alpha channel
1169 if Image
.Format
= ifGray8
then
1170 ConvertImage(Image
, ifA8Gray8
)
1172 ConvertImage(Image
, ifA8R8G8B8
);
1174 // Combine alpha channel with image
1175 AlphaPtr
:= AlphaImage
.Bits
;
1176 if Image
.Format
= ifA8Gray8
then
1178 GrayPtr
:= Image
.Bits
;
1179 for I
:= 0 to Image
.Width
* Image
.Height
- 1 do
1181 GrayPtr
.High
:= AlphaPtr
^;
1188 ColorPtr
:= Image
.Bits
;
1189 for I
:= 0 to Image
.Width
* Image
.Height
- 1 do
1191 ColorPtr
.A
:= AlphaPtr
^;
1197 FreeImage(AlphaImage
);
1203 procedure TNGFileLoader
.ApplyFrameSettings(Frame
: TFrameInfo
; var Image
: TImageData
);
1205 FmtInfo
: TImageFormatInfo
;
1206 BackGroundColor
: TColor64Rec
;
1207 ColorKey
: TColor64Rec
;
1209 AlphasSize
: LongInt;
1210 IsColorKeyPresent
: Boolean;
1211 IsBackGroundPresent
: Boolean;
1212 IsColorFormat
: Boolean;
1214 procedure ConverttRNS
;
1216 if FmtInfo
.IsIndexed
then
1218 if Alphas
= nil then
1220 GetMem(Alphas
, Frame
.TransparencySize
);
1221 Move(Frame
.Transparency
^, Alphas
^, Frame
.TransparencySize
);
1222 AlphasSize
:= Frame
.TransparencySize
;
1225 else if not FmtInfo
.HasAlphaChannel
then
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);
1239 IsColorKeyPresent
:= True;
1243 procedure ConvertbKGD
;
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);
1258 IsBackGroundPresent
:= True;
1261 procedure ReconstructPalette
;
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
1274 R
:= Frame
.Palette
[I
].B
;
1275 G
:= Frame
.Palette
[I
].G
;
1276 B
:= Frame
.Palette
[I
].R
;
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
];
1285 procedure ApplyColorKey
;
1287 DestFmt
: TImageFormat
;
1288 OldPixel
, NewPixel
: Pointer;
1290 case Image
.Format
of
1291 ifGray8
: DestFmt
:= ifA8Gray8
;
1292 ifGray16
: DestFmt
:= ifA16Gray16
;
1293 ifR8G8B8
: DestFmt
:= ifA8R8G8B8
;
1294 ifR16G16B16
: DestFmt
:= ifA16R16G16B16
;
1296 DestFmt
:= ifUnknown
;
1298 if DestFmt
<> ifUnknown
then
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
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
);
1315 ColorKey
.G
:= $FFFF;
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
);
1329 ColorKey
.A
:= $FFFF;
1332 ReplaceColor(Image
, 0, 0, Image
.Width
, Image
.Height
, OldPixel
, NewPixel
);
1338 IsColorKeyPresent
:= False;
1339 IsBackGroundPresent
:= False;
1340 GetImageFormatInfo(Image
.Format
, FmtInfo
);
1342 IsColorFormat
:= (Frame
.IsJpegFrame
and (Frame
.JHDR
.ColorType
in [10, 14])) or
1343 (not Frame
.IsJpegFrame
and (Frame
.IHDR
.ColorType
in [2, 6]));
1345 // Convert some chunk data to useful format
1346 if Frame
.Transparency
<> nil then
1348 if Frame
.Background
<> nil then
1351 // Build palette for indexed images
1352 if FmtInfo
.IsIndexed
then
1355 // Apply color keying
1356 if IsColorKeyPresent
and not FmtInfo
.HasAlphaChannel
then
1362 { TNGFileSaver class implementation }
1364 procedure TNGFileSaver
.StoreImageToPNGFrame(const IHDR
: TIHDR
; Bits
: Pointer;
1365 FmtInfo
: TImageFormatInfo
; IDATStream
: TMemoryStream
);
1367 TotalBuffer
, CompBuffer
, ZeroLine
, PrevLine
: Pointer;
1368 FilterLines
: array[0..4] of PByteArray
;
1369 TotalSize
, CompSize
, I
, BytesPerLine
, BytesPerPixel
: LongInt;
1373 procedure FilterScanline(Filter
: Byte; BytesPerPixel
: LongInt; Line
, PrevLine
, Target
: PByteArray
);
1381 Move(Line
^, Target
^, BytesPerLine
);
1386 Move(Line
^, Target
^, BytesPerPixel
);
1387 for I
:= BytesPerPixel
to BytesPerLine
- 1 do
1388 Target
[I
] := (Line
[I
] - Line
[I
- BytesPerPixel
]) and $FF;
1393 for I
:= 0 to BytesPerLine
- 1 do
1394 Target
[I
] := (Line
[I
] - PrevLine
[I
]) and $FF;
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;
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;
1415 procedure AdaptiveFilter(var Filter
: Byte; BytesPerPixel
: LongInt; Line
, PrevLine
, Target
: PByteArray
);
1417 I
, J
, BestTest
: LongInt;
1418 Sums
: array[0..4] of LongInt;
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);
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
1433 BestTest
:= Sums
[I
];
1436 Move(FilterLines
[Filter
]^, Target
^, BytesPerLine
);
1440 // Select precompression filter and compression level
1445 if not ((IHDR
.BitDepth
< 8) or (IHDR
.ColorType
= 3))
1446 then Adaptive
:= True;
1447 0..4: Filter
:= PreFilter
;
1449 if IHDR
.ColorType
in [2, 6] then
1452 // Prepare data for compression
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);
1463 GetMem(FilterLines
[I
], BytesPerLine
);
1464 PrevLine
:= ZeroLine
;
1466 // Process next scanlines
1467 for I
:= 0 to IHDR
.Height
- 1 do
1471 AdaptiveFilter(Filter
, BytesPerPixel
, @PByteArray(Bits
)[I
* BytesPerLine
],
1472 PrevLine
, @PByteArray(TotalBuffer
)[I
* (BytesPerLine
+ 1) + 1])
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
;
1488 // Compress IDAT data
1489 CompressBuf(TotalBuffer
, TotalSize
, CompBuffer
, CompSize
, CompressLevel
);
1490 // Write IDAT data to stream
1491 IDATStream
.WriteBuffer(CompBuffer
^, CompSize
);
1493 FreeMem(TotalBuffer
);
1494 FreeMem(CompBuffer
);
1498 FreeMem(FilterLines
[I
]);
1502 {$IFNDEF DONT_LINK_JNG}
1504 procedure TNGFileSaver
.StoreImageToJNGFrame(const JHDR
: TJHDR
;
1505 const Image
: TImageData
; IDATStream
, JDATStream
,
1506 JDAAStream
: TMemoryStream
);
1508 ColorImage
, AlphaImage
: TImageData
;
1509 FmtInfo
: TImageFormatInfo
;
1512 ColorPtr
: PColor32Rec
;
1516 procedure SaveJpegToStream(Stream
: TStream
; const Image
: TImageData
);
1518 JpegFormat
: TCustomIOJpegFileFormat
;
1519 Handle
: TImagingHandle
;
1520 DynImages
: TDynImageDataArray
;
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
1528 JpegFormat
.FProgressive
:= False;
1529 JpegFormat
.FQuality
:= Quality
;
1530 SetLength(DynImages
, 1);
1531 DynImages
[0] := Image
;
1532 Handle
:= StreamIO
.OpenWrite(Pointer(Stream
));
1534 JpegFormat
.SaveData(Handle
, DynImages
, 0);
1536 StreamIO
.Close(Handle
);
1537 SetLength(DynImages
, 0);
1543 GetImageFormatInfo(Image
.Format
, FmtInfo
);
1544 InitImage(ColorImage
);
1545 InitImage(AlphaImage
);
1547 if FmtInfo
.HasAlphaChannel
then
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
);
1557 // Store source image's alpha to separate image
1558 AlphaPtr
:= AlphaImage
.Bits
;
1559 if Image
.Format
= ifA8Gray8
then
1561 GrayPtr
:= Image
.Bits
;
1562 for I
:= 0 to Image
.Width
* Image
.Height
- 1 do
1564 AlphaPtr
^ := GrayPtr
.High
;
1571 ColorPtr
:= Image
.Bits
;
1572 for I
:= 0 to Image
.Width
* Image
.Height
- 1 do
1574 AlphaPtr
^ := ColorPtr
.A
;
1580 // Write color image to stream as JPEG
1581 SaveJpegToStream(JDATStream
, ColorImage
);
1585 // Write alpha image to stream as JPEG
1586 SaveJpegToStream(JDAAStream
, AlphaImage
);
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
;
1598 GetImageFormatInfo(AlphaImage
.Format
, FmtInfo
);
1599 StoreImageToPNGFrame(FakeIHDR
, AlphaImage
.Bits
, FmtInfo
, IDATStream
);
1602 FreeImage(ColorImage
);
1603 FreeImage(AlphaImage
);
1607 // Simply write JPEG to stream
1608 SaveJpegToStream(JDATStream
, Image
);
1614 procedure TNGFileSaver
.AddFrame(const Image
: TImageData
; IsJpegFrame
: Boolean);
1617 FmtInfo
: TImageFormatInfo
;
1619 procedure StorePalette
;
1623 I
, PalBytes
: LongInt;
1624 AlphasDiffer
: Boolean;
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
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;
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
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
;
1654 Frame
:= AddFrameInfo
;
1655 Frame
.IsJpegFrame
:= IsJpegFrame
;
1659 GetImageFormatInfo(Image
.Format
, FmtInfo
);
1663 {$IFNDEF DONT_LINK_JNG}
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;
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;
1681 StoreImageToJNGFrame(JHDR
, Image
, IDATMemory
, JDATMemory
, JDAAMemory
);
1683 // Finally swap endian
1684 SwapEndianLongWord(@JHDR
, 2);
1690 IHDR
.Width
:= Image
.Width
;
1691 IHDR
.Height
:= Image
.Height
;
1692 IHDR
.Compression
:= 0;
1694 IHDR
.Interlacing
:= 0;
1695 IHDR
.BitDepth
:= FmtInfo
.BytesPerPixel
* 8;
1697 // Select appropiate PNG color type and modify bitdepth
1698 if FmtInfo
.HasGrayChannel
then
1700 IHDR
.ColorType
:= 0;
1701 if FmtInfo
.HasAlphaChannel
then
1703 IHDR
.ColorType
:= 4;
1704 IHDR
.BitDepth
:= IHDR
.BitDepth
div 2;
1709 if FmtInfo
.IsIndexed
then
1712 if FmtInfo
.HasAlphaChannel
then
1714 IHDR
.ColorType
:= 6;
1715 IHDR
.BitDepth
:= IHDR
.BitDepth
div 4;
1719 IHDR
.ColorType
:= 2;
1720 IHDR
.BitDepth
:= IHDR
.BitDepth
div 3;
1724 if FileType
= ngAPNG
then
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
;
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
);
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
1747 // Finally swap endian
1748 SwapEndianLongWord(@IHDR
, 2);
1753 function TNGFileSaver
.SaveFile(Handle
: TImagingHandle
): Boolean;
1756 Chunk
: TChunkHeader
;
1759 function GetNextSeqNo
: LongWord;
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
);
1768 function CalcChunkCrc(const ChunkHdr
: TChunkHeader
; Data
: Pointer;
1769 Size
: LongInt): LongWord;
1771 Result
:= $FFFFFFFF;
1772 CalcCrc32(Result
, @ChunkHdr
.ChunkID
, SizeOf(ChunkHdr
.ChunkID
));
1773 CalcCrc32(Result
, Data
, Size
);
1774 Result
:= SwapEndianLongWord(Result
xor $FFFFFFFF);
1777 procedure WriteChunk(var Chunk
: TChunkHeader
; ChunkData
: Pointer);
1780 SizeToWrite
: LongInt;
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
));
1791 procedure WritefdAT(Frame
: TFrameInfo
);
1794 ChunkSeqNo
: LongWord;
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
);
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
));
1814 procedure WritePNGMainImageChunks(Frame
: TFrameInfo
);
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
1825 Chunk
.DataSize
:= PaletteEntries
* SizeOf(TColor24Rec
);
1826 Chunk
.ChunkID
:= PLTEChunk
;
1827 WriteChunk(Chunk
, Palette
);
1829 // Write tRNS chunk if data is present
1830 if Transparency
<> nil then
1832 Chunk
.DataSize
:= TransparencySize
;
1833 Chunk
.ChunkID
:= tRNSChunk
;
1834 WriteChunk(Chunk
, Transparency
);
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
));
1849 if FileType
= ngMNG
then
1851 SwapEndianLongWord(@MHDR
, SizeOf(MHDR
) div SizeOf(LongWord));
1852 Chunk
.DataSize
:= SizeOf(MHDR
);
1853 Chunk
.ChunkID
:= MHDRChunk
;
1854 WriteChunk(Chunk
, @MHDR
);
1857 for I
:= 0 to Length(Frames
) - 1 do
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
1873 if JHDR
.AlphaCompression
= 0 then
1875 // Alpha is PNG compressed
1876 Chunk
.DataSize
:= IDATMemory
.Size
;
1877 Chunk
.ChunkID
:= IDATChunk
;
1878 WriteChunk(Chunk
, IDATMemory
.Memory
);
1882 // Alpha is JNG compressed
1883 Chunk
.DataSize
:= JDAAMemory
.Size
;
1884 Chunk
.ChunkID
:= JDAAChunk
;
1885 WriteChunk(Chunk
, JDAAMemory
.Memory
);
1889 Chunk
.DataSize
:= 0;
1890 Chunk
.ChunkID
:= IENDChunk
;
1891 WriteChunk(Chunk
, nil);
1893 else if FileType
<> ngAPNG
then
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
);
1902 Chunk
.DataSize
:= 0;
1903 Chunk
.ChunkID
:= IENDChunk
;
1904 WriteChunk(Chunk
, nil);
1906 else if FileType
= ngAPNG
then
1908 // APNG frame - first frame must have acTL and fcTL before IDAT,
1909 // subsequent frames have fcTL and fdAT.
1912 WritePNGMainImageChunks(Frames
[I
]);
1913 Chunk
.DataSize
:= SizeOf(acTL
);
1914 Chunk
.ChunkID
:= acTLChunk
;
1915 WriteChunk(Chunk
, @acTL
);
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
1925 Chunk
.DataSize
:= IDATMemory
.Size
;
1926 Chunk
.ChunkID
:= IDATChunk
;
1927 WriteChunk(Chunk
, IDATMemory
.Memory
);
1930 WritefdAT(Frames
[I
]);
1931 // Write image end after last frame
1932 if I
= Length(Frames
) - 1 then
1934 Chunk
.DataSize
:= 0;
1935 Chunk
.ChunkID
:= IENDChunk
;
1936 WriteChunk(Chunk
, nil);
1941 if FileType
= ngMNG
then
1943 Chunk
.DataSize
:= 0;
1944 Chunk
.ChunkID
:= MENDChunk
;
1945 WriteChunk(Chunk
, nil);
1949 procedure TNGFileSaver
.SetFileOptions(FileFormat
: TNetworkGraphicsFileFormat
);
1951 PreFilter
:= FileFormat
.FPreFilter
;
1952 CompressLevel
:= FileFormat
.FCompressLevel
;
1953 LossyAlpha
:= FileFormat
.FLossyAlpha
;
1954 Quality
:= FileFormat
.FQuality
;
1955 Progressive
:= FileFormat
.FProgressive
;
1958 { TAPNGAnimator class implemnetation }
1960 class procedure TAPNGAnimator
.Animate(var Images
: TDynImageDataArray
;
1961 const acTL
: TacTL
; const SrcFrames
: array of TFrameInfo
);
1963 I
, SrcIdx
, Offset
, Len
: Integer;
1964 DestFrames
: TDynImageDataArray
;
1965 SrcCanvas
, DestCanvas
: TImagingCanvas
;
1966 PreviousCache
: TImageData
;
1968 function AnimatingNeeded
: Boolean;
1973 for I
:= 0 to Len
- 1 do
1974 with SrcFrames
[I
] do
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
1988 Len
:= Length(SrcFrames
);
1989 if (Len
= 0) or not AnimatingNeeded
then
1992 if (Len
= acTL
.NumFrames
+ 1) and (SrcFrames
[0].fcTL
.Width
= 0) then
1994 // If default image (stored in IDAT chunk) isn't part of animation we ignore it
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
);
2007 for I
:= 0 to Len
- 1 do
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
]);
2016 if (SrcFrames
[SrcIdx
].fcTL
.DisposeOp
= DisposeOpPrevious
) and (SrcFrames
[SrcIdx
- 1].fcTL
.DisposeOp
<> DisposeOpPrevious
) then
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);
2023 if (I
= 0) or (SrcIdx
= 0) then
2025 // Clear whole frame with transparent black color (default for first frame)
2026 DestCanvas
.FillColor32
:= pcClear
;
2029 else if SrcFrames
[SrcIdx
- 1].fcTL
.DisposeOp
= DisposeOpBackground
then
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
));
2038 else if SrcFrames
[SrcIdx
- 1].fcTL
.DisposeOp
= DisposeOpNone
then
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);
2044 else if SrcFrames
[SrcIdx
- 1].fcTL
.DisposeOp
= DisposeOpPrevious
then
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);
2051 // Copy pixels or alpha blend them over
2052 if SrcFrames
[SrcIdx
].fcTL
.BlendOp
= BlendOpSource
then
2054 CopyRect(Images
[SrcIdx
], 0, 0, Images
[SrcIdx
].Width
, Images
[SrcIdx
].Height
,
2055 DestFrames
[I
], SrcFrames
[SrcIdx
].fcTL
.XOffset
, SrcFrames
[SrcIdx
].fcTL
.YOffset
);
2057 else if SrcFrames
[SrcIdx
].fcTL
.BlendOp
= BlendOpOver
then
2059 SrcCanvas
.CreateForData(@Images
[SrcIdx
]);
2060 SrcCanvas
.DrawAlpha(SrcCanvas
.ClipRect
, DestCanvas
,
2061 SrcFrames
[SrcIdx
].fcTL
.XOffset
, SrcFrames
[SrcIdx
].fcTL
.YOffset
);
2064 FreeImage(Images
[SrcIdx
]);
2069 FreeImage(PreviousCache
);
2071 // Assign dest frames to final output images
2072 Images
:= DestFrames
;
2075 { TNetworkGraphicsFileFormat class implementation }
2077 constructor TNetworkGraphicsFileFormat
.Create
;
2082 FIsMultiImageFormat
:= False;
2084 FPreFilter
:= NGDefaultPreFilter
;
2085 FCompressLevel
:= NGDefaultCompressLevel
;
2086 FLossyAlpha
:= NGDefaultLossyAlpha
;
2087 FLossyCompression
:= NGDefaultLossyCompression
;
2088 FQuality
:= NGDefaultQuality
;
2089 FProgressive
:= NGDefaultProgressive
;
2092 procedure TNetworkGraphicsFileFormat
.CheckOptionsValidity
;
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
;
2103 function TNetworkGraphicsFileFormat
.GetSupportedFormats
: TImageFormats
;
2105 if FLossyCompression
then
2106 Result
:= NGLossyFormats
2108 Result
:= NGLosslessFormats
;
2111 procedure TNetworkGraphicsFileFormat
.ConvertToSupported(var Image
: TImageData
;
2112 const Info
: TImageFormatInfo
);
2114 ConvFormat
: TImageFormat
;
2116 if not FLossyCompression
then
2118 // Convert formats for lossless compression
2119 if Info
.HasGrayChannel
then
2121 if Info
.HasAlphaChannel
then
2123 if Info
.BytesPerPixel
<= 2 then
2124 // Convert <= 16bit grayscale images with alpha to ifA8Gray8
2125 ConvFormat
:= ifA8Gray8
2127 // Convert > 16bit grayscale images with alpha to ifA16Gray16
2128 ConvFormat
:= ifA16Gray16
2131 // Convert grayscale images without alpha to ifGray16
2132 ConvFormat
:= ifGray16
;
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
2142 // Convert images without alpha to R8G8B8
2143 ConvFormat
:= ifR8G8B8
;
2147 // Convert formats for lossy compression
2148 if Info
.HasGrayChannel
then
2149 ConvFormat
:= IffFormat(Info
.HasAlphaChannel
, ifA8Gray8
, ifGray8
)
2151 ConvFormat
:= IffFormat(Info
.HasAlphaChannel
, ifA8R8G8B8
, ifR8G8B8
);
2154 ConvertImage(Image
, ConvFormat
);
2157 function TNetworkGraphicsFileFormat
.TestFormat(Handle
: TImagingHandle
): Boolean;
2163 if Handle
<> nil then
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
);
2173 { TPNGFileFormat class implementation }
2175 constructor TPNGFileFormat
.Create
;
2178 FName
:= SPNGFormatName
;
2179 FIsMultiImageFormat
:= True;
2180 FLoadAnimated
:= PNGDefaultLoadAnimated
;
2181 AddMasks(SPNGMasks
);
2183 FSignature
:= PNGSignature
;
2185 RegisterOption(ImagingPNGPreFilter
, @FPreFilter
);
2186 RegisterOption(ImagingPNGCompressLevel
, @FCompressLevel
);
2187 RegisterOption(ImagingPNGLoadAnimated
, @FLoadAnimated
);
2190 function TPNGFileFormat
.LoadData(Handle
: TImagingHandle
;
2191 var Images
: TDynImageDataArray
; OnlyFirstLevel
: Boolean): Boolean;
2194 NGFileLoader
: TNGFileLoader
;
2197 NGFileLoader
:= TNGFileLoader
.Create
;
2199 // Use NG file parser to load file
2200 if NGFileLoader
.LoadFile(Handle
) and (Length(NGFileLoader
.Frames
) > 0) then
2202 Len
:= Length(NGFileLoader
.Frames
);
2203 SetLength(Images
, Len
);
2204 for I
:= 0 to Len
- 1 do
2205 with NGFileLoader
.Frames
[I
] do
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
]);
2214 // Animate APNG images
2215 if (NGFileLoader
.FileType
= ngAPNG
) and FLoadAnimated
then
2216 TAPNGAnimator
.Animate(Images
, NGFileLoader
.acTL
, NGFileLoader
.Frames
);
2223 function TPNGFileFormat
.SaveData(Handle
: TImagingHandle
;
2224 const Images
: TDynImageDataArray
; Index
: LongInt): Boolean;
2227 ImageToSave
: TImageData
;
2228 MustBeFreed
: Boolean;
2229 NGFileSaver
: TNGFileSaver
;
2230 DefaultFormat
: TImageFormat
;
2232 AnimWidth
, AnimHeight
: Integer;
2235 DefaultFormat
:= ifDefault
;
2238 NGFileSaver
:= TNGFileSaver
.Create
;
2240 // Save images with more frames as APNG format
2241 if Length(Images
) > 1 then
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
2252 AnimWidth
:= Max(AnimWidth
, Images
[I
].Width
);
2253 AnimHeight
:= Max(AnimHeight
, Images
[I
].Height
);
2257 NGFileSaver
.FileType
:= ngPNG
;
2258 NGFileSaver
.SetFileOptions(Self
);
2262 // Store all frames to be saved frames file saver
2263 for I
:= FFirstIdx
to FLastIdx
do
2265 if MakeCompatible(Images
[I
], ImageToSave
, MustBeFreed
) then
2267 if FileType
= ngAPNG
then
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
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
2280 if (ImageToSave
.Width
<> AnimWidth
) or (ImageToSave
.Height
<> AnimHeight
) then
2283 NewImage(AnimWidth
, AnimHeight
, ImageToSave
.Format
, Screen
);
2284 CopyRect(ImageToSave
, 0, 0, ImageToSave
.Width
, ImageToSave
.Height
, Screen
, 0, 0);
2286 FreeImage(ImageToSave
);
2287 ImageToSave
:= Screen
;
2290 else if ImageToSave
.Format
<> DefaultFormat
then
2293 ConvertImage(ImageToSave
, DefaultFormat
)
2296 CloneImage(Images
[I
], ImageToSave
);
2297 ConvertImage(ImageToSave
, DefaultFormat
);
2298 MustBeFreed
:= True;
2303 // Add image as PNG frame
2304 AddFrame(ImageToSave
, False);
2307 FreeImage(ImageToSave
);
2313 // Finally save PNG file
2321 {$IFNDEF DONT_LINK_MNG}
2323 { TMNGFileFormat class implementation }
2325 constructor TMNGFileFormat
.Create
;
2328 FName
:= SMNGFormatName
;
2329 FIsMultiImageFormat
:= True;
2330 AddMasks(SMNGMasks
);
2332 FSignature
:= MNGSignature
;
2334 RegisterOption(ImagingMNGLossyCompression
, @FLossyCompression
);
2335 RegisterOption(ImagingMNGLossyAlpha
, @FLossyAlpha
);
2336 RegisterOption(ImagingMNGPreFilter
, @FPreFilter
);
2337 RegisterOption(ImagingMNGCompressLevel
, @FCompressLevel
);
2338 RegisterOption(ImagingMNGQuality
, @FQuality
);
2339 RegisterOption(ImagingMNGProgressive
, @FProgressive
);
2342 function TMNGFileFormat
.LoadData(Handle
: TImagingHandle
;
2343 var Images
: TDynImageDataArray
; OnlyFirstLevel
: Boolean): Boolean;
2345 NGFileLoader
: TNGFileLoader
;
2349 NGFileLoader
:= TNGFileLoader
.Create
;
2351 // Use NG file parser to load file
2352 if NGFileLoader
.LoadFile(Handle
) then
2354 Len
:= Length(NGFileLoader
.Frames
);
2357 SetLength(Images
, Len
);
2358 for I
:= 0 to Len
- 1 do
2359 with NGFileLoader
.Frames
[I
] do
2361 // Build actual image bits
2363 NGFileLoader
.LoadImageFromJNGFrame(FrameWidth
, FrameHeight
, JHDR
, IDATMemory
, JDATMemory
, JDAAMemory
, Images
[I
])
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
]);
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]);
2383 function TMNGFileFormat
.SaveData(Handle
: TImagingHandle
;
2384 const Images
: TDynImageDataArray
; Index
: LongInt): Boolean;
2386 NGFileSaver
: TNGFileSaver
;
2387 I
, LargestWidth
, LargestHeight
: LongInt;
2388 ImageToSave
: TImageData
;
2389 MustBeFreed
: Boolean;
2395 NGFileSaver
:= TNGFileSaver
.Create
;
2396 NGFileSaver
.FileType
:= ngMNG
;
2397 NGFileSaver
.SetFileOptions(Self
);
2401 // Store all frames to be saved frames file saver
2402 for I
:= FFirstIdx
to FLastIdx
do
2404 if MakeCompatible(Images
[I
], ImageToSave
, MustBeFreed
) then
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
);
2413 FreeImage(ImageToSave
);
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
2428 // Finally save MNG file
2438 {$IFNDEF DONT_LINK_JNG}
2440 { TJNGFileFormat class implementation }
2442 constructor TJNGFileFormat
.Create
;
2445 FName
:= SJNGFormatName
;
2446 AddMasks(SJNGMasks
);
2448 FSignature
:= JNGSignature
;
2449 FLossyCompression
:= True;
2451 RegisterOption(ImagingJNGLossyAlpha
, @FLossyAlpha
);
2452 RegisterOption(ImagingJNGAlphaPreFilter
, @FPreFilter
);
2453 RegisterOption(ImagingJNGAlphaCompressLevel
, @FCompressLevel
);
2454 RegisterOption(ImagingJNGQuality
, @FQuality
);
2455 RegisterOption(ImagingJNGProgressive
, @FProgressive
);
2458 function TJNGFileFormat
.LoadData(Handle
: TImagingHandle
;
2459 var Images
: TDynImageDataArray
; OnlyFirstLevel
: Boolean): Boolean;
2461 NGFileLoader
: TNGFileLoader
;
2464 NGFileLoader
:= TNGFileLoader
.Create
;
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
2470 SetLength(Images
, 1);
2471 // Build actual image bits
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]);
2483 function TJNGFileFormat
.SaveData(Handle
: TImagingHandle
;
2484 const Images
: TDynImageDataArray
; Index
: LongInt): Boolean;
2486 NGFileSaver
: TNGFileSaver
;
2487 ImageToSave
: TImageData
;
2488 MustBeFreed
: Boolean;
2490 // Make image JNG compatible, store it in saver, and save it to file
2491 Result
:= MakeCompatible(Images
[Index
], ImageToSave
, MustBeFreed
);
2494 NGFileSaver
:= TNGFileSaver
.Create
;
2498 SetFileOptions(Self
);
2499 AddFrame(ImageToSave
, True);
2502 // Free NG saver and compatible image
2505 FreeImage(ImageToSave
);
2513 RegisterImageFileFormat(TPNGFileFormat
);
2514 {$IFNDEF DONT_LINK_MNG}
2515 RegisterImageFileFormat(TMNGFileFormat
);
2517 {$IFNDEF DONT_LINK_JNG}
2518 RegisterImageFileFormat(TJNGFileFormat
);
2525 -- TODOS ----------------------------------------------------
2528 -- 0.26.3 Changes/Bug Fixes ---------------------------------
2529 - Added APNG saving support.
2530 - Added APNG support to NG loader and animating to PNG loader.
2532 -- 0.26.1 Changes/Bug Fixes ---------------------------------
2533 - Changed file format conditional compilation to reflect changes
2536 -- 0.24.3 Changes/Bug Fixes ---------------------------------
2537 - Changes for better thread safety.
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).
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
2549 - Changed extensions to filename masks.
2550 - Changed SaveData, LoadData, and MakeCompatible methods according
2551 to changes in base class in Imaging unit.
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
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
2568 -- 0.13 Changes/Bug Fixes -----------------------------------
2569 - adaptive filtering added to PNG saving
2570 - TPNGFileFormat class added