+ Applied patches from Matthias Gaertner

fcl/image/fpcolcnv.inc

@@ -82,7 +82,7 @@ begin
   result := FillOtherBits (w ,BitDepths[CFmt]);
 end;
 
-function ConvertColor (From : TColorData; FromFmt:TColorFormat) : TFPColor;
+function ConvertColor (const From : TColorData; FromFmt:TColorFormat) : TFPColor;
   function SetGrayScale (value : word) : TFPColor;
   begin
     with result do
@@ -139,17 +139,19 @@ begin
   end;
 end;
 
-function ConvertColor (From : TDeviceColor) : TFPColor;
+function ConvertColor (const From : TDeviceColor) : TFPColor;
 begin
   result := ConvertColor (From.data, From.Fmt)
 end;
 
-function CalculateGray (c : TFPcolor; Bits:byte) : TColorData;
-var r : longword;
+function CalculateGray (const c : TFPcolor; Bits:byte) : TColorData;
 begin
+  // MG: ToDo
+  if (c.alpha=0) or (Bits=0) then ;
+  Result:=0;
 end;
 
-function CalculateGrayA (c : TFPcolor; Bits:byte) : TColorData;
+function CalculateGrayA (const c : TFPcolor; Bits:byte) : TColorData;
 var r : longword;
     d : byte;
 begin
@@ -160,7 +162,7 @@ begin
   result := result or r;
 end;
 
-function ConvertColorToData (From : TFPColor; Fmt : TColorFormat) : TColorData;
+function ConvertColorToData (const From : TFPColor; Fmt : TColorFormat) : TColorData;
 var sb : TShiftBits;
     cb : TColorBits;
   function MakeSample (Value:word; ToShift:shortint; ToUse:TColorData) : TColorData;
@@ -205,20 +207,20 @@ begin
   end;
 end;
 
-function ConvertColor (From : TFPColor; Fmt : TColorFormat) : TDeviceColor;
+function ConvertColor (const From : TFPColor; Fmt : TColorFormat) : TDeviceColor;
 begin
   result.Fmt := Fmt;
   result.data := convertColorToData(From, Fmt);
 end;
 
-function ConvertColorToData (From : TDeviceColor; Fmt : TColorFormat) : TColorData;
+function ConvertColorToData (const From : TDeviceColor; Fmt : TColorFormat) : TColorData;
 var c : TFPColor;
 begin
   c := ConvertColor (From);
   result := ConvertColorToData (c, Fmt);
 end;
 
-function ConvertColor (From : TDeviceColor; Fmt : TColorFormat) : TDeviceColor;
+function ConvertColor (const From : TDeviceColor; Fmt : TColorFormat) : TDeviceColor;
 begin
   result.Fmt := Fmt;
   result.data := ConvertColorToData (From, Fmt);

fcl/image/fphandler.inc

@@ -25,7 +25,7 @@ begin
     result := copy(TheExtentions, 1, p-1);
 end;
 
