Changeset 30 for trunk/Components/TemplateGenerics/Generic

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/GenericDictionary.inc (modified) (2 diffs)
• Components/TemplateGenerics/Generic/GenericList.inc (modified) (24 diffs)
• Components/TemplateGenerics/Generic/GenericListObject.inc (modified) (4 diffs)
• Components/TemplateGenerics/Generic/GenericListString.inc (modified) (2 diffs)
• Components/TemplateGenerics/Generic/GenericPoint.inc (modified) (2 diffs)
• Components/TemplateGenerics/Generic/GenericQueue.inc (modified) (4 diffs)
• Components/TemplateGenerics/Generic/GenericRectangle.inc (added)
• Components/TemplateGenerics/Generic/GenericStream.inc (added)

trunk

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

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

trunk/Components/TemplateGenerics/Generic/GenericDictionary.inc

@@ -11 +11 @@
 {$DEFINE TGListItem := TGPair}
 {$DEFINE TGList := TGDictionaryList}
-{$DEFINE TGListSortCompare := TDictionarySortCompare}
-{$DEFINE TGListToStringConverter := TDictionaryToStringConverter}
-{$DEFINE TGListFromStringConverter := TDictionaryFromStringConverter}
-{$DEFINE TGListItemArray := TDictionaryItemArray}
+{$DEFINE TGListSortCompare := TGDictionarySortCompare}
+{$DEFINE TGListToStringConverter := TGDictionaryToStringConverter}
+{$DEFINE TGListFromStringConverter := TGDictionaryFromStringConverter}
+{$DEFINE TGListItemArray := TGDictionaryItemArray}
 {$DEFINE INTERFACE}
 {$I 'GenericList.inc'}
@@ -37 +37 @@
 {$ENDIF}
 
+
+{$IFDEF IMPLEMENTATION_USES}
+{$I '..\Generic\GenericList.inc'}
+{$UNDEF IMPLEMENTATION_USES}
+{$ENDIF}
+
+
 {$IFDEF IMPLEMENTATION}
-
-{$UNDEF IMPLEMENTATION}
-{$DEFINE IMPLEMENTATION_USES}
-{$I '..\Generic\GenericList.inc'}
 
 {$DEFINE TGListIndex := TGDictionaryIndex}
 {$DEFINE TGListItem := TGPair}
 {$DEFINE TGList := TGDictionaryList}
-{$DEFINE TGListSortCompare := TDictionarySortCompare}
-{$DEFINE TGListToStringConverter := TDictionaryToStringConverter}
-{$DEFINE TGListFromStringConverter := TDictionaryFromStringConverter}
-{$DEFINE TGListItemArray := TDictionaryItemArray}
+{$DEFINE TGListSortCompare := TGDictionarySortCompare}
+{$DEFINE TGListToStringConverter := TGDictionaryToStringConverter}
+{$DEFINE TGListFromStringConverter := TGDictionaryFromStringConverter}
+{$DEFINE TGListItemArray := TGDictionaryItemArray}
 {$DEFINE IMPLEMENTATION}
 {$I 'GenericList.inc'}

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;
 

trunk/Components/TemplateGenerics/Generic/GenericListObject.inc

@@ -13 +13 @@
   // TGListObject<TListObjectIndex, TListObjectItem> = class(TGList)
   TGListObject = class(TGList)
-  private
+  protected
     procedure Put(Index: TGListIndex; const AValue: TGListItem); override;
+    procedure SetCount(const AValue: TGListIndex); override;
   public
     OwnsObjects: Boolean;
+    function AddNew(NewObject: TGListItem = nil): TGListItem;
+    function InsertNew(Index: TGListIndex; NewObject: TGListItem = nil): TGListItem;
     procedure Delete(Index: TGListObjectIndex); override;
-    procedure Clear; override;
     procedure Assign(Source: TGList); override;
-    constructor Create;
+    constructor Create; override;
     destructor Destroy; override;
   end;
@@ -49 +51 @@
 { TGListObject }
 
