--- Merging r31942 into '.':

U    packages/fcl-image/src/fpreadtiff.pas
--- Recording mergeinfo for merge of r31942 into '.':
 U   .
--- Merging r32813 into '.':
U    packages/fcl-image/src/fpwritepng.pp
--- Recording mergeinfo for merge of r32813 into '.':
 G   .
--- Merging r33464 into '.':
U    packages/fcl-image/src/fpimage.inc
--- Recording mergeinfo for merge of r33464 into '.':
 G   .
--- Merging r33465 into '.':
U    packages/fcl-image/src/fpreadjpeg.pas
--- Recording mergeinfo for merge of r33465 into '.':
 G   .
--- Merging r33466 into '.':
U    packages/fcl-image/src/fphandler.inc
--- Recording mergeinfo for merge of r33466 into '.':
 G   .
--- Merging r33467 into '.':
G    packages/fcl-image/src/fpimage.inc
--- Recording mergeinfo for merge of r33467 into '.':
 G   .
--- Merging r33471 into '.':
G    packages/fcl-image/src/fphandler.inc
G    packages/fcl-image/src/fpreadjpeg.pas
G    packages/fcl-image/src/fpimage.inc
--- Recording mergeinfo for merge of r33471 into '.':
 G   .
--- Merging r33472 into '.':
U    packages/fcl-image/src/fpreadpng.pp
--- Recording mergeinfo for merge of r33472 into '.':
 G   .
--- Merging r33473 into '.':
G    packages/fcl-image/src/fpimage.inc
U    packages/fcl-image/src/fpimage.pp
U    packages/fcl-image/src/fphandler.inc
--- Recording mergeinfo for merge of r33473 into '.':
 G   .
--- Merging r33474 into '.':
G    packages/fcl-image/src/fpimage.pp
G    packages/fcl-image/src/fpreadjpeg.pas
G    packages/fcl-image/src/fphandler.inc
--- Recording mergeinfo for merge of r33474 into '.':
 G   .

# revisions: 31942,32813,33464,33465,33466,33467,33471,33472,33473,33474

git-svn-id: branches/fixes_3_0@33580 -

packages/fcl-image/src/fphandler.inc

@@ -252,6 +252,32 @@ begin
   end;
 end;
 
+function TFPCustomImageReader.InternalSize(Str: TStream): TPoint;
+
+begin
+  Result.X:=-1;
+  Result.Y:=-1;
+end;
+
+function TFPCustomImageReader.ImageSize(Str: TStream): TPoint;
+var InRead : boolean;
+    P : Int64;
+begin
+  InRead := assigned(FStream);
+  if not assigned(Str) then
+    raise FPImageException.Create(ErrorText[StrNoStream]);
+  try
+    FStream := Str;
+    P:=Str.Position;
+    result := InternalSize (Str);
+    Str.Position:=P;
+  finally
+    if not InRead then
+      FStream := nil;
+  end;
+end;
+
+
 { TFPCustomImageWriter }
 
 procedure TFPCustomImageWriter.ImageWrite (Str:TStream; Img:TFPCustomImage);

packages/fcl-image/src/fpimage.inc

@@ -71,47 +71,30 @@ begin
   end
 end;
 
-procedure TFPCustomImage.SaveToFile (const filename:String);
+function TFPCustomImage.SaveToFile (const filename:String):boolean;
 
-var e,s : string;
-    r : integer;
-    f : TFileStream;
-    h : TFPCustomImageWriterClass;
+var h : TFPCustomImageWriterClass;
     Writer : TFPCustomImageWriter;
-    d : TIHData;
     Msg : string;
 
 begin
-  e := lowercase (ExtractFileExt(filename));
-  if (e <> '') and (e[1] = '.') then
-    delete (e,1,1);
-  with ImageHandlers do
-    begin
-    r := count-1;
-    s := e + ';';
-    while (r >= 0) do
+  Msg := '';
+  try
+    h := FindWriterFromFileName(filename);
+    Result := assigned (h);
+    if Result then
       begin
