Changeset 349 for trunk/ItemList.pas

Timestamp:

Dec 27, 2024, 10:29:54 AM (11 days ago)

Author:

chronos

Message:

• Fixed: ItemList interface implementation was not working as expected. Implemented as proxy list instead.

File:

• trunk/ItemList.pas (modified) (11 diffs)

trunk/ItemList.pas

@@ -36 +36 @@
   end;
 
-  { IList }
-
-  IList<T> = interface
-    function GetName: string;
-    function GetCount: SizeInt;
-    function GetItem(Index: SizeInt): T;
-    function Remove(constref AValue: T): SizeInt;
-    function Add(constref AValue: T): SizeInt;
-    function CreateBaseItem(Name: string = ''): T;
-    function GetNextAvailableName(Name: string): string;
-    function GetItemFields: TItemFields;
-    procedure SetItem(Index: SizeInt; AValue: T);
-    property Count: SizeInt read GetCount;
-    property Items[Index: SizeInt]: T read GetItem write SetItem; default;
-  end;
+  TBaseItemList = class;
 
   { TItem }
@@ -87 +73 @@
     class function GetClassSysName: string; virtual;
     class function GetClassName: string; virtual;
-    function GetReferenceList(Index: Integer): IList<TItem>; virtual;
+    function GetReferenceList(Index: Integer): TBaseItemList; virtual;
     constructor Create; virtual;
   end;
@@ -93 +79 @@
   TItemClass = class of TItem;
 
-  IItemList = interface(IList<TItem>)
-  end;
+  { TBaseItemList }
+
+  TBaseItemList = class
+  public
+  type
+    TAddEvent = function (constref AValue: TItem): SizeInt of object;
+    TGetCountEvent = function: SizeInt of object;
+    TSetItemEvent = procedure(Index: SizeInt; AValue: TItem) of object;
+    TGetNameEvent = function: string of object;
+    TGetItemEvent = function(Index: SizeInt): TItem of object;
+    TGetItemFieldsEvent = function: TItemFields of object;
+    TRemoveEvent = function(constref AValue: TItem): SizeInt of object;
+    TGetNextAvailableNameEvent = function(Name: string): string of object;
+    TCreateItemEvent = function(Name: string = ''): TItem of object;
+  private
+    FOnAdd: TAddEvent;
+    FOnCreateItem: TCreateItemEvent;
+    FOnGetCount: TGetCountEvent;
+    FOnGetItem: TGetItemEvent;
+    FOnGetItemFields: TGetItemFieldsEvent;
+    FOnGetName: TGetNameEvent;
+    FOnGetNextAvailableName: TGetNextAvailableNameEvent;
+    FOnRemove: TRemoveEvent;
+    FOnSetItem: TSetItemEvent;
+    procedure SetItem(Index: SizeInt; AValue: TItem);
+    function GetItem(Index: SizeInt): TItem;
+  public
+    function GetName: string;
+    function GetCount: SizeInt;
+    function Remove(constref AValue: TItem): SizeInt;
+    function Add(constref AValue: TItem): SizeInt;
+    function CreateItem(Name: string = ''): TItem;
+    function GetNextAvailableName(Name: string): string;
+    function GetItemFields: TItemFields;
+    property Count: SizeInt read GetCount;
+    property Items[Index: SizeInt]: TItem read GetItem write SetItem; default;
+    property OnAdd: TAddEvent read FOnAdd write FOnAdd;
+    property OnGetCount: TGetCountEvent read FOnGetCount write FOnGetCount;
+    property OnSetItem: TSetItemEvent read FOnSetItem write FOnSetItem;
+    property OnGetItem: TGetItemEvent read FOnGetItem write FOnGetItem;
+    property OnGetName: TGetNameEvent read FOnGetName write FOnGetName;
+    property OnRemove: TRemoveEvent read FOnRemove write FOnRemove;
+    property OnGetItemFields: TGetItemFieldsEvent read FOnGetItemFields write FOnGetItemFields;
+    property OnGetNextAvailableName: TGetNextAvailableNameEvent read
+      FOnGetNextAvailableName write FOnGetNextAvailableName;
+    property OnCreateItem: TCreateItemEvent read FOnCreateItem
+      write FOnCreateItem;
+end;
 
   { TItemList }
 
