Changeset 30 for trunk/Components/TemplateGenerics/Generic/GenericList.inc

Timestamp:

Sep 8, 2012, 9:28:39 PM (12 years ago)

Author:

chronos

Message:

• Updated: Component versions.
• Added: Missing forms.

Location:

trunk

Files:

• . (modified) (1 prop)
• Components/TemplateGenerics (modified) (1 prop)
• Components/TemplateGenerics/Generic/GenericList.inc (modified) (24 diffs)

trunk

@@ -3 +3 @@
 backup
 tunneler.exe
+heaptrclog.trc

@@ -3 +3 @@
 backup
 tunneler.exe
+heaptrclog.trc

trunk/Components/TemplateGenerics/Generic/GenericList.inc

@@ -1 +1 @@
 {$IFDEF INTERFACE}
+
+  // TGList implemented using templates
+  // - item operations (Add, Insert, ReplaceArray, Get, Set, IndexOf,
+  //   Extract, Delete, Exchange)
+  // - item range operations (DeleteItems, InsertItems, ReplaceItems,
+  //   Move, Fill)
+  // - other TGList operations (AddList, InsertList,
+  //   ReplaceList, GetList, IndexOfList)
+  // - dynamic array operations (AddArray, InsertArray,
+  //   ReplaceArray, GetArray, IndexOfArray)
+  // - all items operations (Clear, Reverse, Sort)
 
   TGList = class;
@@ -13 +24 @@
     FItems: array of TGListItem;
     FCount: TGListIndex;
+    FUpdateCount: Integer;
+    FOnUpdate: TNotifyEvent;
     function Get(Index: TGListIndex): TGListItem;
     function GetCapacity: TGListIndex;
@@ -21 +34 @@
     procedure SetLast(AValue: TGListItem);
     procedure SetFirst(AValue: TGListItem);
+    procedure QuickSort(L, R : TGListIndex; Compare: TGListSortCompare);
+  protected
     procedure Put(Index: TGListIndex; const AValue: TGListItem); virtual;
     procedure SetCount(const AValue: TGListIndex); virtual;
-    procedure QuickSort(L, R : TGListIndex; Compare: TGListSortCompare);
   public
+    type
+      PItem = ^TGListItem;
+    function CompareMem(P1, P2: Pointer; Length: cardinal): Boolean; inline;
     function Add(Item: TGListItem): TGListIndex;
     procedure AddArray(Values: array of TGListItem);
     procedure AddList(List: TGList);
+    procedure AddListPart(List: TGList; ItemIndex, ItemCount: TGListIndex);
     procedure Assign(Source: TGList); virtual;
+    constructor Create; virtual;
     procedure Clear; virtual;
     procedure Delete(Index: TGListIndex); virtual;
@@ -38 +57 @@
     property First: TGListItem read GetFirst write SetFirst;
     procedure Fill(Start, Count: TGListIndex; Value: TGListItem);
-    function GetArray: TGListItemArray;
+    function GetArray(Index, ACount: TGListIndex): TGListItemArray;
+    procedure GetList(List: TGList; Index, ACount: TGListIndex);
+    procedure GetBuffer(Index: TGListIndex; var Buffer; Count: TGListIndex);
     function Implode(Separator: string; Converter: TGListToStringConverter): string;
-    function IndexOf(Item: TGListItem; Start: TGListIndex = 0): TGListIndex;
+    function IndexOf(Item: TGListItem; Start: TGListIndex = 0): TGListIndex; virtual;
     function IndexOfList(List: TGList; Start: TGListIndex = 0): TGListIndex;
+    function IndexOfArray(Values: array of TGListItem; Start: TGListIndex = 0): TGListIndex;
     procedure Insert(Index: TGListIndex; Item: TGListItem);
     procedure InsertList(Index: TGListIndex; List: TGList);
     procedure InsertArray(Index: TGListIndex; Values: array of TGListItem);
+    procedure InsertCount(Index: TGListIndex; ACount: TGListIndex);
     procedure Move(CurIndex, NewIndex: TGListIndex);
     procedure MoveItems(CurIndex, NewIndex, Count: TGListIndex);
     function Remove(Item: TGListItem): TGListIndex;
     procedure Reverse;
-    procedure Replace(Index: TGListIndex; Source: TGList);
+    procedure ReplaceArray(Index: TGListIndex; Values: array of TGListItem);
+    procedure ReplaceList(Index: TGListIndex; Source: TGList);
+    procedure ReplaceListPart(Index: TGListIndex; Source: TGList;
+      SourceIndex, SourceCount: TGListIndex);
+    procedure ReplaceBuffer(Index: TGListIndex; var Buffer; Count: TGListIndex);
     procedure Sort(Compare: TGListSortCompare);
-    procedure SetArray(Values: TGListItemArray);
+    procedure SetArray(Values: array of TGListItem);
+    procedure BeginUpdate;
+    procedure EndUpdate;
+    procedure Update;
     property Count: TGListIndex read FCount write SetCount;
     property Capacity: TGListIndex read GetCapacity write SetCapacity;
     property Items[Index: TGListIndex]: TGListItem read Get write Put; default;
     property Last: TGListItem read GetLast write SetLast;
