Changeset 93 for trunk/Packages/TemplateGenerics/Generic/GenericList.inc

Timestamp:

Jul 20, 2018, 10:25:06 AM (6 years ago)

Author:

chronos

Message:

• Modified: Updated Common, CoolTranslator and TemplateGenerics packages.
• Fixed: FormMain initialization was not completed if last opened file was not found.

Location:

trunk

Files:

• . (modified) (1 prop)
• Packages/TemplateGenerics/Generic/GenericList.inc (modified) (12 diffs)

trunk

@@ -6 +6 @@
 compiled
 heaptrclog.trc
+LazFuck.dbg

@@ -6 +6 @@
 compiled
 heaptrclog.trc
+LazFuck.dbg

trunk/Packages/TemplateGenerics/Generic/GenericList.inc

@@ -12 +12 @@
   // - all items operations (Clear, Reverse, Sort)
 
-  TGList = class;
-
-  TGListSortCompare = function(Item1, Item2: TGListItem): Integer of object;
-  TGListToStringConverter = function(Item: TGListItem): string;
-  TGListFromStringConverter = function(Text: string): TGListItem;
-  TGListItemArray = array of TGListItem;
+  //TGAbstractList = class
+
+  //end;
 
   // TGList<TGListIndex, TGListItem> = class
-  TGList = class
+  TGList = class//(TGAbstractList)
+  public
+    type
+      PItem = ^TGListItem;
+      TSortCompare = function(Item1, Item2: TGListItem): Integer of object;
+      TToStringConverter = function(Item: TGListItem): string;
+      TFromStringConverter = function(Text: string): TGListItem;
+      TItemArray = array of TGListItem;
   private
     FItems: array of TGListItem;
@@ -34 +38 @@
     procedure SetLast(AValue: TGListItem);
     procedure SetFirst(AValue: TGListItem);
-    procedure QuickSort(L, R : TGListIndex; Compare: TGListSortCompare);
+    procedure QuickSort(L, R : TGListIndex; Compare: TSortCompare);
+    procedure DoUpdate;
   protected
     procedure Put(Index: TGListIndex; const AValue: TGListItem); virtual;
@@ -51 +56 @@
     function EqualTo(List: TGList): Boolean;
     procedure Exchange(Index1, Index2: TGListIndex);
-    procedure Explode(Text, Separator: string; Converter: TGListFromStringConverter; SlicesCount: Integer = -1);
+    procedure Explode(Text, Separator: string; Converter: TFromStringConverter; SlicesCount: Integer = -1);
     function Extract(Item: TGListItem): TGListItem;
     property First: TGListItem read GetFirst write SetFirst;
     procedure Fill(Start, Count: TGListIndex; Value: TGListItem);
-    function GetArray(Index, ACount: TGListIndex): TGListItemArray;
+    function GetArray(Index, ACount: TGListIndex): TItemArray;
     procedure GetList(List: TGList; Index, ACount: TGListIndex);
-    function Implode(Separator: string; Converter: TGListToStringConverter): string;
+    procedure GetBuffer(Index: TGListIndex; var Buffer; Count: TGListIndex);
+    function Implode(Separator: string; Converter: TToStringConverter): string;
     function IndexOf(Item: TGListItem; Start: TGListIndex = 0): TGListIndex; virtual;
     function IndexOfList(List: TGList; Start: TGListIndex = 0): TGListIndex;
@@ -73 +79 @@
     procedure ReplaceListPart(Index: TGListIndex; Source: TGList;
       SourceIndex, SourceCount: TGListIndex);
-    procedure Sort(Compare: TGListSortCompare);
+    procedure ReplaceBuffer(Index: TGListIndex; var Buffer; Count: TGListIndex);
+    procedure Sort(Compare: TSortCompare);
     procedure SetArray(Values: array of TGListItem);
     procedure BeginUpdate;
@@ -82 +89 @@
     property Items[Index: TGListIndex]: TGListItem read Get write Put; default;
     property Last: TGListItem read GetLast write SetLast;
-  end;
-  
+    property OnUpdate: TNotifyEvent read FOnUpdate write FOnUpdate;
+  end;
+
 {$UNDEF INTERFACE}
 {$ENDIF}
@@ -102 +110 @@
 begin
   FCount := 0;
+  FUpdateCount := 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;
 
@@ -200 +241 @@
 end;
 
-function TGList.GetArray(Index, ACount: TGListIndex): TGListItemArray;
+function TGList.GetArray(Index, ACount: TGListIndex): TItemArray;
 var
   I: Integer;
@@ -218 +259 @@
 end;
 
-procedure TGList.QuickSort(L, R: TGListIndex; Compare: TGListSortCompare);
+procedure TGList.QuickSort(L, R: TGListIndex; Compare: TSortCompare);
 var
   I, J: TGListIndex;
@@ -302 +343 @@
   if (Index < 0) or (Index > FCount) then
     raise EListError.CreateFmt(SListIndexError, [Index]);
-  InsertCount(Index, 1);
-  FItems[Index] := Item;
-  Update;
+  try
+    BeginUpdate;
+    InsertCount(Index, 1);
+    FItems[Index] := Item;
+  finally
+    EndUpdate;
+  end;
 end;
 
@@ -487 +532 @@
 end;
 
-procedure TGList.Sort(Compare: TGListSortCompare);
+procedure TGList.Sort(Compare: TSortCompare);
 begin
   if FCount > 1 then
@@ -525 +570 @@
 procedure TGList.EndUpdate;
 begin
-  Dec(FUpdateCount);
-  Update;
+  if FUpdateCount > 0 then Dec(FUpdateCount);
+  if FUpdateCount = 0 then DoUpdate;
+end;
+
+procedure TGList.DoUpdate;
+begin
+  if Assigned(FOnUpdate) then FOnUpdate(Self);
 end;
 
 procedure TGList.Update;
 begin
-  if Assigned(FOnUpdate) and (FUpdateCount = 0) then FOnUpdate(Self);
-end;
-
-function TGList.Implode(Separator: string; Converter: TGListToStringConverter): string;
+  if FUpdateCount = 0 then DoUpdate;
+end;
+
+function TGList.Implode(Separator: string; Converter: TToStringConverter): string;
 var
   I: TGListIndex;
@@ -548 +598 @@
 end;
 
-procedure TGList.Explode(Text, Separator: string; Converter: TGListFromStringConverter; SlicesCount: Integer = -1);
+procedure TGList.Explode(Text, Separator: string; Converter: TFromStringConverter; SlicesCount: Integer = -1);
 begin
   Clear;

@@ -6 +6 @@
 compiled
 heaptrclog.trc
+LazFuck.dbg