* Patch from Ondrej Pokorny to implement and use TFPCustomImage.FindHandlerFromExtension

git-svn-id: trunk@33473 -

packages/fcl-image/src/fphandler.inc

@@ -252,6 +252,7 @@ begin
   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;
@@ -168,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
@@ -298,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;
@@ -204,11 +213,10 @@ type
       function ImageRead (Str:TStream; Img:TFPCustomImage) : TFPCustomImage;
       // reads image
       function CheckContents (Str:TStream) : boolean;
-      // Gives True if contents is readable
+      // returns the size of image in stream without loading it completely
       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 +225,6 @@ type
       procedure ImageWrite (Str:TStream; Img:TFPCustomImage);
       // writes given image to stream
   end;
-  TFPCustomImageWriterClass = class of TFPCustomImageWriter;
 
   TIHData = class
     private