+    property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
   end;
   
@@ -73 +104 @@
 { TGList }
 
-procedure TGList.Replace(Index: TGListIndex; Source: TGList);
+constructor TGList.Create;
+begin
+  FCount := 0;
+end;
+
+procedure TGList.GetBuffer(Index: TGListIndex; var Buffer; Count: TGListIndex);
+var
+  P: PItem;
+  I: TGListIndex;
+begin
+  if (Index + Count) > FCount then
+    raise EListError.CreateFmt(SListIndexError, [Index + Count]);
+  P := PItem(@Buffer);
+  I := 0;
+  while I < Count do begin
+    P^ := Items[Index + I];
+    Inc(P, 1);
+    I := I + 1;
+  end;
+end;
+
+procedure TGList.ReplaceBuffer(Index: TGListIndex; var Buffer; Count: TGListIndex);
+var
+  P: PItem;
+  I: TGListIndex;
+begin
+  if (Index + Count) > FCount then
+    raise EListError.CreateFmt(SListIndexError, [Index + Count]);
+  P := PItem(@Buffer);
+  I := 0;
+  while I < Count do begin
+    Items[Index + I] := P^;
+    Inc(P, 1);
+    I := I + 1;
+  end;
+end;
+
+procedure TGList.ReplaceArray(Index: TGListIndex; Values: array of TGListItem);
+var
+  I: TGListIndex;
+begin
+  I := 0;
+  while I < Length(Values) do begin
+    Items[Index + I] := Values[I];
+    I := I + 1;
+  end;
+  Update;
+end;
+
+procedure TGList.ReplaceList(Index: TGListIndex; Source: TGList);
 var
   I: TGListIndex;
@@ -82 +162 @@
     I := I + 1;
   end;
+  Update;
+end;
+
+procedure TGList.ReplaceListPart(Index: TGListIndex; Source: TGList;
+  SourceIndex, SourceCount: TGListIndex);
+var
+  I: TGListIndex;
+begin
+  I := 0;
+  while I < SourceCount do begin
+    Items[Index + I] := Source[SourceIndex + I];
+    I := I + 1;
+  end;
+  Update;
 end;
 
@@ -143 +237 @@
 end;
 
-function TGList.GetArray: TGListItemArray;
+function TGList.GetArray(Index, ACount: TGListIndex): TGListItemArray;
 var
   I: Integer;
 begin
-  SetLength(Result, Count);
-  I := 0;
-  while I < Count do begin
-    Result[I] := FItems[I];
-    I := I + 1;
-  end;
+  SetLength(Result, ACount);
+  I := 0;
+  while I < Count do begin
+    Result[I] := FItems[Index + I];
+    I := I + 1;
+  end;
+end;
+
+procedure TGList.GetList(List: TGList; Index, ACount: TGListIndex);
+begin
+  List.Clear;
+  List.AddListPart(Self, Index, ACount);
 end;
 
@@ -194 +294 @@
     I := I + 1;
   end;
+  Update;
 end;
 
@@ -208 +309 @@
 end;
 
+function TGList.CompareMem(P1, P2: Pointer; Length: cardinal): Boolean;
+var
+  I: Cardinal;
+begin
+  Result := True;
+  I := 0;
+  if (P1) <> (P2) then
+    while Result and (I < Length) do
+    begin
+      Result := PByte(P1)^ = PByte(P2)^;
+      Inc(I);
+      Inc(pchar(P1));
+      Inc(pchar(P2));
+    end;
+end;
+
 function TGList.IndexOf(Item: TGListItem; Start: TGListIndex): TGListIndex;
 begin
   Result := Start;
   while (Result < FCount) and
-  not CompareMem(Addr(FItems[Result]), Addr(Item), SizeOf(TGListItem)) do
+//  not CompareMem(@FItems[Result], @Item, SizeOf(TGListItem)) do
+  not (CompareByte(FItems[Result], Item, SizeOf(TGListItem)) = 0) do
     Result := Result + 1;
   if Result = FCount then Result := -1;
@@ -219 +337 @@
 procedure TGList.Insert(Index: TGListIndex; Item: TGListItem);
 begin
-  if (Index < 0) or (Index > FCount ) then
+  if (Index < 0) or (Index > FCount) then
     raise EListError.CreateFmt(SListIndexError, [Index]);
-  if FCount = Capacity then SetCapacityOptimized(Capacity + 1);
+  InsertCount(Index, 1);
+  FItems[Index] := Item;
+  Update;
+end;
+
+procedure TGList.InsertList(Index: TGListIndex; List: TGList);
+begin
+  if (Index < 0) or (Index > FCount) then
+    raise EListError.CreateFmt(SListIndexError, [Index]);
+  InsertCount(Index, List.Count);
+  ReplaceList(Index, List);
+end;
+
+procedure TGList.InsertArray(Index: TGListIndex; Values: array of TGListItem);
+begin
+  if (Index < 0) or (Index > FCount) then
+    raise EListError.CreateFmt(SListIndexError, [Index]);
+  InsertCount(Index, Length(Values));
+  ReplaceArray(Index, Values);
+end;
+
+procedure TGList.InsertCount(Index: TGListIndex; ACount: TGListIndex);
+begin
+  if (Index < 0) or (Index > FCount) then
+    raise EListError.CreateFmt(SListIndexError, [Index]);
+  Count := Count + ACount;
   if Index < FCount then
