paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 16:06:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fix for 15509.

Browse Source 
* setcount drastically simplified
   * Capacity now property with setter, to allow shrinking (but only till count)

git-svn-id: trunk@14897 -
This commit is contained in:
marco 2010-02-13 13:47:06 +00:00
parent 5e1a09f817
commit b99d54383c
2 changed files with 21 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
packages/fcl-image/src/fpimage.pp
View File

@ -73,6 +73,7 @@ type
function GetCount : integer; function GetCount : integer;
procedure SetColor (index:integer; const Value:TFPColor); virtual; procedure SetColor (index:integer; const Value:TFPColor); virtual;
function GetColor (index:integer) : TFPColor; function GetColor (index:integer) : TFPColor;
procedure SetCapacity (ind : Integer);
procedure CheckIndex (index:integer); virtual; procedure CheckIndex (index:integer); virtual;
procedure EnlargeData; virtual; procedure EnlargeData; virtual;
public public
@ -86,6 +87,7 @@ type
procedure Clear; virtual; procedure Clear; virtual;
property Color [Index : integer] : TFPColor read GetColor write SetColor; default; property Color [Index : integer] : TFPColor read GetColor write SetColor; default;
property Count : integer read GetCount write SetCount; property Count : integer read GetCount write SetCount;
property Capacity : integer read FCapacity write SetCapacity;
end; end;
TFPCustomImage = class(TPersistent) TFPCustomImage = class(TPersistent)

30
packages/fcl-image/src/fppalette.inc
View File

@ -122,23 +122,15 @@ begin
end; end;
procedure TFPPalette.SetCount (Value:integer); procedure TFPPalette.SetCount (Value:integer);
var NewData : PFPColorArray; var
O : integer; O : integer;
begin begin
if Value <> FCount then if Value <> FCount then
begin begin
if Value > FCapacity then if Value > FCapacity then
begin begin
O := FCapacity; FCapacity := Value+8;
FCapacity := Value + 8; Reallocmem(FData,sizeof(TFPColor)*FCapacity);
if FCapacity > 0 then
GetMem (NewData, sizeof(TFPColor)*FCapacity)
else
FData := nil;
move (FData^, NewData^, sizeof(TFPColor)*FCount);
if O > 0 then
FreeMem (FData);
FData := NewData;
end; end;
for o := FCount to Value-1 do for o := FCount to Value-1 do
FData^[o] := colBlack; FData^[o] := colBlack;
@ -146,6 +138,22 @@ begin
end; end;
end; end;
procedure TFPPalette.SetCapacity (ind : Integer);
var o : Integer;
begin
if ind<count then ind:=count;
if ind<>fcapacity then
begin
fcapacity:=ind;
Reallocmem(FData,sizeof(TFPColor)*FCapacity);
end;
if ind>count then
begin
for o := FCount to ind-1 do
FData^[o] := colBlack;
end;
end;
function TFPPalette.IndexOf (const AColor:TFPColor) : integer; function TFPPalette.IndexOf (const AColor:TFPColor) : integer;
begin begin
result := FCount; result := FCount;