-      d := GetData(r);
-      if (pos(s,d.Fextension+';') <> 0) then
-        try
-          h := d.FWriter;
-          if assigned (h) then
-            begin
-            Writer := h.Create;
-            try
-              SaveTofile (filename, Writer);
-            finally
-              Writer.Free;
-            end;
-            break;
-            end;
-        except
-          on e : exception do
-            Msg := e.message;
-        end;
-      dec (r);
-      end
-    end;
+      Writer := h.Create;
+      try
+        SaveTofile (filename, Writer);
+      finally
+        Writer.Free;
+      end;
+      end;
+  except
+    on e : exception do
+      Msg := e.message;
+  end;
   if (Msg<>'') then
     FPImgError (StrWriteWithError, [Msg]);
 end;
@@ -123,7 +106,9 @@ var r : integer;
     reader : TFPCustomImageReader;
     msg : string;
     d : TIHData;
+    startPos: Int64;
 begin
+  startPos := str.Position;
   with ImageHandlers do
     try
       r := count-1;
@@ -139,6 +124,7 @@ begin
             try
               if CheckContents (str) then
                 try
+                  str.Position := startPos;
                   FStream := str;
                   FImage := self;
                   InternalRead (str, self);
@@ -149,7 +135,7 @@ begin
                 end;
             finally
               Free;
-              str.seek (soFromBeginning, 0);
+              str.Position := startPos;
             end;
           end;
         dec (r);
@@ -165,48 +151,32 @@ begin
       FPImgError (StrReadWithError, [Msg]);
 end;
 
-procedure TFPCustomImage.LoadFromFile (const filename:String);
-var e,s : string;
-    r : integer;
-    f : TFileStream;
+function TFPCustomImage.LoadFromFile (const filename:String):boolean;
+var f : TFileStream;
     h : TFPCustomImageReaderClass;
     reader : TFPCustomImageReader;
-    d : TIHData;
     Msg : string;
 begin
-  e := lowercase (ExtractFileExt(filename));
-  if (e <> '') and (e[1] = '.') then
-    delete (e,1,1);
-  with ImageHandlers do
-    begin
-      r := count-1;
-      s := e + ';';
-      while (r >= 0) do
-        begin
-        d := GetData(r);
-        if (pos(s,d.Fextension+';') <> 0) then
-          try
-            h := d.FReader;
-            if assigned (h) then
-              begin
-              reader := h.Create;
-              try
-                loadfromfile (filename, reader);
-              finally
-                Reader.Free;
-              end;
-              break;
-              end;
-          except
-            on e : exception do
-              Msg := e.message;
-          end;
-        dec (r);
-        end
-    end;
+  Msg := '';
+  try
+    h := FindReaderFromFileName(filename);
+    Result := assigned (h);
+    if Result then
+      begin
+      reader := h.Create;
+      try
+        loadfromfile (filename, reader);
+      finally
+        Reader.Free;
+      end;
+      end;
+  except
+    on e : exception do
+      Msg := e.message;
+  end;
   if Msg = '' then
     begin
-    if r < 0 then
+    if h = nil then
       begin
       f := TFileStream.Create (filename, fmOpenRead);
       try
@@ -295,6 +265,63 @@ begin
   result := FExtra.count;
 end;
 
+class function TFPCustomImage.FindHandlerFromExtension(extension: String
+  ): TIHData;
+var s : string;
+    r : integer;
+begin
+  extension := lowercase (extension);
+  if (extension <> '') and (extension[1] = '.') then
+    delete (extension,1,1);
+  with ImageHandlers do
+    begin
+      r := count-1;
+      s := extension + ';';
+      while (r >= 0) do
+        begin
+        Result := GetData(r);
+        if (pos(s,Result.Fextension+';') <> 0) then
+          Exit;
+        dec (r);
+        end;
+    end;
+  Result := nil;
+end;
+
+class function TFPCustomImage.FindReaderFromExtension(const extension: String
+  ): TFPCustomImageReaderClass;
+var d : TIHData;
+begin
+  d := FindHandlerFromExtension(extension);
+  if d<>nil then
+    Result := d.FReader
+  else
+    Result := nil;
+end;
+
+class function TFPCustomImage.FindReaderFromFileName(const filename: String
+  ): TFPCustomImageReaderClass;
+begin
+  Result := FindReaderFromExtension(ExtractFileExt(filename));
+end;
+
+class function TFPCustomImage.FindWriterFromExtension(const extension: String
+  ): TFPCustomImageWriterClass;
+var d : TIHData;
+begin
+  d := FindHandlerFromExtension(extension);
+  if d<>nil then
+    Result := d.FWriter
+  else
+    Result := nil;
+end;
+
+class function TFPCustomImage.FindWriterFromFileName(const filename: String
+  ): TFPCustomImageWriterClass;
+begin
+  Result := FindWriterFromExtension(ExtractFileExt(filename));
+end;
+
 procedure TFPCustomImage.RemoveExtra (const key:string);
 var p : integer;
 begin

