فهرست منبع

* Applied patch from Luiz Amerigo to have Delphi compatible behaviour when freeing a stringlist (bug 21529)

git-svn-id: trunk@20570 -
michael 13 سال پیش
والد
کامیت
d1b209025f
2فایلهای تغییر یافته به همراه24 افزوده شده و 23 حذف شده
  1. 1 0
      rtl/objpas/classes/classesh.inc
  2. 23 23
      rtl/objpas/classes/stringl.inc

+ 1 - 0
rtl/objpas/classes/classesh.inc

@@ -679,6 +679,7 @@ type
     FOwnsObjects : Boolean;
     procedure ExchangeItems(Index1, Index2: Integer);
     procedure Grow;
+    procedure InternalClear;
     procedure QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
     procedure SetSorted(Value: Boolean);
     procedure SetCaseSensitive(b : boolean);

+ 23 - 23
rtl/objpas/classes/stringl.inc

@@ -908,7 +908,28 @@ begin
   SetCapacity(NC);
 end;
 
+Procedure TStringList.InternalClear;
 
+Var
+  I: Integer;
+
+begin
+  if FOwnsObjects then
+    begin
+      For I:=0 to FCount-1 do
+        begin
+          Flist^[I].FString:='';
+          freeandnil(Flist^[i].FObject);
+        end;
+    end
+  else
+    begin
+      For I:=0 to FCount-1 do
+        Flist^[I].FString:='';
+    end;
+  FCount:=0;
+  SetCapacity(0);
+end;
 
 Procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
 var
@@ -1128,13 +1149,8 @@ end;
 
 destructor TStringList.Destroy;
 
-Var I : Longint;
-
 begin
-  FOnChange:=Nil;
-  FOnChanging:=Nil;
-  Clear;
-  SetCapacity(0);
+  InternalClear;
   Inherited destroy;
 end;
 
@@ -1156,26 +1172,10 @@ end;
 
 Procedure TStringList.Clear;
 
-Var I : longint;
-
 begin
   if FCount = 0 then Exit;
   Changing;
-  if FOwnsObjects then
-    begin
-      For I:=0 to FCount-1 do
-        begin
-          Flist^[I].FString:='';
-          freeandnil(Flist^[i].FObject);
-        end;
-    end
-  else
-    begin
-      For I:=0 to FCount-1 do
-        Flist^[I].FString:='';
-    end;
-  FCount:=0;
-  SetCapacity(0);
+  InternalClear;
   Changed;
 end;