-procedure TImageHandlersManager.RegisterImageHandlers (ATypeName,TheExtentions:string;
+procedure TImageHandlersManager.RegisterImageHandlers (const ATypeName,TheExtentions:string;
                    AReader:TFPCustomImageReaderClass; AWriter:TFPCustomImageWriterClass);
 var ih : TIHData;
 begin
@@ -44,7 +44,7 @@ begin
   FData.Add (ih);
 end;
 
-procedure TImageHandlersManager.RegisterImageReader (ATypeName,TheExtentions:string;
+procedure TImageHandlersManager.RegisterImageReader (const ATypeName,TheExtentions:string;
                    AReader:TFPCustomImageReaderClass);
 var ih : TIHData;
 begin
@@ -71,7 +71,7 @@ begin
     end;
 end;
 
-procedure TImageHandlersManager.RegisterImageWriter (ATypeName,TheExtentions:string;
+procedure TImageHandlersManager.RegisterImageWriter (const ATypeName,TheExtentions:string;
                    AWriter:TFPCustomImageWriterClass);
 var ih : TIHData;
 begin
@@ -103,7 +103,7 @@ begin
   result := FData.Count;
 end;
 
-function TImageHandlersManager.GetData (ATypeName:string) : TIHData;
+function TImageHandlersManager.GetData (const ATypeName:string) : TIHData;
 var r : integer;
 begin
   r := FData.count;
@@ -123,7 +123,7 @@ begin
   result := ih.FTypeName;
 end;
 
-function TImageHandlersManager.GetReader (TypeName:string) : TFPCustomImageReaderClass;
+function TImageHandlersManager.GetReader (const TypeName:string) : TFPCustomImageReaderClass;
 var ih : TIHData;
 begin
   ih := GetData (TypeName);
@@ -133,7 +133,7 @@ begin
     result := nil;
 end;
 
-function TImageHandlersManager.GetWriter (TypeName:string) : TFPCustomImageWriterClass;
+function TImageHandlersManager.GetWriter (const TypeName:string) : TFPCustomImageWriterClass;
 var ih : TIHData;
 begin
   ih := GetData (TypeName);
@@ -143,7 +143,7 @@ begin
     result := nil;
 end;
 
-function TImageHandlersManager.GetExt (TypeName:string) : string;
+function TImageHandlersManager.GetExt (const TypeName:string) : string;
 var ih : TIHData;
 begin
   ih := GetData (TypeName);
@@ -153,7 +153,7 @@ begin
     result := '';
 end;
 
-function TImageHandlersManager.GetDefExt (TypeName:string) : string;
+function TImageHandlersManager.GetDefExt (const TypeName:string) : string;
 var ih : TIHData;
 begin
   ih := GetData (TypeName);

fcl/image/fpimage.inc

@@ -23,15 +23,20 @@ begin
   Handler.ImageRead (Str, self);
 end;
 
-procedure TFPCustomImage.LoadFromFile (filename:String; Handler:TFPCustomImageReader);
-var str : TStream;
+procedure TFPCustomImage.LoadFromFile (const filename:String; Handler:TFPCustomImageReader);
+
+var 
+  fs : TStream;
+
 begin
   if FileExists (filename) then
+    begin
+    fs := TFileStream.Create (filename, fmOpenRead);
     try
-      str := TFileStream.Create (filename, fmOpenRead);
-      LoadFromStream (str, handler);
+      LoadFromStream (fs, handler);
     finally
-      str.Free;
+      fs.Free;
+    end;
     end
   else
     FPImgError (StrNoFile, [filename]);
@@ -42,14 +47,17 @@ begin
   Handler.ImageWrite (Str, Self);
 end;
 
-procedure TFPCustomImage.SaveToFile (filename:String; Handler:TFPCustomImageWriter);
-var str : TStream;
+procedure TFPCustomImage.SaveToFile (const filename:String; Handler:TFPCustomImageWriter);
+
+var 
+  fs : TStream;
+
 begin
+  fs := TFileStream.Create (filename, fmCreate);
   try
-    str := TFileStream.Create (filename, fmCreate);
-    SaveToStream (str, handler);
+    SaveToStream (fs, handler);
   finally
-    str.Free;
+    fs.Free;
   end
 end;
 
@@ -71,7 +79,7 @@ begin
   FHeight := AHeight;
 end;
 
-procedure TFPCustomImage.SetExtraValue (index:integer; AValue:string);
+procedure TFPCustomImage.SetExtraValue (index:integer; const AValue:string);
 var s : string;
     p : integer;
 begin
@@ -95,7 +103,7 @@ begin
     result := '';
 end;
 
-procedure TFPCustomImage.SetExtraKey (index:integer; AValue:string);
+procedure TFPCustomImage.SetExtraKey (index:integer; const AValue:string);
 var s : string;
     p : integer;
 begin
@@ -113,12 +121,12 @@ begin
   result := FExtra.Names[index];
 end;
 
-procedure TFPCustomImage.SetExtra (key:String; AValue:string);
+procedure TFPCustomImage.SetExtra (const key:String; const AValue:string);
 begin
   FExtra.values[key] := AValue;
 end;
 
-function TFPCustomImage.GetExtra (key:String) : string;
+function TFPCustomImage.GetExtra (const key:String) : string;
 begin
   result := FExtra.values[key];
 end;
@@ -128,10 +136,10 @@ begin
   result := FExtra.count;
 end;
 
-procedure TFPCustomImage.RemoveExtra (key:string);
+procedure TFPCustomImage.RemoveExtra (const key:string);
 var p : integer;
 begin
-  p := FExtra.indexOfName(key);
+  p := FExtra.IndexOfName(key);
   if p >= 0 then
     FExtra.Delete (p);
 end;
@@ -149,7 +157,7 @@ begin
   result := GetInternalPixel(x,y);
 end;
 
-procedure TFPCustomImage.SetColor (x,y:integer; Value:TFPColor);
+procedure TFPCustomImage.SetColor (x,y:integer; const Value:TFPColor);
 begin
   CheckIndex (x,y);
   SetInternalColor (x,y,Value);
@@ -161,7 +169,7 @@ begin
   result := GetInternalColor(x,y);
 end;
 
-procedure TFPCustomImage.SetInternalColor (x,y:integer; Value:TFPColor);
+procedure TFPCustomImage.SetInternalColor (x,y:integer; const Value:TFPColor);
 var i : integer;
 begin
   i := FPalette.IndexOf (Value);
@@ -220,7 +228,9 @@ end;
 
 destructor TFPMemoryImage.Destroy;
 begin
-  FreeMem (FData);
+  // MG: missing if
+  if FData<>nil then
+    FreeMem (FData);
   inherited Destroy;
 end;
 
@@ -246,7 +256,8 @@ procedure TFPMemoryImage.SetSize (AWidth, AHeight : integer);
 var w, h, r, old : integer;
     NewData : PFPIntegerArray;
 begin
-  if (AWidth <> Width) and (AHeight <> Height) then
+  // MG: bug: was 'and'
+  if (AWidth <> Width) or (AHeight <> Height) then
     begin
     old := Height * Width;
     r := SizeOf(integer)*AWidth*AHeight;
@@ -257,7 +268,8 @@ begin
       GetMem (NewData, r);
       Fillchar (Newdata^[0], r, $FF);
       end;
-    if (old <> 0) and assigned(FData) then
+    // MG: missing "and (NewData<>nil)"
+    if (old <> 0) and assigned(FData) and (NewData<>nil) then
       begin
       if r <> 0 then
         begin

fcl/image/fpimage.pp

@@ -40,7 +40,7 @@ type
       FCount, FCapacity : integer;
       procedure SetCount (Value:integer);
       function GetCount : integer;
-      procedure SetColor (index:integer; Value:TFPColor);
+      procedure SetColor (index:integer; const Value:TFPColor);
       function GetColor (index:integer) : TFPColor;
       procedure CheckIndex (index:integer);
       procedure EnlargeData;
@@ -49,8 +49,8 @@ type
       destructor destroy; override;
       procedure Build (Img : TFPCustomImage);
       procedure Merge (pal : TFPPalette);
-      function IndexOf (AColor:TFPColor) : integer;
-      function Add (Value:TFPColor) : integer;
+      function IndexOf (const AColor: TFPColor) : integer;
+      function Add (const Value: TFPColor) : integer;
       property Color [Index : integer] : TFPColor read GetColor write SetColor; default;
       property Count : integer read GetCount write SetCount;
   end;
@@ -62,15 +62,15 @@ type
       FHeight, FWidth : integer;
       procedure SetHeight (Value : integer);
       procedure SetWidth (Value : integer);
-      procedure SetExtra (key:String; AValue:string);
-      function GetExtra (key:String) : string;
-      procedure SetExtraValue (index:integer; AValue:string);
+      procedure SetExtra (const key:String; const AValue:string);
+      function GetExtra (const key:String) : string;
+      procedure SetExtraValue (index:integer; const AValue:string);
       function GetExtraValue (index:integer) : string;
-      procedure SetExtraKey (index:integer; AValue:string);
+      procedure SetExtraKey (index:integer; const AValue:string);
       function GetExtraKey (index:integer) : string;
       procedure CheckIndex (x,y:integer);
       procedure CheckPaletteIndex (PalIndex:integer);
-      procedure SetColor (x,y:integer; Value:TFPColor);
+      procedure SetColor (x,y:integer; const Value:TFPColor);
       function GetColor (x,y:integer) : TFPColor;
       procedure SetPixel (x,y:integer; Value:integer);
       function GetPixel (x,y:integer) : integer;
@@ -78,7 +78,7 @@ type
       procedure SetUsePalette (Value:boolean);
     protected
       // Procedures to store the data. Implemented in descendants
-      procedure SetInternalColor (x,y:integer; Value:TFPColor); virtual;
+      procedure SetInternalColor (x,y:integer; const Value:TFPColor); virtual;
       function GetInternalColor (x,y:integer) : TFPColor; virtual;
       procedure SetInternalPixel (x,y:integer; Value:integer); virtual; abstract;
       function GetInternalPixel (x,y:integer) : integer; virtual; abstract;
@@ -87,9 +87,9 @@ type
       destructor destroy; override;
       // Saving and loading
       procedure LoadFromStream (Str:TStream; Handler:TFPCustomImageReader);
-      procedure LoadFromFile (filename:String; Handler:TFPCustomImageReader);
+      procedure LoadFromFile (const filename:String; Handler:TFPCustomImageReader);
       procedure SaveToStream (Str:TStream; Handler:TFPCustomImageWriter);
-      procedure SaveToFile (filename:String; Handler:TFPCustomImageWriter);
+      procedure SaveToFile (const filename:String; Handler:TFPCustomImageWriter);
       // Size and data
       procedure SetSize (AWidth, AHeight : integer); virtual;
       property  Height : integer read FHeight write SetHeight;
@@ -100,10 +100,10 @@ type
       property  Palette : TFPPalette read FPalette;
       property  Pixels [x,y:integer] : integer read GetPixel write SetPixel;
       // Info unrelated with the image representation
-      property  Extra [key:string] : string read GetExtra write SetExtra;
+      property  Extra [const key:string] : string read GetExtra write SetExtra;
       property  ExtraValue [index:integer] : string read GetExtraValue write SetExtraValue;
       property  ExtraKey [index:integer] : string read GetExtraKey write SetExtraKey;
-      procedure RemoveExtra (key:string);
+      procedure RemoveExtra (const key:string);
       function  ExtraCount : integer;
   end;
   TFPCustomImageClass = class of TFPCustomImage;
@@ -141,7 +141,7 @@ type
       procedure InternalRead  (Str:TStream; Img:TFPCustomImage); virtual; abstract;
       function  InternalCheck (Str:TStream) : boolean; virtual; abstract;
     public
-      constructor create; override;
+      constructor Create; override;
       function ImageRead (Str:TStream; Img:TFPCustomImage) : TFPCustomImage;
       // reads image
       function CheckContents (Str:TStream) : boolean;
@@ -170,55 +170,75 @@ type
   TImageHandlersManager = class
     private
       FData : TList;
-      function Getreader (TypeName:string) : TFPCustomImageReaderClass;
-      function GetWriter (TypeName:string) : TFPCustomImageWriterClass;
-      function GetExt (TypeName:string) : string;
-      function GetDefExt (TypeName:string) : string;
+      function GetReader (const TypeName:string) : TFPCustomImageReaderClass;
+      function GetWriter (const TypeName:string) : TFPCustomImageWriterClass;
+      function GetExt (const TypeName:string) : string;
+      function GetDefExt (const TypeName:string) : string;
       function GetTypeName (index:integer) : string;
-      function GetData (ATypeName:string) : TIHData;
+      function GetData (const ATypeName:string) : TIHData;
       function GetCount : integer;
     public
       constructor Create;
       destructor Destroy; override;
-      procedure RegisterImageHandlers (ATypeName,TheExtentions:string;
+      procedure RegisterImageHandlers (const ATypeName,TheExtentions:string;
                    AReader:TFPCustomImageReaderClass; AWriter:TFPCustomImageWriterClass);
-      procedure RegisterImageReader (ATypeName,TheExtentions:string;
+      procedure RegisterImageReader (const ATypeName,TheExtentions:string;
                    AReader:TFPCustomImageReaderClass);
-      procedure RegisterImageWriter (ATypeName,TheExtentions:string;
+      procedure RegisterImageWriter (const ATypeName,TheExtentions:string;
                    AWriter:TFPCustomImageWriterClass);
       property Count : integer read GetCount;
-      property ImageReader [TypeName:string] : TFPCustomImageReaderClass read GetReader;
-      property ImageWriter [TypeName:string] : TFPCustomImageWriterClass read GetWriter;
-      property Extentions [TypeName:string] : string read GetExt;
-      property DefaultExtention [TypeName:string] : string read GetDefExt;
+      property ImageReader [const TypeName:string] : TFPCustomImageReaderClass read GetReader;
+      property ImageWriter [const TypeName:string] : TFPCustomImageWriterClass read GetWriter;
+      property Extentions [const TypeName:string] : string read GetExt;
+      property DefaultExtention [const TypeName:string] : string read GetDefExt;
       property TypeNames [index:integer] : string read GetTypeName;
     end;
 
 function ShiftAndFill (initial:word; CorrectBits:byte):word;
 function FillOtherBits (initial:word;CorrectBits:byte):word;
-function ConvertColor (From : TDeviceColor) : TFPColor;
-function ConvertColor (From : TColorData; FromFmt:TColorFormat) : TFPColor;
-function ConvertColorToData (From : TFPColor; Fmt : TColorFormat) : TColorData;
-function ConvertColorToData (From : TDeviceColor; Fmt : TColorFormat) : TColorData;
-function ConvertColor (From : TFPColor; Fmt : TColorFormat) : TDeviceColor;
-function ConvertColor (From : TDeviceColor; Fmt : TColorFormat) : TDeviceColor;
+function ConvertColor (const From : TDeviceColor) : TFPColor;
+function ConvertColor (const From : TColorData; FromFmt:TColorFormat) : TFPColor;
+function ConvertColorToData (const From : TFPColor; Fmt : TColorFormat) : TColorData;
+function ConvertColorToData (const From : TDeviceColor; Fmt : TColorFormat) : TColorData;
+function ConvertColor (const From : TFPColor; Fmt : TColorFormat) : TDeviceColor;
+function ConvertColor (const From : TDeviceColor; Fmt : TColorFormat) : TDeviceColor;
 
 operator = (const c,d:TFPColor) : boolean;
 
 var ImageHandlers : TImageHandlersManager;
 
 type
-  TErrorTextIndices = (StrInvalidIndex, StrNoImageToWrite, StrNoFile,
-    StrNoStream, StrPalette, StrImageX, StrImageY, StrImageExtra,
-    StrTypeAlreadyExist,StrTypeReaderAlreadyExist,StrTypeWriterAlreadyExist,
-    StrNoPaletteAvailable);
+  TErrorTextIndices = (
+    StrInvalidIndex,
+    StrNoImageToWrite,
+    StrNoFile,
+    StrNoStream,
+    StrPalette,
+    StrImageX,
+    StrImageY,
+    StrImageExtra,
+    StrTypeAlreadyExist,
+    StrTypeReaderAlreadyExist,
+    StrTypeWriterAlreadyExist,
+    StrNoPaletteAvailable
+    );
 
 const
+  // MG: ToDo: move to implementation and add a function to map to resourcestrings
   ErrorText : array[TErrorTextIndices] of string =
-    ('Invalid %s index %d', 'No image to write', 'File "%s" does not exist',
-     'No stream to write to', 'palette', 'horizontal pixel', 'vertical pixel', 'extra',
-     'Image type "%s" already exists','Image type "%s" already has a reader class',
-     'Image type "%s" already has a writer class', 'No palette available');
+    ('Invalid %s index %d',
+     'No image to write',
+     'File "%s" does not exist',
+     'No stream to write to',
+     'palette',
+     'horizontal pixel',
+     'vertical pixel',
+     'extra',
+     'Image type "%s" already exists',
+     'Image type "%s" already has a reader class',
+     'Image type "%s" already has a writer class',
+     'No palette available'
+     );
 
 {$i FPColors.inc}
 

fcl/image/fppalette.inc

@@ -43,7 +43,7 @@ begin
     FPImgError (StrInvalidIndex,[ErrorText[StrPalette],index]);
 end;
 
-function TFPPalette.Add (Value:TFPColor) : integer;
+function TFPPalette.Add (const Value:TFPColor) : integer;
 begin
   result := FCount;
   inc (FCount);
@@ -52,7 +52,7 @@ begin
   FData^[result] := Value;
 end;
 
-procedure TFPPalette.SetColor (index:integer; Value:TFPColor);
+procedure TFPPalette.SetColor (index:integer; const Value:TFPColor);
 begin
   if index = FCount then
     Add (Value)
@@ -84,7 +84,8 @@ begin
   else if FCapacity <= 128 then
     FCapacity := 256
   else
-    inc (FCapacity, 256);
+    // MG: changed to exponential growth
+    inc (FCapacity, FCapacity);
   GetMem (NewData, sizeof(TFPColor)*FCapacity);
   if old > 0 then
     begin
@@ -119,7 +120,7 @@ begin
     end;
 end;
 
-function TFPPalette.IndexOf (AColor:TFPColor) : integer;
+function TFPPalette.IndexOf (const AColor:TFPColor) : integer;
 begin
   result := FCount;
   repeat

fcl/image/fpreadpng.pp

@@ -525,6 +525,8 @@ end;
 
 procedure TFPReaderPNG.InternalRead (Str:TStream; Img:TFPCustomImage);
 begin
+  if Str<>TheStream then
+    writeln('WARNING: TFPReaderPNG.InternalRead Str<>TheStream');
   with Header do
     Img.SetSize (Width, Height);
   ZData := TMemoryStream.Create;

fcl/image/fpreadxpm.pp

@@ -194,7 +194,7 @@ var l : TStringList;
       end;
   end;
 
-  procedure AddPalette (code:string;Acolor:TFPColor);
+  procedure AddPalette (const code:string;const Acolor:TFPColor);
   var r : integer;
   begin
     r := Palette.Add(code);
@@ -243,7 +243,7 @@ var l : TStringList;
       AddToPalette (l[r]);
   end;
 
-  procedure ReadLine (s : string; imgindex : integer);
+  procedure ReadLine (const s : string; imgindex : integer);
   var color, r, p : integer;
       code : string;
   begin

fcl/image/fpwritexpm.pp

@@ -47,7 +47,7 @@ var p, l : TStringList;
     c, len, r, t : integer;
   procedure BuildPaletteStrings;
   var r,c,e : integer;
-    procedure MakeCodes (head:string; charplace:integer);
+    procedure MakeCodes (const head:string; charplace:integer);
     var r : integer;
     begin
       r := 1;