+function TGListObject.AddNew(NewObject: TGListItem = nil): TGListItem;
+begin
+  if Assigned(NewObject) then Result := NewObject
+    else Result := TGListItem.Create;
+  Add(Result);
+end;
+
+function TGListObject.InsertNew(Index: TGListIndex;
+  NewObject: TGListItem = nil): TGListItem;
+begin
+  if Assigned(NewObject) then Result := NewObject
+    else Result := TGListItem.Create;
+  Insert(Index, Result);
+end;
+
 procedure TGListObject.Assign(Source: TGList);
 begin
@@ -58 +75 @@
 procedure TGListObject.Put(Index: TGListIndex; const AValue: TGListItem);
 begin
-  if OwnsObjects then FItems[Index].Free;
+  if OwnsObjects and (FItems[Index] <> AValue) then FItems[Index].Free;
   inherited Put(Index, AValue);
 end;
@@ -68 +85 @@
 end;
 
-procedure TGListObject.Clear;
+procedure TGListObject.SetCount(const AValue: TGListIndex);
 var
   I: TGListObjectIndex;
 begin
   if OwnsObjects then begin
-    I := 0;
-    while I < Count do begin
+    I := FCount - 1;
+    while I >= AValue do begin
       FItems[I].Free;
-      I := I + 1;
+      I := I - 1;
     end;
   end;
-  inherited Clear;
+  inherited;
 end;
 

trunk/Components/TemplateGenerics/Generic/GenericListString.inc

@@ -18 +18 @@
     procedure Clear; override;
     procedure Assign(Source: TGList); override;
-    constructor Create;
+    function IndexOf(Item: TGListItem; Start: TGListIndex = 0): TGListIndex; override;
+    constructor Create; override;
     destructor Destroy; override;
   end;
@@ -71 +72 @@
 end;
 
+function TGListString.IndexOf(Item: TGListItem; Start: TGListIndex): TGListIndex;
+begin
+  Result := Start;
+  while (Result < Count) and
+  (CompareStr(FItems[Result], Item) <> 0) do
+    Result := Result + 1;
+  if Result = FCount then Result := -1;
+end;
+
 constructor TGListString.Create;
 begin

trunk/Components/TemplateGenerics/Generic/GenericPoint.inc

@@ -1 +1 @@
 {$IFDEF INTERFACE}
 
-// TGPoint<TPointCoord, TPointType> = class
-TGPoint = class
-  Coordinate: array[TGPointIndex] of TGPointType;
-  //procedure SetArray(Items: array[TGPointIndex] of TGPointType);
+// TGPoint<TPointType> = class
+TGPoint = record
+  X: TGPointType;
+  Y: TGPointType;
+  procedure Add(Point: TGPoint);
 end;
 
@@ -12 +13 @@
 {$IFDEF IMPLEMENTATION}
 
+procedure TGPoint.Add(Point: TGPoint);
+begin
+  X := X + Point.X;
+  Y := Y + Point.Y;
+end;
 
 {$UNDEF IMPLEMENTATION}

trunk/Components/TemplateGenerics/Generic/GenericQueue.inc

@@ -11 +11 @@
 {$I 'GenericList.inc'}
 
-  // TGQueue<TSetIndex, TSetItem> = class(TGList)
+  // TGQueue<TQueueIndex, TQueueItem> = class(TGList)
   TGQueue = class
   private
     FList: TGList;
+    function GetCount: TGQueueIndex;
   public
     procedure Enqueue(Value: TGQueueItem);
+    procedure EnqueueArray(Values: array of TGQueueItem);
+    procedure EnqueueList(List: TGList);
     function Dequeue: TGQueueItem;
     function Peek: TGQueueItem;
@@ -22 +25 @@
     destructor Destroy; override;
     property List: TGList read FList;
+    property Count: TGQueueIndex read GetCount;
   end;
 
@@ -54 +58 @@
 end;
 
+procedure TGQueue.EnqueueArray(Values: array of TGQueueItem);
+begin
+  FList.AddArray(Values);
+end;
+
+procedure TGQueue.EnqueueList(List: TGList);
+begin
+  FList.AddList(List);
+end;
+
 function TGQueue.Peek: TGQueueItem;
 begin
@@ -75 +89 @@
 end;
 
+function TGQueue.GetCount: TGQueueIndex;
+begin
+  Result := FList.Count;
+end;
+
 {$UNDEF IMPLEMENTATION}
 {$ENDIF}

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