packages/fcl-image/src/fpimage.pp

@@ -22,7 +22,10 @@ uses sysutils, classes;
 type
 
   TFPCustomImageReader = class;
+  TFPCustomImageReaderClass = class of TFPCustomImageReader;
   TFPCustomImageWriter = class;
+  TFPCustomImageWriterClass = class of TFPCustomImageWriter;
+  TIHData = class;
   TFPCustomImage = class;
 
   FPImageException = class (exception);
@@ -125,14 +128,20 @@ type
       constructor create (AWidth,AHeight:integer); virtual;
       destructor destroy; override;
       procedure Assign(Source: TPersistent); override;
+      // Image handlers
+      class function FindHandlerFromExtension(extension:String): TIHData;
+      class function FindReaderFromFileName(const filename:String): TFPCustomImageReaderClass;
+      class function FindReaderFromExtension(const extension:String): TFPCustomImageReaderClass;
+      class function FindWriterFromFileName(const filename:String): TFPCustomImageWriterClass;
+      class function FindWriterFromExtension(const extension:String): TFPCustomImageWriterClass;
       // Saving and loading
       procedure LoadFromStream (Str:TStream; Handler:TFPCustomImageReader);
       procedure LoadFromStream (Str:TStream);
       procedure LoadFromFile (const filename:String; Handler:TFPCustomImageReader);
-      procedure LoadFromFile (const filename:String);
+      function LoadFromFile (const filename:String): Boolean;
       procedure SaveToStream (Str:TStream; Handler:TFPCustomImageWriter);
       procedure SaveToFile (const filename:String; Handler:TFPCustomImageWriter);
-      procedure SaveToFile (const filename:String);
+      function SaveToFile (const filename:String): Boolean;
       // Size and data
       procedure SetSize (AWidth, AHeight : integer); virtual;
       property  Height : integer read FHeight write SetHeight;
@@ -164,7 +173,7 @@ type
   PFPIntegerArray = ^TFPIntegerArray;
 
   TFPMemoryImage = class (TFPCustomImage)
-    private
+    protected
       function GetInternalColor(x,y:integer):TFPColor;override;
       procedure SetInternalColor (x,y:integer; const Value:TFPColor);override;
       procedure SetUsePalette (Value:boolean);override;
@@ -199,16 +208,18 @@ type
     protected
       procedure InternalRead  (Str:TStream; Img:TFPCustomImage); virtual; abstract;
       function  InternalCheck (Str:TStream) : boolean; virtual; abstract;
+      function  InternalSize  (Str:TStream): TPoint; virtual; 
     public
       constructor Create; override;
       function ImageRead (Str:TStream; Img:TFPCustomImage) : TFPCustomImage;
       // reads image
       function CheckContents (Str:TStream) : boolean;
-      // Gives True if contents is readable
+      // Returns true if the content is readable
+      function ImageSize(Str:TStream): TPoint;
+      // returns the size of image in stream without loading it completely. -1,-1 means this is not implemented.
       property DefaultImageClass : TFPCustomImageClass read FDefImageClass write FDefImageClass;
       // Image Class to create when no img is given for reading
   end;
-  TFPCustomImageReaderClass = class of TFPCustomImageReader;
 
   TFPCustomImageWriter = class (TFPCustomImageHandler)
     protected
