View Issue Details

IDProjectCategoryView StatusLast Update
0016993LazarusPatchpublic2010-07-22 14:05
ReporterJosé MejutoAssigned ToPaul Ishenin 
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Platformi386OSWindowsOS VersionXP SP2
Product Version0.9.29 (SVN)Product Build26617 
Target VersionFixed in Version0.9.29 (SVN) 
Summary0016993: [Patch] No GIF image support in LCL
DescriptionLCL is missing GIF graphics format support, at least in read mode.
Additional InformationAttached patch add GIF read support using the FPReadGIF functions. Win32 tested and running fine. No animations.
TagsNo tags attached.
Fixed in Revision26758
LazTarget-
Widgetset
Attached Files
  • lcl_gifsupport_readonly.patch (6,074 bytes)
    Index: graphics.pp
    ===================================================================
    --- graphics.pp	(revision 26617)
    +++ graphics.pp	(working copy)
    @@ -40,6 +40,7 @@
       FPReadPNM, FPWritePNM,   // PNM (Portable aNyMap) support
       FPReadJpeg, FPWriteJpeg, // jpg support
       FPReadTiff, FPTiffCmn,   // tiff support
    +  FPReadGif,
       IntfGraphics,
       AvgLvlTree,
       LCLStrConsts, LCLType, LCLProc, LMessages, LCLIntf, LResources, LCLResCache,
    @@ -425,6 +426,7 @@
       TPortableNetworkGraphic = class;  // png
       TPortableAnyMapGraphic = class;   // pnm formats: pbm, pgm and ppm
       TJpegImage = class;               // jpg
    +  TGIFImage = class;                // gif (read only)
     
       { TGraphicsObject
         In Delphi VCL this is the ancestor of TFont, TPen and TBrush.
    @@ -1825,7 +1827,33 @@
         property YResolution: TTiffRational read FYResolution write FYResolution;
       end;
     
    +  { TSharedGIFImage }
     
    +  TSharedGIFImage = class(TSharedCustomBitmap)
    +  end;
    +
    +  { TGIFImage }
    +
    +  TGIFImage = class(TFPImageBitmap)
    +  private
    +    FTransparent: Boolean;
    +    FInterlaced: Boolean;
    +    FBitsPerPixel: byte;
    +  protected
    +    procedure InitializeReader(AImage: TLazIntfImage; AReader: TFPCustomImageReader); override;
    +    procedure FinalizeReader(AReader: TFPCustomImageReader); override;
    +    class function GetReaderClass: TFPCustomImageReaderClass; override;
    +    class function GetSharedImageClass: TSharedRasterImageClass; override;
    +  public
    +    constructor Create; override;
    +    class function IsStreamFormatSupported(Stream: TStream): Boolean; override;
    +    class function GetFileExtensions: string; override;
    +  public
    +    property Transparent: Boolean read FTransparent;
    +    property Interlaced: Boolean read FInterlaced;
    +    property BitsPerPixel: byte read FBitsPerPixel;
    +  end;
    +
     function GraphicFilter(GraphicClass: TGraphicClass): string;
     function GraphicExtension(GraphicClass: TGraphicClass): string;
     function GraphicFileMask(GraphicClass: TGraphicClass): string;
    @@ -2181,7 +2209,7 @@
     procedure Register;
     begin
       RegisterClasses([TBitmap,TPixmap,TPortableNetworkGraphic,
    -                   TPortableAnyMapGraphic,TJpegImage,TPicture,
    +                   TPortableAnyMapGraphic,TJpegImage,TGIFImage,TPicture,
                        TFont,TPen,TBrush,TRegion]);
     end;
     
    @@ -2554,6 +2582,7 @@
     {$I fpimagebitmap.inc}
     {$I bitmap.inc}
     {$I tiffimage.inc}
    +{$I gifimage.inc}
     
     function LocalGetSystemFont: HFont;
     begin
    Index: include/gifimage.inc
    ===================================================================
    --- include/gifimage.inc	(revision 0)
    +++ include/gifimage.inc	(revision 0)
    @@ -0,0 +1,73 @@
    +{%MainUnit ../graphics.pp}
    +
    +{******************************************************************************
    +                                TGIFImage
    + ******************************************************************************
    +
    + *****************************************************************************
    + *                                                                           *
    + *  This file is part of the Lazarus Component Library (LCL)                 *
    + *                                                                           *
    + *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
    + *  for details about the copyright.                                         *
    + *                                                                           *
    + *  This program is distributed in the hope that it will be useful,          *
    + *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
    + *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
    + *                                                                           *
    + *****************************************************************************
    +}
    +
    +{ TGIFImage }
    +
    +constructor TGIFImage.Create;
    +begin
    +  inherited Create;
    +end;
    +
    +class function TGIFImage.IsStreamFormatSupported(Stream: TStream): Boolean;
    +var
    +  Pos: Int64;
    +  Signature: array [0..5] of char;
    +begin
    +  Pos := Stream.Position;
    +  try
    +    Stream.Read(Signature, SizeOf(Signature));
    +    Result := (Signature='GIF89a') or (Signature='GIF87a');
    +  finally
    +    Stream.Position := Pos;
    +  end;
    +end;
    +
    +procedure TGIFImage.FinalizeReader(AReader: TFPCustomImageReader);
    +begin
    +  inherited;
    +  with TFPReaderGif(AReader) do
    +  begin
    +    FTransparent := Transparent;
    +    FInterlaced := Interlace;
    +    FBitsPerPixel := BitsPerPixel;
    +  end;
    +end;
    +
    +class function TGIFImage.GetFileExtensions: string;
    +begin
    +  Result := 'gif';
    +end;
    +
    +class function TGIFImage.GetReaderClass: TFPCustomImageReaderClass;
    +begin
    +  Result := TFPReaderGif;
    +end;
    +
    +class function TGIFImage.GetSharedImageClass: TSharedRasterImageClass;
    +begin
    +  Result := TSharedGIFImage;
    +end;
    +
    +procedure TGIFImage.InitializeReader(AImage: TLazIntfImage;
    +  AReader: TFPCustomImageReader);
    +begin
    +  inherited;
    +  //Nothing by now. Maybe not needed at all.
    +end;
    Index: include/picture.inc
    ===================================================================
    --- include/picture.inc	(revision 26617)
    +++ include/picture.inc	(working copy)
    @@ -57,6 +57,7 @@
       Add(TCursorImage.GetFileExtensions, rsCursor, TCursorImage);
       Add(TJpegImage.GetFileExtensions, rsJpeg, TJpegImage);
       Add(TTiffImage.GetFileExtensions, rsTiff, TTiffImage);
    +  Add(TGIFImage.GetFileExtensions, rsGIF, TGIFImage);
     end;
     
     procedure TPicFileFormatsList.Clear;
    Index: lclstrconsts.pas
    ===================================================================
    --- lclstrconsts.pas	(revision 26617)
    +++ lclstrconsts.pas	(working copy)
    @@ -267,6 +267,7 @@
       rsCursor = 'Cursor';
       rsJpeg = 'Joint Picture Expert Group';
       rsTiff = 'Tagged Image File Format';
    +  rsGIF = 'Graphics Interchange Format';
       rsGraphic = 'Graphic';
       rsUnsupportedClipboardFormat = 'Unsupported clipboard format: %s';
       rsGroupIndexCannotBeLessThanPrevious = 'GroupIndex cannot be less than a '
    

Activities

2010-07-20 20:14

 

lcl_gifsupport_readonly.patch (6,074 bytes)
Index: graphics.pp
===================================================================
--- graphics.pp	(revision 26617)
+++ graphics.pp	(working copy)
@@ -40,6 +40,7 @@
   FPReadPNM, FPWritePNM,   // PNM (Portable aNyMap) support
   FPReadJpeg, FPWriteJpeg, // jpg support
   FPReadTiff, FPTiffCmn,   // tiff support
+  FPReadGif,
   IntfGraphics,
   AvgLvlTree,
   LCLStrConsts, LCLType, LCLProc, LMessages, LCLIntf, LResources, LCLResCache,
@@ -425,6 +426,7 @@
   TPortableNetworkGraphic = class;  // png
   TPortableAnyMapGraphic = class;   // pnm formats: pbm, pgm and ppm
   TJpegImage = class;               // jpg
+  TGIFImage = class;                // gif (read only)
 
   { TGraphicsObject
     In Delphi VCL this is the ancestor of TFont, TPen and TBrush.
@@ -1825,7 +1827,33 @@
     property YResolution: TTiffRational read FYResolution write FYResolution;
   end;
 
+  { TSharedGIFImage }
 
+  TSharedGIFImage = class(TSharedCustomBitmap)
+  end;
+
+  { TGIFImage }
+
+  TGIFImage = class(TFPImageBitmap)
+  private
+    FTransparent: Boolean;
+    FInterlaced: Boolean;
+    FBitsPerPixel: byte;
+  protected
+    procedure InitializeReader(AImage: TLazIntfImage; AReader: TFPCustomImageReader); override;
+    procedure FinalizeReader(AReader: TFPCustomImageReader); override;
+    class function GetReaderClass: TFPCustomImageReaderClass; override;
+    class function GetSharedImageClass: TSharedRasterImageClass; override;
+  public
+    constructor Create; override;
+    class function IsStreamFormatSupported(Stream: TStream): Boolean; override;
+    class function GetFileExtensions: string; override;
+  public
+    property Transparent: Boolean read FTransparent;
+    property Interlaced: Boolean read FInterlaced;
+    property BitsPerPixel: byte read FBitsPerPixel;
+  end;
+
 function GraphicFilter(GraphicClass: TGraphicClass): string;
 function GraphicExtension(GraphicClass: TGraphicClass): string;
 function GraphicFileMask(GraphicClass: TGraphicClass): string;
@@ -2181,7 +2209,7 @@
 procedure Register;
 begin
   RegisterClasses([TBitmap,TPixmap,TPortableNetworkGraphic,
-                   TPortableAnyMapGraphic,TJpegImage,TPicture,
+                   TPortableAnyMapGraphic,TJpegImage,TGIFImage,TPicture,
                    TFont,TPen,TBrush,TRegion]);
 end;
 
@@ -2554,6 +2582,7 @@
 {$I fpimagebitmap.inc}
 {$I bitmap.inc}
 {$I tiffimage.inc}
+{$I gifimage.inc}
 
 function LocalGetSystemFont: HFont;
 begin
Index: include/gifimage.inc
===================================================================
--- include/gifimage.inc	(revision 0)
+++ include/gifimage.inc	(revision 0)
@@ -0,0 +1,73 @@
+{%MainUnit ../graphics.pp}
+
+{******************************************************************************
+                                TGIFImage
+ ******************************************************************************
+
+ *****************************************************************************
+ *                                                                           *
+ *  This file is part of the Lazarus Component Library (LCL)                 *
+ *                                                                           *
+ *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
+ *  for details about the copyright.                                         *
+ *                                                                           *
+ *  This program is distributed in the hope that it will be useful,          *
+ *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
+ *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
+ *                                                                           *
+ *****************************************************************************
+}
+
+{ TGIFImage }
+
+constructor TGIFImage.Create;
+begin
+  inherited Create;
+end;
+
+class function TGIFImage.IsStreamFormatSupported(Stream: TStream): Boolean;
+var
+  Pos: Int64;
+  Signature: array [0..5] of char;
+begin
+  Pos := Stream.Position;
+  try
+    Stream.Read(Signature, SizeOf(Signature));
+    Result := (Signature='GIF89a') or (Signature='GIF87a');
+  finally
+    Stream.Position := Pos;
+  end;
+end;
+
+procedure TGIFImage.FinalizeReader(AReader: TFPCustomImageReader);
+begin
+  inherited;
+  with TFPReaderGif(AReader) do
+  begin
+    FTransparent := Transparent;
+    FInterlaced := Interlace;
+    FBitsPerPixel := BitsPerPixel;
+  end;
+end;
+
+class function TGIFImage.GetFileExtensions: string;
+begin
+  Result := 'gif';
+end;
+
+class function TGIFImage.GetReaderClass: TFPCustomImageReaderClass;
+begin
+  Result := TFPReaderGif;
+end;
+
+class function TGIFImage.GetSharedImageClass: TSharedRasterImageClass;
+begin
+  Result := TSharedGIFImage;
+end;
+
+procedure TGIFImage.InitializeReader(AImage: TLazIntfImage;
+  AReader: TFPCustomImageReader);
+begin
+  inherited;
+  //Nothing by now. Maybe not needed at all.
+end;
Index: include/picture.inc
===================================================================
--- include/picture.inc	(revision 26617)
+++ include/picture.inc	(working copy)
@@ -57,6 +57,7 @@
   Add(TCursorImage.GetFileExtensions, rsCursor, TCursorImage);
   Add(TJpegImage.GetFileExtensions, rsJpeg, TJpegImage);
   Add(TTiffImage.GetFileExtensions, rsTiff, TTiffImage);
+  Add(TGIFImage.GetFileExtensions, rsGIF, TGIFImage);
 end;
 
 procedure TPicFileFormatsList.Clear;
Index: lclstrconsts.pas
===================================================================
--- lclstrconsts.pas	(revision 26617)
+++ lclstrconsts.pas	(working copy)
@@ -267,6 +267,7 @@
   rsCursor = 'Cursor';
   rsJpeg = 'Joint Picture Expert Group';
   rsTiff = 'Tagged Image File Format';
+  rsGIF = 'Graphics Interchange Format';
   rsGraphic = 'Graphic';
   rsUnsupportedClipboardFormat = 'Unsupported clipboard format: %s';
   rsGroupIndexCannotBeLessThanPrevious = 'GroupIndex cannot be less than a '

Paul Ishenin

2010-07-21 04:57

manager   ~0039504

Thanks, applied. Please close if ok.

Issue History

Date Modified Username Field Change
2010-07-20 20:14 José Mejuto New Issue
2010-07-20 20:14 José Mejuto File Added: lcl_gifsupport_readonly.patch
2010-07-21 04:57 Paul Ishenin Fixed in Revision => 26758
2010-07-21 04:57 Paul Ishenin LazTarget => -
2010-07-21 04:57 Paul Ishenin Status new => resolved
2010-07-21 04:57 Paul Ishenin Fixed in Version => 0.9.29 (SVN)
2010-07-21 04:57 Paul Ishenin Resolution open => fixed
2010-07-21 04:57 Paul Ishenin Assigned To => Paul Ishenin
2010-07-21 04:57 Paul Ishenin Note Added: 0039504
2010-07-22 14:05 José Mejuto Status resolved => closed