a38e33adbb67ccde804a5a65ca4d5d4e8dcfa754
1 {
2 Vampyre Imaging Library
3 by Marek Mauder
4 http://imaginglib.sourceforge.net
6 The contents of this file are used with permission, subject to the Mozilla
7 Public License Version 1.1 (the "License"); you may not use this file except
8 in compliance with the License. You may obtain a copy of the License at
9 http://www.mozilla.org/MPL/MPL-1.1.html
11 Software distributed under the License is distributed on an "AS IS" basis,
12 WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
13 the specific language governing rights and limitations under the License.
15 Alternatively, the contents of this file may be used under the terms of the
16 GNU Lesser General Public License (the "LGPL License"), in which case the
17 provisions of the LGPL License are applicable instead of those above.
18 If you wish to allow use of your version of this file only under the terms
19 of the LGPL License and not to allow others to use your version of this file
20 under the MPL, indicate your decision by deleting the provisions above and
21 replace them with the notice and other provisions required by the LGPL
22 License. If you do not delete the provisions above, a recipient may use
23 your version of this file under either the MPL or the LGPL License.
25 For more information about the LGPL: http://www.gnu.org/copyleft/lesser.html
26 }
28 { This unit contains image format loader/saver for GIF images.}
31 {$I ImagingOptions.inc}
33 interface
35 uses
38 type
39 { GIF (Graphics Interchange Format) loader/saver class. GIF was
40 (and is still used) popular format for storing images supporting
41 multiple images per file and single color transparency.
42 Pixel format is 8 bit indexed where each image frame can have
43 its own color palette. GIF uses lossless LZW compression
44 (patent expired few years ago).
45 Imaging can load and save all GIFs with all frames and supports
46 transparency. Imaging can load just raw ifIndex8 frames or
47 also animate them in ifA8R8G8B8 format. See ImagingGIFLoadAnimated option.}
49 private
56 protected
64 public
66 published
70 implementation
72 const
78 type
83 const
88 // Masks for accessing fields in PackedFields of TGIFHeader
94 // Masks for accessing fields in PackedFields of TImageDescriptor
99 // Block identifiers
109 // Masks for accessing fields in PackedFields of TGraphicControlExtension
114 const
115 // Netscape sub block types
119 type
121 // File header part
124 // Logical Screen Descriptor part
133 //Separator: Byte; // leave that out since we always read one bye ahead
141 const
142 // GIF extension labels
148 type
157 type
165 const
169 type
212 resourcestring
215 {
216 TGIFFileFormat implementation
217 }
220 begin
232 begin
243 begin
245 begin
249 Exit;
252 begin
256 Exit;
259 begin
266 { GIF LZW decompresion code is from JVCL JvGIF.pas unit.}
267 procedure TGIFFileFormat.LZWDecompress(Stream: TStream; Handle: TImagingHandle; Width, Height: Integer;
269 var
281 var
286 begin
289 begin
290 // Not enough bits in buffer - refill it - Not very efficient, but infrequently called
292 // Note biggest Code Size is 12 bits. And this can at worst span 3 Bytes
312 var
314 begin
316 Exit;
318 // Only ifIndex8 supported
322 {case Context.BitsPerPixel of
323 1:
324 begin
325 P := @PByteArray(Context.CurrLineData)[Context.X shr 3];
326 if (Context.X and $07) <> 0 then
327 P^ := P^ or Word(Value shl (7 - (Word(Context.X and 7))))
328 else
329 P^ := Byte(Value shl 7);
330 end;
331 4:
332 begin
333 P := @PByteArray(Context.CurrLineData)[Context.X shr 1];
334 if (Context.X and 1) <> 0 then
335 P^ := P^ or Value
336 else
337 P^ := Byte(Value shl 4);
338 end;
339 8:
340 begin
341 P := @PByteArray(Context.CurrLineData)[Context.X];
342 P^ := Value;
343 end;
344 end;}
348 Exit;
352 else
358 begin
366 try
370 // Initial read context
375 // Initialise pixel-output context
387 // 2 ^ MinCodeSize accounts for all colours in file
392 // 2^ (MinCodeSize + 1) includes clear and eoi Code and space too
398 begin
400 begin
409 Break;
413 end
414 else
415 begin
419 begin
425 begin
439 // Update dictionary
441 begin
444 // Advance to next free slot
447 begin
449 begin
453 end
454 else
464 finally
471 { GIF LZW compresion code is from JVCL JvGIF.pas unit.}
472 procedure TGIFFileFormat.LZWCompress(const IO: TIOFunctions; Handle: TImagingHandle; Width, Height, BitCount: Integer;
474 var
489 begin
494 var
497 begin
505 begin
506 // Flush out full buffer
517 var
519 begin
522 begin
526 // Data block terminator - a block of zero Size
531 begin
538 try
542 // Initialise encoder variables
553 // Setup write context
562 begin
565 begin
566 // Only ifIndex8 support
569 begin
573 {4:
574 begin
575 if X and 1 <> 0 then
576 begin
577 Col := PData^ and $0F;
578 PData := @PByteArray(PData)[1];
579 end
580 else
581 Col := PData^ shr 4;
582 end;
583 1:
584 begin
585 if X and 7 = 7 then
586 begin
587 Col := PData^ and 1;
588 PData := @PByteArray(PData)[1];
589 end
590 else
591 Col := (PData^ shr (7 - (X and $07))) and $01;
592 end;}
596 begin
599 end
600 else
601 begin
608 begin
615 else
616 begin
617 // Not found
628 begin
629 // Next Code will be written longer
632 end
633 else
635 begin
636 // Reset tables
651 else
657 finally
665 type
675 var
690 begin
697 var
703 begin
705 repeat
706 // Read block sizes and skip them
712 begin
716 // Read extensions until image descriptor is found. Only graphic extension
717 // is stored now (for transparency), others are skipped.
720 begin
723 while ExtType in [GIFGraphicControlExtension, GIFCommentExtension, GIFApplicationExtension, GIFPlainText] do
724 begin
726 begin
729 end
731 begin
734 begin
738 begin
741 begin
746 GIFAppLoopExtension:
748 begin
749 // Read loop count
756 GIFAppBufferExtension:
757 begin
763 SkipBytes;
765 end
766 else
767 begin
768 // Revert all bytes reading
770 SkipBytes;
772 end
773 else
774 begin
776 SkipBytes;
778 end
780 repeat
781 // Read block sizes and skip them
786 // Read ID of following block
789 end
794 var
798 begin
800 // Copy codesize to stream
803 repeat
804 // Read and write data blocks, last is block term value of 0
808 begin
816 var
824 begin
829 begin
836 begin
837 // Read and parse image descriptor
839 FrameInfos[Idx].HasLocalPal := (ImageDesc.PackedFields and GIFLocalColorTable) = GIFLocalColorTable;
844 // From Mozilla source
856 // Create new image for this frame which would be later pasted onto logical screen
859 // Load local palette if there is any
862 begin
869 // Use local pal if present or global pal if present or create
870 // default pal if neither of them is present
875 else
878 if (ImageDesc.Left <= Header.ScreenWidth + 1) and (ImageDesc.Top <= Header.ScreenHeight + 1) then
879 begin
880 // Resize the screen if needed to fit the frame
883 end
884 else
885 begin
886 // Remove frame outside logical screen
887 RemoveBadFrame;
888 Exit;
891 // If Grahic Control Extension is present make use of it
893 begin
894 FrameInfos[Idx].HasTransparency := (GraphicExt.PackedFields and GIFTransparent) = GIFTransparent;
895 FrameInfos[Idx].Disposal := TDisposalMethod((GraphicExt.PackedFields and GIFDisposalMethod) shr 2);
897 begin
902 end
903 else
907 try
908 try
909 // Copy LZW data to temp stream, needed for correct decompression
912 // Data decompression finally
913 LZWDecompress(LZWStream, Handle, ImageDesc.Width, ImageDesc.Height, Interlaced, Images[Idx].Bits);
914 except
915 RemoveBadFrame;
916 Exit;
918 finally
925 var
929 begin
932 // Copy all pixels from frame to log screen but ignore the transparent ones
934 begin
937 begin
947 var
951 begin
952 // We may need to use raw frame 0 to n to correctly animate n-th frame
955 // See if we can use last animate frame as a basis for this one
956 // (so we don't have to use previous raw frames).
960 // Reuse or release cache
963 else
966 // Default color for clearing of the screen
969 // Now prepare logical screen for drawing of raw frame at Index.
970 // We may need to use all previous raw frames to get the screen
971 // to proper state (according to their disposal methods).
974 begin
977 // Clear whole screen
980 // Try to maximize First so we don't have to use all 0 to n raw frames
982 begin
984 begin
986 Break;
992 begin
995 begin
996 // Copy previous raw frame onto screen
999 dmRestoreBackground:
1001 begin
1002 // Restore background color
1009 end
1011 begin
1012 // We have our cached result but also need to restore
1013 // background in a place of cached frame
1020 // Copy current raw frame to prepared screen
1021 CopyFrameTransparent32(AnimFrame, Images[Index], FrameInfos[Index].Left, FrameInfos[Index].Top);
1023 // Cache animated result
1028 begin
1035 begin
1036 // Read GIF header
1044 // Read global palette from file if present
1046 begin
1048 begin
1056 // Read ID of the first block
1059 // Now read all data blocks in the file until file trailer is reached
1061 begin
1062 // Read blocks until we find the one of known type
1065 // Read supported and skip unsupported extensions
1066 ReadExtensions;
1067 // If image frame is found read it
1069 ReadFrame;
1070 // Read next block's ID
1072 // If block ID is unknown set it to end-of-GIF marker
1078 begin
1079 // Aniated frames will be stored in AnimFrames
1085 begin
1086 // Create new logical screen
1088 // Animate frames to current log screen
1092 // Now release raw 8bit frames and put animated 32bit ones
1093 // to output array
1096 begin
1108 var
1117 var
1119 begin
1124 begin
1131 begin
1134 else
1139 var
1143 begin
1146 begin
1168 begin
1169 // Fill header with data, select size of largest image in array as
1170 // logical screen size
1178 // Prepare default GC extension with delay
1183 SaveGlobalMetadata;
1186 begin
1189 try
1190 // Write Graphic Control Extension with default delay
1195 // Write frame marker and fill and write image descriptor for this frame
1200 ImageDesc.PackedFields := GIFLocalColorTable or GIFColorTableSize; // Use lccal color table with 256 entries
1203 // Write local color table for each frame
1205 begin
1211 // Finally compress image data
1214 finally
1226 begin
1231 var
1234 begin
1237 begin
1246 initialization
1249 {
1250 File Notes:
1252 -- TODOS ----------------------------------------------------
1253 - nothing now
1255 -- 0.77 Changes/Bug Fixes -----------------------------------
1256 - Fixed crash when resaving GIF with animation metadata.
1257 - Writes frame delays of GIF animations from metadata.
1258 - Reads and writes looping of GIF animations stored into/from metadata.
1260 -- 0.26.5 Changes/Bug Fixes ---------------------------------
1261 - Reads frame delays from GIF animations into metadata.
1263 -- 0.26.3 Changes/Bug Fixes ---------------------------------
1264 - Fixed bug - loading of GIF with NETSCAPE app extensions
1265 failed with Delphi 2009.
1267 -- 0.26.1 Changes/Bug Fixes ---------------------------------
1268 - GIF loading and animation mostly rewritten, based on
1269 modification by Sergey Galezdinov (ExtraGIF in Extras/Contrib).
1271 -- 0.25.0 Changes/Bug Fixes ---------------------------------
1272 - Fixed loading of some rare GIFs, problems with LZW
1273 decompression.
1275 -- 0.24.3 Changes/Bug Fixes ---------------------------------
1276 - Better solution to transparency for some GIFs. Background not
1277 transparent by default.
1279 -- 0.24.1 Changes/Bug Fixes ---------------------------------
1280 - Made backround color transparent by default (alpha = 0).
1282 -- 0.23 Changes/Bug Fixes -----------------------------------
1283 - Fixed other loading bugs (local pal size, transparency).
1284 - Added GIF saving.
1285 - Fixed bug when loading multiframe GIFs and implemented few animation
1286 features (disposal methods, ...).
1287 - Loading of GIFs working.
1288 - Unit created with initial stuff!
1289 }