@@ -217,7 +228,6 @@ type
       procedure ImageWrite (Str:TStream; Img:TFPCustomImage);
       // writes given image to stream
   end;
-  TFPCustomImageWriterClass = class of TFPCustomImageWriter;
 
   TIHData = class
     private

packages/fcl-image/src/fpreadjpeg.pas

@@ -64,6 +64,7 @@ type
   protected
     procedure InternalRead(Str: TStream; Img: TFPCustomImage); override;
     function  InternalCheck(Str: TStream): boolean; override;
+    function  InternalSize(Str:TStream): TPoint; override;
   public
     constructor Create; override;
     destructor Destroy; override;
@@ -450,12 +451,47 @@ begin
   end;
 end;
 
+function TFPReaderJPEG.InternalSize(Str: TStream): TPoint;
+var
+  JInfo: jpeg_decompress_struct;
+  JError: jpeg_error_mgr;
+
+  procedure SetSource;
+  begin
+    jpeg_stdio_src(@JInfo, @Str);
+  end;
+
+  procedure ReadHeader;
+  begin
+    jpeg_read_header(@JInfo, TRUE);
+    Result.X := JInfo.image_width;
+    Result.Y := JInfo.image_height;
+  end;
+
+begin
+  FillChar(JInfo,SizeOf(JInfo),0);
+  if Str.Position < Str.Size then begin
+    JError:=jpeg_std_error;
+    JInfo.err := @JError;
+    jpeg_CreateDecompress(@JInfo, JPEG_LIB_VERSION, SizeOf(JInfo));
+    try
+      SetSource;
+      ReadHeader;
+    finally
+      jpeg_Destroy_Decompress(@JInfo);
+    end;
+  end;
+end;
+
 function TFPReaderJPEG.InternalCheck(Str: TStream): boolean;
+var
+  Buf: array[0..1] of Byte = (0, 0);
+  p: Int64;
 begin
-  // ToDo: read header and check
-  Result:=false;
-  if Str=nil then exit;
-  Result:=true;
+  if Str=nil then exit(false);
+  p:=Str.Position;
+  Result := (Str.Read(Buf, 2)=2) and (Buf[0]=$FF) and (Buf[1]=$D8); // byte sequence FFD8 = start of image
+  Str.Position:=p;
 end;
 
 constructor TFPReaderJPEG.Create;

packages/fcl-image/src/fpreadpng.pp

@@ -846,7 +846,7 @@ begin
     for r := 0 to 7 do
     begin
       If SigCheck[r] <> Signature[r] then
-        raise PNGImageException.Create('This is not PNG-data');
+        Exit(false);
     end;
     // Check IHDR
     ReadChunk;

packages/fcl-image/src/fpreadtiff.pas

@@ -1486,11 +1486,20 @@ begin
   if EntryType<>2 then
     TiffError('asciiz expected, but found '+IntToStr(EntryType));
   EntryCount:=ReadDWord;
-  EntryStart:=ReadDWord;
-  SetStreamPos(EntryStart);
   SetLength(Result,EntryCount-1);
-  if EntryCount>1 then
+  if EntryCount>4 then begin
+    // long string -> next 4 DWord is the offset
+    EntryStart:=ReadDWord;
+    SetStreamPos(EntryStart);
     s.Read(Result[1],EntryCount-1);
+  end else begin
+    // short string -> stored directly in the next 4 bytes
+    if Result<>'' then
+      s.Read(Result[1],length(Result));
+    // skip rest of 4 bytes
+    if length(Result)<4 then
+      s.Read(EntryStart,4-length(Result));
+  end;
 end;
 
 function TFPReaderTiff.ReadByte: Byte;

packages/fcl-image/src/fpwritepng.pp

@@ -2,7 +2,7 @@
     This file is part of the Free Pascal run time library.
     Copyright (c) 2003 by the Free Pascal development team
 
-    XPM writer class.
+    PNG writer class.
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.

utils/fpcm/revision.inc

@@ -1 +1 @@
-'2015-10-06 rev 31969'
+'2016-04-05 rev 33425'