1 {
2 $Id: ImagingGif.pas 157 2009-02-15 14:24:58Z galfar $
3 Vampyre Imaging Library
4 by Marek Mauder
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
27 }
29 { This unit contains image format loader/saver for GIF images.}
32 {$I ImagingOptions.inc}
34 interface
36 uses
39 type
40 { GIF (Graphics Interchange Format) loader/saver class. GIF was
41 (and is still used) popular format for storing images supporting
42 multiple images per file and single color transparency.
43 Pixel format is 8 bit indexed where each image frame can have
44 its own color palette. GIF uses lossless LZW compression
45 (patent expired few years ago).
46 Imaging can load and save all GIFs with all frames and supports
47 transparency. Imaging can load just raw ifIndex8 frames or
48 also animate them in ifA8R8G8B8 format. See ImagingGIFLoadAnimated option.}
50 private
57 protected
64 public
67 published
71 implementation
73 const
79 type
84 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 type
116 // File header part
119 // Logical Screen Descriptor part
128 //Separator: Byte; // leave that out since we always read one bye ahead
136 const
137 // GIF extension labels
143 type
152 const
153 // Netscape sub block types
157 type
165 const
169 type
212 resourcestring
215 {
216 TGIFFileFormat implementation
217 }
220 begin
234 begin
245 begin
247 begin
251 Exit;
254 begin
258 Exit;
261 begin
268 { GIF LZW decompresion code is from JVCL JvGIF.pas unit.}
269 procedure TGIFFileFormat.LZWDecompress(Stream: TStream; Handle: TImagingHandle; Width, Height: Integer;
271 var
283 var
288 begin
291 begin
292 // Not enough bits in buffer - refill it - Not very efficient, but infrequently called
294 // Note biggest Code Size is 12 bits. And this can at worst span 3 Bytes
314 var
316 begin
318 Exit;
320 // Only ifIndex8 supported
324 {case Context.BitsPerPixel of
325 1:
326 begin
327 P := @PByteArray(Context.CurrLineData)[Context.X shr 3];
328 if (Context.X and $07) <> 0 then
329 P^ := P^ or Word(Value shl (7 - (Word(Context.X and 7))))
330 else
331 P^ := Byte(Value shl 7);
332 end;
333 4:
334 begin
335 P := @PByteArray(Context.CurrLineData)[Context.X shr 1];
336 if (Context.X and 1) <> 0 then
337 P^ := P^ or Value
338 else
339 P^ := Byte(Value shl 4);
340 end;
341 8:
342 begin
343 P := @PByteArray(Context.CurrLineData)[Context.X];
344 P^ := Value;
345 end;
346 end;}
350 Exit;
354 else
360 begin
368 try
372 // Initial read context
377 // Initialise pixel-output context
389 // 2 ^ MinCodeSize accounts for all colours in file
394 // 2^ (MinCodeSize + 1) includes clear and eoi Code and space too
400 begin
402 begin
411 Break;
415 end
416 else
417 begin
421 begin
427 begin
441 // Update dictionary
443 begin
446 // Advance to next free slot
449 begin
451 begin
455 end
456 else
466 finally
473 { GIF LZW compresion code is from JVCL JvGIF.pas unit.}
474 procedure TGIFFileFormat.LZWCompress(const IO: TIOFunctions; Handle: TImagingHandle; Width, Height, BitCount: Integer;
476 var
491 begin
496 var
499 begin
507 begin
508 // Flush out full buffer
519 var
521 begin
524 begin
528 // Data block terminator - a block of zero Size
533 begin
540 try
544 // Initialise encoder variables
555 // Setup write context
564 begin
567 begin
568 // Only ifIndex8 support
571 begin
575 {4:
576 begin
577 if X and 1 <> 0 then
578 begin
579 Col := PData^ and $0F;
580 PData := @PByteArray(PData)[1];
581 end
582 else
583 Col := PData^ shr 4;
584 end;
585 1:
586 begin
587 if X and 7 = 7 then
588 begin
589 Col := PData^ and 1;
590 PData := @PByteArray(PData)[1];
591 end
592 else
593 Col := (PData^ shr (7 - (X and $07))) and $01;
594 end;}
598 begin
601 end
602 else
603 begin
610 begin
617 else
618 begin
619 // Not found
630 begin
631 // Next Code will be written longer
634 end
635 else
637 begin
638 // Reset tables
653 else
659 finally
667 type
677 var
692 begin
699 var
705 begin
707 repeat
708 // Read block sizes and skip them
714 begin
718 // Read extensions until image descriptor is found. Only graphic extension
719 // is stored now (for transparency), others are skipped.
722 begin
725 while ExtType in [GIFGraphicControlExtension, GIFCommentExtension, GIFApplicationExtension, GIFPlainText] do
726 begin
728 begin
731 end
733 begin
736 begin
739 begin
742 begin
747 GIFAppLoopExtension:
749 begin
750 // Read loop count
754 GIFAppBufferExtension:
755 begin
761 SkipBytes;
763 end
764 else
765 begin
766 // Revert all bytes reading
768 SkipBytes;
770 end
771 else
772 begin
774 SkipBytes;
776 end
778 repeat
779 // Read block sizes and skip them
784 // Read ID of following block
787 end
792 var
796 begin
798 // Copy codesize to stream
801 repeat
802 // Read and write data blocks, last is block term value of 0
806 begin
814 var
822 begin
827 begin
834 begin
835 // Read and parse image descriptor
837 FrameInfos[Idx].HasLocalPal := (ImageDesc.PackedFields and GIFLocalColorTable) = GIFLocalColorTable;
842 // From Mozilla source
854 // Create new image for this frame which would be later pasted onto logical screen
857 // Load local palette if there is any
860 begin
867 // Use local pal if present or global pal if present or create
868 // default pal if neither of them is present
873 else
876 if (ImageDesc.Left <= Header.ScreenWidth + 1) and (ImageDesc.Top <= Header.ScreenHeight + 1) then
877 begin
878 // Resize the screen if needed to fit the frame
881 end
882 else
883 begin
884 // Remove frame outside logical screen
885 RemoveBadFrame;
886 Exit;
889 // If Grahic Control Extension is present make use of it
891 begin
892 FrameInfos[Idx].HasTransparency := (GraphicExt.PackedFields and GIFTransparent) = GIFTransparent;
893 FrameInfos[Idx].Disposal := TDisposalMethod((GraphicExt.PackedFields and GIFDisposalMethod) shr 2);
895 begin
899 end
900 else
904 try
905 try
906 // Copy LZW data to temp stream, needed for correct decompression
909 // Data decompression finally
910 LZWDecompress(LZWStream, Handle, ImageDesc.Width, ImageDesc.Height, Interlaced, Images[Idx].Bits);
911 except
912 RemoveBadFrame;
913 Exit;
915 finally
922 var
926 begin
929 // Copy all pixels from frame to log screen but ignore the transparent ones
931 begin
934 begin
944 var
948 begin
949 // We may need to use raw frame 0 to n to correctly animate n-th frame
952 // See if we can use last animate frame as a basis for this one
953 // (so we don't have to use previous raw frames).
957 // Reuse or release cache
960 else
963 // Default color for clearing of the screen
966 // Now prepare logical screen for drawing of raw frame at Index.
967 // We may need to use all previous raw frames to get the screen
968 // to proper state (according to their disposal methods).
971 begin
974 // Clear whole screen
977 // Try to maximize First so we don't have to use all 0 to n raw frames
979 begin
981 begin
983 Break;
989 begin
992 begin
993 // Copy previous raw frame onto screen
996 dmRestoreBackground:
998 begin
999 // Restore background color
1006 end
1008 begin
1009 // We have our cached result but also need to restore
1010 // background in a place of cached frame
1017 // Copy current raw frame to prepared screen
1018 CopyFrameTransparent32(AnimFrame, Images[Index], FrameInfos[Index].Left, FrameInfos[Index].Top);
1020 // Cache animated result
1025 begin
1032 begin
1033 // Read GIF header
1041 // Read global palette from file if present
1043 begin
1045 begin
1053 // Read ID of the first block
1056 // Now read all data blocks in the file until file trailer is reached
1058 begin
1059 // Read blocks until we find the one of known type
1062 // Read supported and skip unsupported extensions
1063 ReadExtensions;
1064 // If image frame is found read it
1066 ReadFrame;
1067 // Read next block's ID
1069 // If block ID is unknown set it to end-of-GIF marker
1075 begin
1076 // Aniated frames will be stored in AnimFrames
1082 begin
1083 // Create new logical screen
1085 // Animate frames to current log screen
1089 // Now release raw 8bit frames and put animated 32bit ones
1090 // to output array
1093 begin
1105 var
1114 var
1116 begin
1121 begin
1127 begin
1128 // Fill header with data, select size of largest image in array as
1129 // logical screen size
1137 // Prepare default GC extension with delay
1143 begin
1146 try
1147 // Write Graphic Control Extension with default delay
1151 // Write frame marker and fill and write image descriptor for this frame
1156 ImageDesc.PackedFields := GIFLocalColorTable or GIFColorTableSize; // Use lccal color table with 256 entries
1159 // Write local color table for each frame
1161 begin
1167 // Fonally compress image data
1170 finally
1182 begin
1187 var
1190 begin
1193 begin
1202 initialization
1205 {
1206 File Notes:
1208 -- TODOS ----------------------------------------------------
1209 - nothing now
1211 -- 0.26.3 Changes/Bug Fixes ---------------------------------
1212 - Fixed bug - loading of GIF with NETSCAPE app extensions
1213 failed with Delphi 2009.
1215 -- 0.26.1 Changes/Bug Fixes ---------------------------------
1216 - GIF loading and animation mostly rewritten, based on
1217 modification by Sergey Galezdinov (ExtraGIF in Extras/Contrib).
1219 -- 0.25.0 Changes/Bug Fixes ---------------------------------
1220 - Fixed loading of some rare GIFs, problems with LZW
1221 decompression.
1223 -- 0.24.3 Changes/Bug Fixes ---------------------------------
1224 - Better solution to transparency for some GIFs. Background not
1225 transparent by default.
1227 -- 0.24.1 Changes/Bug Fixes ---------------------------------
1228 - Made backround color transparent by default (alpha = 0).
1230 -- 0.23 Changes/Bug Fixes -----------------------------------
1231 - Fixed other loading bugs (local pal size, transparency).
1232 - Added GIF saving.
1233 - Fixed bug when loading multiframe GIFs and implemented few animation
1234 features (disposal methods, ...).
1235 - Loading of GIFs working.
1236 - Unit created with initial stuff!
1237 }