Browse Source

* clearing palette (if used) before reading image
* determining which handler to use for reading image

luk 22 years ago
parent
commit
0b9255933d
4 changed files with 130 additions and 11 deletions
  1. 13 3
      fcl/image/fphandler.inc
  2. 101 6
      fcl/image/fpimage.inc
  3. 12 2
      fcl/image/fpimage.pp
  4. 4 0
      fcl/image/fppalette.inc

+ 13 - 3
fcl/image/fphandler.inc

@@ -51,7 +51,7 @@ begin
   with ih do
     begin
     FTypeName := ATypeName;
-    FExtention := TheExtentions;
+    FExtention := lowercase(TheExtentions);
     FDefaultExt := CalcDefExt (TheExtentions);
     FReader := AReader;
     FWriter := AWriter;
@@ -77,7 +77,7 @@ begin
     with ih do
       begin
       FTypeName := ATypeName;
-      FExtention := TheExtentions;
+      FExtention := Lowercase(TheExtentions);
       FDefaultExt := CalcDefExt (TheExtentions);
       FReader := AReader;
       FWriter := nil;
@@ -104,7 +104,7 @@ begin
     with ih do
       begin
       FTypeName := ATypeName;
-      FExtention := TheExtentions;
+      FExtention := lowercase(TheExtentions);
       FDefaultExt := CalcDefExt (TheExtentions);
       FReader := nil;
       FWriter := AWriter;
@@ -131,6 +131,14 @@ begin
     result := nil;
 end;
 
+function TImageHandlersManager.GetData (index:integer) : TIHData;
+begin
+  if (index >= 0) and (index < FData.count) then
+    result := TIHData (FData[index])
+  else
+    result := nil;
+end;
+
 function TImageHandlersManager.GetTypeName (index:integer) : string;
 var ih : TIHData;
 begin
@@ -216,6 +224,8 @@ begin
     else
       result := Img;
     FImage := result;
+    if FImage.UsePalette then
+      FImage.Palette.Clear;
     if CheckContents (Str) then
       begin
       InternalRead (Str, result)

+ 101 - 6
fcl/image/fpimage.inc

@@ -39,10 +39,8 @@ begin
 end;
 
 procedure TFPCustomImage.LoadFromFile (const filename:String; Handler:TFPCustomImageReader);
-
-var 
+var
   fs : TStream;
-
 begin
   if FileExists (filename) then
     begin
@@ -63,10 +61,8 @@ begin
 end;
 
 procedure TFPCustomImage.SaveToFile (const filename:String; Handler:TFPCustomImageWriter);
-
-var 
+var
   fs : TStream;
-
 begin
   fs := TFileStream.Create (filename, fmCreate);
   try
@@ -76,6 +72,105 @@ begin
   end
 end;
 
+procedure TFPCustomImage.LoadFromStream (Str:TStream);
+var r : integer;
+    h : TFPCustomImageReaderClass;
+    reader : TFPCustomImageReader;
+    msg : string;
+    d : TIHData;
+begin
+  with ImageHandlers do
+    try
+      r := count-1;
+      while (r >= 0) do
+        begin
+        d := GetData(r);
+        if assigned (d) then
+          h := d.FReader;
+        if assigned (h) then
+          begin
+          reader := h.Create;
+          with reader do
+            try
+              if CheckContents (str) then
+                try
+                  FStream := str;
+                  FImage := self;
+                  InternalRead (str, self);
+                  break;
+                except
+                  on e : exception do
+                    msg := e.message;
+                end;
+            finally
+              Free;
+              str.seek (soFromBeginning, 0);
+            end;
+          end;
+        dec (r);
+        end;
+    except
+      on e : exception do
+        FPImgError (StrCantDetermineType, [e.message]);
+    end;
+  if r < 0 then
+    if msg = '' then
+      FPImgError (StrNoCorrectReaderFound)
+    else
+      FPImgError (StrReadWithError, [Msg]);
+end;
+
+procedure TFPCustomImage.LoadFromFile (const filename:String);
+var e,s : string;
+    r : integer;
+    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.Fextention+';') <> 0) then
+          try
+            h := d.FReader;
+            if assigned (h) then
+              begin
+              reader := h.Create;
+              loadfromfile (filename, reader);
+              break;
+              end;
+          except
+            on e : exception do
+              Msg := e.message;
+          end;
+        dec (r);
+        end
+    end;
+  if Msg = '' then
+    begin
+    if r < 0 then
+      begin
+      f := TFileStream.Create (filename, fmOpenRead);
+      try
+        LoadFromStream (f);
+      finally
+        f.Free;
+      end;
+      end;
+    end
+  else
+    FPImgError (StrReadWithError, [Msg]);
+end;
+
 procedure TFPCustomImage.SetHeight (Value : integer);
 begin
   if Value <> FHeight then

+ 12 - 2
fcl/image/fpimage.pp

@@ -83,6 +83,7 @@ type
       procedure Merge (pal : TFPPalette); virtual;
       function IndexOf (const AColor: TFPColor) : integer; virtual;
       function Add (const Value: TFPColor) : integer; virtual;
+      procedure Clear; virtual;
       property Color [Index : integer] : TFPColor read GetColor write SetColor; default;
       property Count : integer read GetCount write SetCount;
   end;
@@ -124,7 +125,9 @@ type
       procedure Assign(Source: TPersistent); override;
       // 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);
       procedure SaveToStream (Str:TStream; Handler:TFPCustomImageWriter);
       procedure SaveToFile (const filename:String; Handler:TFPCustomImageWriter);
       // Size and data
@@ -229,6 +232,7 @@ type
       function GetDefExt (const TypeName:string) : string;
       function GetTypeName (index:integer) : string;
       function GetData (const ATypeName:string) : TIHData;
+      function GetData (index : integer) : TIHData;
       function GetCount : integer;
     public
       constructor Create;
@@ -279,6 +283,9 @@ type
     StrTypeAlreadyExist,
     StrTypeReaderAlreadyExist,
     StrTypeWriterAlreadyExist,
+    StrCantDetermineType,
+    StrNoCorrectReaderFound,
+    StrReadWithError,
     StrNoPaletteAvailable
     );
 
@@ -296,6 +303,9 @@ const
      'Image type "%s" already exists',
      'Image type "%s" already has a reader class',
      'Image type "%s" already has a writer class',
+     'Error while determining image type of stream: %s',
+     'Can''t determine image type of stream',
+     'Error while reading stream: %s',
      'No palette available'
      );
 
@@ -313,9 +323,9 @@ begin
   raise FPImageException.Create (ErrorText[Fmt]);
 end;
 
-{$i FPPalette.inc}
-{$i FPHandler.inc}
 {$i FPImage.inc}
+{$i FPHandler.inc}
+{$i FPPalette.inc}
 {$i FPColCnv.inc}
 
 function FPColor (r,g,b,a:word) : TFPColor;

+ 4 - 0
fcl/image/fppalette.inc

@@ -145,3 +145,7 @@ begin
     result := Add (AColor);
 end;
 
+procedure TFPPalette.Clear;
+begin
+  SetCount (0);
+end;