-  TItemList<T: TItem> = class(TObjectList<T>, IList<TItem>)
+  TItemList<T: TItem> = class(TObjectList<T>)
   private
+    FBaseItemList: TBaseItemList;
     procedure RecalculateNewId(Reset: Boolean);
     procedure RecalculateItemsId;
-    function GetItem(Index: SizeInt): TItem;
-    procedure SetItem(Index: SizeInt; AValue: TItem);
-  protected
-    function GetCount: SizeInt; override;
+    function BaseGetItem(Index: SizeInt): TItem;
+    procedure BaseSetItem(Index: SizeInt; AValue: TItem);
+    function BaseAdd(constref AValue: TItem): SizeInt;
+    function BaseGetCount: SizeInt;
+    function BaseGetName(A: string): string;
+    function BaseRemove(constref AValue: TItem): SizeInt;
+    function BaseGetItemFields: TItemFields;
+    function BaseCreateItem(Name: string = ''): TItem;
   public
     NewId: Integer;
-    function GetName: string;
-    function GetItemFields: TItemFields;
-    function Remove(constref AValue: TItem): SizeInt;
-    function Add(constref AValue: TItem): SizeInt; overload;
     function CreateItem(Name: string = ''): T; virtual;
-    function CreateBaseItem(Name: string = ''): TItem;
     function IncrementName(Name: string): string;
     function GetNextAvailableName(Name: string): string;
@@ -126 +158 @@
     procedure SaveToNode(Node: TDOMNode); virtual;
     constructor Create(FreeObjects: Boolean = True);
-    function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
-    function _AddRef: Longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
-    function _Release: Longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+    destructor Destroy; override;
+    property BaseItemList: TBaseItemList read FBaseItemList;
   end;
 
@@ -210 +241 @@
 end;
 
-function TItemList<T>.CreateBaseItem(Name: string): TItem;
+function TItemList<T>.BaseCreateItem(Name: string): TItem;
 begin
   Result := TItem(CreateItem(Name));
@@ -247 +278 @@
 begin
   inherited;
+  FBaseItemList := TBaseItemList.Create;
+  FBaseItemList.OnAdd := BaseAdd;
+  FBaseItemList.OnGetCount := BaseGetCount;
+  FBaseItemList.OnSetItem := BaseSetItem;
+  FBaseItemList.OnGetItem := BaseGetItem;
+  FBaseItemList.OnRemove := BaseRemove;
+  FBaseItemList.OnGetItemFields := BaseGetItemFields;
+  FBaseItemList.OnCreateItem := BaseCreateItem;
+  //FBaseItemList.OnGetNextAvailableName := GetNextAvailableName;
+  //FBaseItemList.OnGetName := BaseGetName;
   NewId := 1;
 end;
 
