mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-08 14:39:33 +02:00
+ Applied patches from Matthias Gaertner
This commit is contained in:
michael
parent
9eaa44de48
commit
b7ae35ec3b
@ -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);
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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}
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user