-    System.Move(FItems[Index], FItems[Index + 1], (FCount - Index) * SizeOf(TGListItem));
-  FItems[Index] := Item;
-  FCount := FCount + 1;
-end;
-
-procedure TGList.InsertList(Index: TGListIndex; List: TGList);
-var
-  I: TGListIndex;
-begin
-  I := 0;
-  while (I < List.Count) do begin
-    Insert(Index + I, List[I]);
-    I := I + 1;
-  end;
+    System.Move(FItems[Index], FItems[Index + ACount], (FCount - ACount - Index) * SizeOf(TGListItem));
+  Update;
 end;
 
@@ -258 +389 @@
 end;
 
+function TGList.IndexOfArray(Values: array of TGListItem; Start: TGListIndex): TGListIndex;
+var
+  I: TGListIndex;
+begin
+  if Length(Values) > 0 then begin
+    Result := IndexOf(Values[0], Start);
+    if Result <> -1 then begin
+      I := 1;
+      while I < Length(Values) do begin
+        if not CompareMem(Addr(FItems[Result + I]), Addr(Values[I]), SizeOf(TGListItem)) then begin
+          Result := -1;
+          Break;
+        end;
+        I := I + 1;
+      end;
+    end;
+  end else Result := -1;
+end;
+
 function TGList.GetLast: TGListItem;
 begin
@@ -308 +458 @@
   //Delete(CurIndex);
   //Insert(NewIndex, Temp);
+  Update;
 end;
 
@@ -333 +484 @@
     end;
   end;
+  Update;
 end;
 
@@ -339 +491 @@
   Result := IndexOf(Item);
   if Result <> -1 then
-    Delete(Result);
+    Delete(Result)
+    else raise Exception.CreateFmt(SItemNotFound, [0]);
 end;
 
@@ -368 +521 @@
     I := I + 1;
   end;
+  Update;
 end;
 
@@ -374 +528 @@
   if FCount > 1 then
     QuickSort(0, FCount - 1, Compare);
+  Update;
 end;
 
@@ -385 +540 @@
     I := I + 1;
   end;
-end;
-
-procedure TGList.SetArray(Values: TGListItemArray);
+  Update;
+end;
+
+procedure TGList.SetArray(Values: array of TGListItem);
 var
   I: TGListIndex;
@@ -399 +555 @@
 end;
 
-procedure TGList.InsertArray(Index: TGListIndex; Values: array of TGListItem);
-var
-  I: TGListIndex;
-begin
-  I := 0;
-  while I <= High(Values) do begin
-    Insert(Index + I, Values[I]);
-    I := I + 1;
-  end;
+procedure TGList.BeginUpdate;
+begin
+  Inc(FUpdateCount);
+end;
+
+procedure TGList.EndUpdate;
+begin
+  Dec(FUpdateCount);
+  Update;
+end;
+
+procedure TGList.Update;
+begin
+  if Assigned(FOnUpdate) and (FUpdateCount = 0) then FOnUpdate(Self);
 end;
 
@@ -440 +601 @@
   Result := FCount - 1;
   FItems[Result] := Item;
+  Update;
 end;
 
@@ -445 +607 @@
 var
   I: TGListIndex;
-begin
-  I := 0;
-  while I < List.Count do begin
-    Add(List[I]);
-    I := I + 1;
-  end;
+  J: TGListIndex;
+begin
+  I := Count;
+  J := 0;
+  Count := Count + List.Count;
+  while I < Count do begin
+    Items[I] := List[J];
+    I := I + 1;
+    J := J + 1;
+  end;
+  Update;
+end;
+
+procedure TGList.AddListPart(List: TGList; ItemIndex, ItemCount: TGListIndex);
+var
+  I: TGListIndex;
+  J: TGListIndex;
+begin
+  I := Count;
+  J := ItemIndex;
+  Count := Count + ItemCount;
+  while I < Count do begin
+    Items[I] := List[J];
+    I := I + 1;
+    J := J + 1;
+  end;
+  Update;
 end;
 
@@ -466 +649 @@
   System.Move(FItems[Index + 1], FItems[Index], (FCount - Index) * SizeOf(TGListItem));
   SetCapacityOptimized(Capacity - 1);
+  Update;
 end;
 
@@ -477 +661 @@
     I := I + 1;
   end;
+  Update;
 end;
 
@@ -488 +673 @@
     I := I + 1;
   end;
+  Update;
 end;
 
@@ -501 +687 @@
   FItems[Index1] := FItems[Index2];
   FItems[Index2] := Temp;
+  Update;
 end;
 

@@ -3 +3 @@
 backup
 tunneler.exe
+heaptrclog.trc