-function TItemList<T>.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid: tguid; out obj): LongInt;
-  {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
-begin
-  if GetInterface(IID, Obj) then Result := 0
-    else Result := E_NOINTERFACE;
-end;
-
-function TItemList<T>._AddRef: LongInt; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
-begin
-  Result := -1;
-end;
-
-function TItemList<T>._Release: LongInt; {$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
-begin
-  Result := -1;
-end;
-
-function TItemList<T>.GetCount: SizeInt;
+destructor TItemList<T>.Destroy;
+begin
+  FreeAndNil(FBaseItemList);
+  inherited;
+end;
+
+function TItemList<T>.BaseGetCount: SizeInt;
 begin
   Result := Count;
 end;
 
-function TItemList<T>.GetName: string;
+function TItemList<T>.BaseGetName(A: string): string;
 begin
   Result := T.GetClassName;
 end;
 
-function TItemList<T>.GetItemFields: TItemFields;
+function TItemList<T>.BaseGetItemFields: TItemFields;
 begin
   Result := T.GetFields;
 end;
 
-function TItemList<T>.Remove(constref AValue: TItem): SizeInt;
+function TItemList<T>.BaseRemove(constref AValue: TItem): SizeInt;
 begin
   Result := inherited Remove(T(AValue));
 end;
 
-function TItemList<T>.Add(constref AValue: TItem): SizeInt;
+function TItemList<T>.BaseAdd(constref AValue: TItem): SizeInt;
 begin
   Result := inherited Add(T(AValue));
@@ -312 +342 @@
 end;
 
-function TItemList<T>.GetItem(Index: SizeInt): TItem;
+function TItemList<T>.BaseGetItem(Index: SizeInt): TItem;
 begin
   Result := inherited GetItem(Index);
 end;
 
-procedure TItemList<T>.SetItem(Index: SizeInt; AValue: TItem);
+procedure TItemList<T>.BaseSetItem(Index: SizeInt; AValue: TItem);
 begin
   inherited SetItem(Index, T(AValue));
@@ -452 +482 @@
 var
   ReadId: Integer;
-  ReferenceList: IList<TItem>;
+  ReferenceList: TBaseItemList;
 begin
   if Field.DataType = dtString then begin
@@ -471 +501 @@
   if Field.DataType = dtReference then begin
     ReadId := ReadInteger(Node, Field.SysName, 0);
-    ReferenceList := IList<TItem>(GetReferenceList(Field.Index));
+    ReferenceList := GetReferenceList(Field.Index);
     if (ReadId > 0) and Assigned(ReferenceList) then
       SetValueReference(Field.Index, TItem(ReferenceList[ReadId]));
@@ -714 +744 @@
 end;
 
-function TItem.GetReferenceList(Index: Integer): IList<TItem>;
+function TItem.GetReferenceList(Index: Integer): TBaseItemList;
 begin
   Result := nil;
@@ -723 +753 @@
 end;
 
+{ TBaseItemList }
+
+procedure TBaseItemList.SetItem(Index: SizeInt; AValue: TItem);
+begin
+  if Assigned(FOnSetItem) then FOnSetItem(Index, AValue)
+    else Exception.Create('Undefined SetItem handler');
+end;
+
+function TBaseItemList.GetName: string;
+begin
+  if Assigned(FOnGetName) then Result := FOnGetName
+    else Exception.Create('Undefined GetName handler');
+end;
+
+function TBaseItemList.GetCount: SizeInt;
+begin
+  if Assigned(FOnGetCount) then Result := FOnGetCount
+    else Exception.Create('Undefined GetCount handler');
+end;
+
+function TBaseItemList.GetItem(Index: SizeInt): TItem;
+begin
+  if Assigned(FOnGetItem) then Result := FOnGetItem(Index)
+    else Exception.Create('Undefined GetItem handler');
+end;
+
+function TBaseItemList.Remove(constref AValue: TItem): SizeInt;
+begin
+  if Assigned(FOnRemove) then Result := FOnRemove(AValue)
+    else Exception.Create('Undefined Remove handler');
+end;
+
+function TBaseItemList.Add(constref AValue: TItem): SizeInt;
+begin
+  if Assigned(FOnAdd) then Result := FOnAdd(AValue)
+    else Exception.Create('Undefined Add handler');
+end;
+
+function TBaseItemList.CreateItem(Name: string): TItem;
+begin
+  if Assigned(FOnCreateItem) then Result := FOnCreateItem(Name)
+    else Exception.Create('Undefined CreateItem handler');
+end;
+
+function TBaseItemList.GetNextAvailableName(Name: string): string;
+begin
+  if Assigned(FOnGetNextAvailableName) then Result := FOnGetNextAvailableName(Name)
+    else Exception.Create('Undefined GetNextAvailableName handler');
+end;
+
+function TBaseItemList.GetItemFields: TItemFields;
+begin
+  if Assigned(FOnGetItemFields) then Result := FOnGetItemFields
+    else Exception.Create('Undefined GetItemFields handler');
+end;
+
 end.