* fixed tstringlist.setcapacity for growing

This commit is contained in:
peter 1998-11-12 23:43:44 +00:00
parent 70261b4c01
commit 551046a9cd

View File

@ -94,7 +94,7 @@ Procedure TStrings.ReadData(Reader: TReader);
begin
end;
Function GetQuotedString (Var P : Pchar) : AnsiString;
Function GetQuotedString (Var P : Pchar) : String;
Var P1,L : Pchar;
@ -112,7 +112,7 @@ begin
P:=P+1;
If P1-P>0 then
begin
SetLength(Result,(P1-P));
SetLength(Result,P1-P);
L:=Pointer(Result);
Move (P^,L^,P1-P);
P:=P1+1;
@ -650,6 +650,7 @@ end;
Function TStringList.Get(Index: Integer): string;
begin
pointer(Result):=nil;
If (Index<0) or (INdex>=Fcount) then
Error (SListIndexError,Index);
Result:=Flist^[Index].FString;
@ -711,8 +712,7 @@ end;
Procedure TStringList.SetCapacity(NewCapacity: Integer);
Var NewList : Pointer;
MSize : Longint;
Var NewList,ToFree : Pointer;
begin
If (NewCapacity<0) then
@ -721,21 +721,23 @@ begin
begin
GetMem (NewList,NewCapacity*SizeOf(TStringItem));
If NewList=Nil then
//!! Find another one here !!
Error (SListCapacityError,NewCapacity);
If Assigned(FList) then
begin
MSize:=FCapacity*Sizeof(TStringItem);
System.Move (FList^,NewList^,MSize);
FillWord (Pchar(NewList)[MSize],(NewCapacity-FCapacity)*WordRatio, 0);
FreeMem (Flist,MSize);
System.Move (FList^,NewList^,FCapacity*Sizeof(TStringItem));
FillChar (PStringItemList(NewList)^[FCapacity],(NewCapacity-FCapacity)*sizeof(TStringItem), 0);
FreeMem (Flist,FCapacity*SizeOf(TStringItem));
end;
Flist:=NewList;
FCapacity:=NewCapacity;
end
else if NewCapacity<FCapacity then
begin
NewList:=Flist+NewCapacity*SizeOf(TStringItem);
FreeMem (NewList, (FCapacity-NewCapacity)*SizeOf(TStringItem));
If NewCapacity<0 then
Error (SListCapacityError,NewCapacity);
ToFree:=Flist+NewCapacity*SizeOf(TStringItem);
FreeMem (ToFree, (FCapacity-NewCapacity)*SizeOf(TStringItem));
FCapacity:=NewCapacity;
end;
end;
@ -898,8 +900,8 @@ end;
{
$Log$
Revision 1.6 1998-11-09 10:07:24 michael
+ Bugfix in setcapacity, sizes were wrong
Revision 1.7 1998-11-12 23:43:44 peter
* fixed tstringlist.setcapacity for growing
Revision 1.5 1998/10/30 14:52:52 michael
+ Added format in interface