From b7ae35ec3bf0b9e902c35a635f1540194cd10e71 Mon Sep 17 00:00:00 2001 From: michael Date: Mon, 30 Jun 2003 19:18:23 +0000 Subject: [PATCH] + Applied patches from Matthias Gaertner --- fcl/image/fpcolcnv.inc | 20 ++++---- fcl/image/fphandler.inc | 16 +++---- fcl/image/fpimage.inc | 54 +++++++++++++--------- fcl/image/fpimage.pp | 100 ++++++++++++++++++++++++---------------- fcl/image/fppalette.inc | 9 ++-- fcl/image/fpreadpng.pp | 2 + fcl/image/fpreadxpm.pp | 4 +- fcl/image/fpwritexpm.pp | 2 +- 8 files changed, 122 insertions(+), 85 deletions(-) diff --git a/fcl/image/fpcolcnv.inc b/fcl/image/fpcolcnv.inc index 9ddedcb89f..26599670e9 100644 --- a/fcl/image/fpcolcnv.inc +++ b/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); diff --git a/fcl/image/fphandler.inc b/fcl/image/fphandler.inc index 7516c401fc..b07a0349a3 100644 --- a/fcl/image/fphandler.inc +++ b/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); diff --git a/fcl/image/fpimage.inc b/fcl/image/fpimage.inc index 9c9339d076..d5cbb52267 100644 --- a/fcl/image/fpimage.inc +++ b/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 diff --git a/fcl/image/fpimage.pp b/fcl/image/fpimage.pp index 1e9ba7cb7e..84b9da525e 100644 --- a/fcl/image/fpimage.pp +++ b/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} diff --git a/fcl/image/fppalette.inc b/fcl/image/fppalette.inc index 6dbed46242..a0fff89518 100644 --- a/fcl/image/fppalette.inc +++ b/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 diff --git a/fcl/image/fpreadpng.pp b/fcl/image/fpreadpng.pp index b27043f321..f133e32dfa 100644 --- a/fcl/image/fpreadpng.pp +++ b/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; diff --git a/fcl/image/fpreadxpm.pp b/fcl/image/fpreadxpm.pp index 3f38d0dc5b..05787c014f 100644 --- a/fcl/image/fpreadxpm.pp +++ b/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 diff --git a/fcl/image/fpwritexpm.pp b/fcl/image/fpwritexpm.pp index e6f01fdf0e..ad848ac201 100644 --- a/fcl/image/fpwritexpm.pp +++ b/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;