* fix for 15509.

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


git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@14897 3ad0048d-3df7-0310-abae-a5850022a9f2

2 files changed, 21 insertions, 11 deletions

diff --git a/packages/fcl-image/src/fpimage.pp b/packages/fcl-image/src/fpimage.pp
index 9f70bffa27..6b04ad694d 100644
--- a/packages/fcl-image/src/fpimage.pp
+++ b/packages/fcl-image/src/fpimage.pp
@@ -73,6 +73,7 @@ type
       function GetCount : integer;
       procedure SetColor (index:integer; const Value:TFPColor); virtual;
       function GetColor (index:integer) : TFPColor;
+      procedure SetCapacity (ind : Integer);
       procedure CheckIndex (index:integer); virtual;
       procedure EnlargeData; virtual;
     public
@@ -86,6 +87,7 @@ type
       procedure Clear; virtual;
       property Color [Index : integer] : TFPColor read GetColor write SetColor; default;
       property Count : integer read GetCount write SetCount;
+      property Capacity : integer read FCapacity write SetCapacity;
   end;
 
   TFPCustomImage = class(TPersistent)
diff --git a/packages/fcl-image/src/fppalette.inc b/packages/fcl-image/src/fppalette.inc
index fd0d4bb845..fbcde56a58 100644
--- a/packages/fcl-image/src/fppalette.inc
+++ b/packages/fcl-image/src/fppalette.inc
@@ -122,23 +122,15 @@ begin
 end;
 
 procedure TFPPalette.SetCount (Value:integer);
-var NewData : PFPColorArray;
+var
     O : integer;
 begin
   if Value <> FCount then
     begin
     if Value > FCapacity then
       begin
-      O := FCapacity;
-      FCapacity := Value + 8;
-      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;
+        FCapacity := Value+8;
+        Reallocmem(FData,sizeof(TFPColor)*FCapacity);
       end;
     for o := FCount to Value-1 do
       FData^[o] := colBlack;
@@ -146,6 +138,22 @@ begin
     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;
 begin
   result := FCount;