source: Common/ItemList.pas

unit ItemList;

interface

uses
  Classes, SysUtils, Generics.Collections, DOM, XML, Common, Graphics, Math;

type
  TUndefinedEnum = (eeNone);

  TDataType = (dtNone, dtString, dtBoolean, dtInteger, dtFloat, dtColor,
    dtTime, dtDate, dtDateTime, dtEnumeration, dtReference);

  { TItemField }

  TItemField = class
    SysName: string;
    Name: string;
    Index: Integer;
    DataType: TDataType;
    Position: TPoint;
    Size: TPoint;
    EnumStates: TStringList;
    VisibleIfIndex: Integer;
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TItemField);
  end;

  { TItemFields }

  TItemFields = class(TObjectList<TItemField>)
    function AddField(Index: Integer; SysName, Name: string; DataType: TDataType): TItemField;
    function SearchByIndex(Index: Integer): TItemField;
  end;

  TBaseItemList = class;

  { TItem }

  TItem = class
  private
    procedure AssignValue(Source: TItem; Field: TItemField);
    function CompareValue(Item: TItem; Field: TItemField): Boolean;
    procedure LoadValueFromNode(Node: TDOMNode; Field: TItemField); virtual;
    procedure SaveValueToNode(Node: TDOMNode; Field: TItemField); virtual;
  public
    Id: Integer;
    Name: string;
    class function GetFields: TItemFields; virtual;
    function GetField(Index: Integer): TItemField;
    procedure GetValue(Index: Integer; out Value); virtual;
    function GetValueInteger(Index: Integer): Integer;
    function GetValueString(Index: Integer): string;
    function GetValueColor(Index: Integer): TColor;
    function GetValueBoolean(Index: Integer): Boolean;
    function GetValueEnumeration(Index: Integer): TUndefinedEnum;
    function GetValueReference(Index: Integer): TItem;
    function GetValueAsText(Index: Integer): string;
    procedure SetValue(Index: Integer; var Value); virtual;
    procedure SetValueInteger(Index: Integer; Value: Integer);
    procedure SetValueString(Index: Integer; Value: string);
    procedure SetValueColor(Index: Integer; Value: TColor);
    procedure SetValueBoolean(Index: Integer; Value: Boolean);
    procedure SetValueEnumeration(Index: Integer; Value: TUndefinedEnum);
    procedure SetValueReference(Index: Integer; Value: TItem);
    procedure Assign(Source: TItem); virtual;
    function Compare(Item: TItem): Boolean; virtual;
    function ToString: string; override;
    procedure LoadFromNode(Node: TDOMNode); virtual;
    procedure SaveToNode(Node: TDOMNode); virtual;
    class function GetClassSysName: string; virtual;
    class function GetClassName: string; virtual;
    function GetReferenceList(Index: Integer): TBaseItemList; virtual;
    constructor Create; virtual;
  end;

  TItemClass = class of TItem;

  { 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 = procedure(out Name: string) of object;
    TGetItemEvent = function(Index: SizeInt): TItem of object;
    TGetItemFieldsEvent = function: TItemFields of object;
    TRemoveEvent = function(constref AValue: TItem): SizeInt of object;
    TGetNextAvailableNameEvent = procedure(Name: string; out NewName: string) of object;
    TCreateItemEvent = function(Name: string = ''): TItem of object;
    TFindByIdEvent = function(Id: Integer): TItem of object;
  private
    FOnAdd: TAddEvent;
    FOnCreateItem: TCreateItemEvent;
    FOnFindById: TFindByIdEvent;
    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;
    function FindById(Id: Integer): TItem;
    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;
    property OnFindById: TFindByIdEvent read FOnFindById
      write FOnFindById;
  end;

  { TItemList }

  TItemList<T: TItem> = class(TObjectList<T>)
  private
    FBaseItemList: TBaseItemList;
    procedure RecalculateNewId(Reset: Boolean);
    function BaseGetItem(Index: SizeInt): TItem;
    procedure BaseSetItem(Index: SizeInt; AValue: TItem);
    function BaseAdd(constref AValue: TItem): SizeInt;
    function BaseGetCount: SizeInt;
    procedure BaseGetName(out Name: string);
    function BaseRemove(constref AValue: TItem): SizeInt;
    function BaseGetItemFields: TItemFields;
    function BaseCreateItem(Name: string = ''): TItem;
    function BaseFindById(Id: Integer): TItem;
    procedure BaseGetNextAvailableName(Name: string; out NewName: string);
  public
    NewId: Integer;
    procedure RecalculateItemsId;
    function CreateItem(Name: string = ''): T; virtual;
    function IncrementName(Name: string): string;
    function FindById(Id: Integer): T;
    function FindByName(Name: string): T;
    function GetNewId: Integer;
    function ToString: string; override;
    procedure Assign(Source: TItemList<T>); virtual;
    function Compare(ItemList: TItemList<T>): Boolean; virtual;
    function AddItem(Name: string = ''): T; virtual;
    procedure LoadFromNode(Node: TDOMNode); virtual;
    procedure SaveToNode(Node: TDOMNode); virtual;
    constructor Create(FreeObjects: Boolean = True);
    destructor Destroy; override;
    property BaseItemList: TBaseItemList read FBaseItemList;
  end;

const
  DataTypeStr: array[TDataType] of string = ('None', 'String', 'Boolean',
    'Integer', 'Float', 'Color', 'Time', 'Date', 'DateTime', 'Enumeration',
    'Reference');

resourcestring
  SUnsupportedDataType = 'Unsupported field value data type %s';
  SUnsupportedValueIndex = 'Unsupported value index %d';


implementation

resourcestring
  SYes = 'Yes';
  SNo = 'No';
  SItem = 'Item';
  SName = 'Name';

{ TItemField }

constructor TItemField.Create;
begin
  EnumStates := TStringList.Create;
end;

destructor TItemField.Destroy;
begin
  FreeAndNil(EnumStates);
  inherited;
end;

procedure TItemField.Assign(Source: TItemField);
begin
  SysName := Source.SysName;
  Name := Source.Name;
  Index := Source.Index;
  DataType := Source.DataType;
  Position := Source.Position;
  Size := Source.Size;
  EnumStates.Assign(Source.EnumStates);
end;

{ TItemList }

procedure TItemList<T>.Assign(Source: TItemList<T>);
var
  I: Integer;
begin
  while Count > Source.Count do Delete(Count - 1);
  while Count < Source.Count do AddItem('');
  for I := 0 to Count - 1 do
    Items[I].Assign(Source.Items[I]);
end;

function TItemList<T>.Compare(ItemList: TItemList<T>): Boolean;
var
  I: Integer;
begin
  Result := Count = ItemList.Count;
  if not Result then Exit;
  for I := 0 to Count - 1 do begin
    Result := Result and TItem(Items[I]).Compare(ItemList.Items[I]);
    if not Result then Break;
  end;
end;

function TItemList<T>.AddItem(Name: string): T;
begin
  Result := CreateItem(Name);
  Result.Id := GetNewId;
  Add(Result);
end;

function TItemList<T>.CreateItem(Name: string): T;
begin
  Result := T.Create;
  Result.Name := Name;
end;

function TItemList<T>.BaseCreateItem(Name: string): TItem;
begin
  Result := TItem(CreateItem(Name));
end;

function TItemList<T>.BaseFindById(Id: Integer): TItem;
begin
  Result := FindById(Id);
end;

procedure TItemList<T>.LoadFromNode(Node: TDOMNode);
var
  Node2: TDOMNode;
  NewItem: T;
begin
  Count := 0;
  Node2 := Node.FirstChild;
  while Assigned(Node2) and (Node2.NodeName = UnicodeString(T.GetClassSysName)) do begin
    NewItem := CreateItem;
    NewItem.LoadFromNode(Node2);
    Add(NewItem);
    Node2 := Node2.NextSibling;
  end;
end;

procedure TItemList<T>.SaveToNode(Node: TDOMNode);
var
  I: Integer;
  NewNode2: TDOMNode;
begin
  for I := 0 to Count - 1 do
  with TItem(Items[I]) do begin
    NewNode2 := Node.OwnerDocument.CreateElement(UnicodeString(T.GetClassSysName));
    Node.AppendChild(NewNode2);
    SaveToNode(NewNode2);
  end;
end;

constructor TItemList<T>.Create(FreeObjects: Boolean);
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 := BaseGetNextAvailableName;
  FBaseItemList.OnGetName := BaseGetName;
  FBaseItemList.OnFindById := BaseFindById;
  NewId := 1;
end;

destructor TItemList<T>.Destroy;
begin
  FreeAndNil(FBaseItemList);
  inherited;
end;

function TItemList<T>.BaseGetCount: SizeInt;
begin
  Result := Count;
end;

procedure TItemList<T>.BaseGetName(out Name: string);
begin
  Name := T.GetClassName;
end;

function TItemList<T>.BaseGetItemFields: TItemFields;
begin
  Result := T.GetFields;
end;

function TItemList<T>.BaseRemove(constref AValue: TItem): SizeInt;
begin
  Result := inherited Remove(T(AValue));
end;

function TItemList<T>.BaseAdd(constref AValue: TItem): SizeInt;
begin
  Result := inherited Add(T(AValue));
  AValue.Id := GetNewId;
end;

procedure TItemList<T>.RecalculateNewId(Reset: Boolean);
var
  I: Integer;
begin
  NewId := 1;
  for I := 0 to Count - 1 do
  with TItem(Items[I]) do begin
    NewId := Max(NewId, Id + 1);
  end;
end;

procedure TItemList<T>.RecalculateItemsId;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    Items[I].Id := I + 1;
  NewId := Count + 1;
end;

function TItemList<T>.BaseGetItem(Index: SizeInt): TItem;
begin
  Result := inherited GetItem(Index);
end;

procedure TItemList<T>.BaseSetItem(Index: SizeInt; AValue: TItem);
begin
  inherited SetItem(Index, T(AValue));
end;

function TItemList<T>.IncrementName(Name: string): string;
var
  I: Integer;
  Num: Integer;
begin
  I := LastPos(' ', Name);
  if I > 0 then begin
    if TryStrToInt(Copy(Name, I + 1, Length(Name)), Num) then
      Result := Trim(Copy(Name, 1, I - 1)) + ' ' + IntToStr(Num + 1)
    else Result := Name + ' 2';
  end else Result := Name + ' 2';
end;

procedure TItemList<T>.BaseGetNextAvailableName(Name: string; out
  NewName: string);
begin
  NewName := Name + ' 1';
  while Assigned(FindByName(NewName)) do
    NewName := IncrementName(NewName);
end;

function TItemList<T>.FindById(Id: Integer): T;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (Items[I].Id <> Id) do Inc(I);
  if I < Count then Result := Items[I]
    else Result := nil;
end;

function TItemList<T>.FindByName(Name: string): T;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (Items[I].Name <> Name) do Inc(I);
  if I < Count then Result := Items[I]
    else Result := nil;
end;

function TItemList<T>.GetNewId: Integer;
begin
  Result := NewId;
  Inc(NewId);
end;

function TItemList<T>.ToString: string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to Count - 1 do
  with TItem(Items[I]) do begin
    Result := Result + ToString + LineEnding;
  end;
end;

{ TItemFields }

function TItemFields.AddField(Index: Integer; SysName, Name: string; DataType: TDataType): TItemField;
begin
  Result := TItemField.Create;
  Result.Index := Index;
  Result.Name := Name;
  Result.SysName := SysName;
  Result.DataType := DataType;
  Add(Result);
end;

function TItemFields.SearchByIndex(Index: Integer): TItemField;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (Items[I].Index <> Index) do Inc(I);
  if I < Count then Result := Items[I]
    else Result := nil;
end;

{ TItem }

procedure TItem.AssignValue(Source: TItem; Field: TItemField);
begin
  if Field.DataType = dtString then begin
    SetValueString(Field.Index, Source.GetValueString(Field.Index));
  end else
  if Field.DataType = dtColor then begin
    SetValueColor(Field.Index, Source.GetValueColor(Field.Index));
  end else
  if Field.DataType = dtInteger then begin
    SetValueInteger(Field.Index, Source.GetValueInteger(Field.Index));
  end else
  if Field.DataType = dtBoolean then begin
    SetValueBoolean(Field.Index, Source.GetValueBoolean(Field.Index));
  end else
  if Field.DataType = dtEnumeration then begin
    SetValueEnumeration(Field.Index, Source.GetValueEnumeration(Field.Index));
  end else
  if Field.DataType = dtReference then begin
    SetValueReference(Field.Index, Source.GetValueReference(Field.Index));
  end else
    raise Exception.Create(Format(SUnsupportedDataType, [DataTypeStr[Field.DataType]]));
end;

function TItem.CompareValue(Item: TItem; Field: TItemField): Boolean;
begin
  if Field.DataType = dtString then begin
    Result := GetValueString(Field.Index) = Item.GetValueString(Field.Index);
  end else
  if Field.DataType = dtColor then begin
    Result := GetValueColor(Field.Index) = Item.GetValueColor(Field.Index);
  end else
  if Field.DataType = dtInteger then begin
    Result := GetValueInteger(Field.Index) = Item.GetValueInteger(Field.Index);
  end else
  if Field.DataType = dtBoolean then begin
    Result := GetValueBoolean(Field.Index) = Item.GetValueBoolean(Field.Index);
  end else
  if Field.DataType = dtEnumeration then begin
    Result := GetValueEnumeration(Field.Index) = Item.GetValueEnumeration(Field.Index);
  end else
  if Field.DataType = dtReference then begin
    Result := GetValueReference(Field.Index) = Item.GetValueReference(Field.Index);
  end else
    raise Exception.Create(Format(SUnsupportedDataType, [DataTypeStr[Field.DataType]]));
end;

procedure TItem.LoadValueFromNode(Node: TDOMNode; Field: TItemField);
var
  ReadId: Integer;
  ReferenceList: TBaseItemList;
  RefItem: TItem;
begin
  if Field.DataType = dtString then begin
    SetValueString(Field.Index, ReadString(Node, Field.SysName, ''));
  end else
  if Field.DataType = dtColor then begin
    SetValueColor(Field.Index, ReadInteger(Node, Field.SysName, 0));
  end else
  if Field.DataType = dtInteger then begin
    SetValueInteger(Field.Index, ReadInteger(Node, Field.SysName, 0));
  end else
  if Field.DataType = dtBoolean then begin
    SetValueBoolean(Field.Index, ReadBoolean(Node, Field.SysName, False));
  end else
  if Field.DataType = dtEnumeration then begin
    SetValueEnumeration(Field.Index, TUndefinedEnum(ReadInteger(Node, Field.SysName, 0)));
  end else
  if Field.DataType = dtReference then begin
    ReadId := ReadInteger(Node, Field.SysName, 0);
    ReferenceList := GetReferenceList(Field.Index);
    if (ReadId > 0) and Assigned(ReferenceList) then begin
      RefItem := ReferenceList.FindById(ReadId);
      if Assigned(RefItem) then
        SetValueReference(Field.Index, RefItem)
        else raise Exception.Create('Reference id ' + IntToStr(ReadId) + ' not found.');
    end;
  end else
    raise Exception.Create(Format(SUnsupportedDataType, [DataTypeStr[Field.DataType]]));
end;

procedure TItem.SaveValueToNode(Node: TDOMNode; Field: TItemField);
var
  Item: TItem;
begin
  if Field.DataType = dtString then begin
    WriteString(Node, Field.SysName, GetValueString(Field.Index));
  end else
  if Field.DataType = dtColor then begin
    WriteInteger(Node, Field.SysName, GetValueColor(Field.Index));
  end else
  if Field.DataType = dtInteger then begin
    WriteInteger(Node, Field.SysName, GetValueInteger(Field.Index));
  end else
  if Field.DataType = dtBoolean then begin
    WriteBoolean(Node, Field.SysName, GetValueBoolean(Field.Index));
  end else
  if Field.DataType = dtEnumeration then begin
    WriteInteger(Node, Field.SysName, Integer(GetValueEnumeration(Field.Index)));
  end else
  if Field.DataType = dtReference then begin
    Item := TItem(GetValueReference(Field.Index));
    if Assigned(Item) then WriteInteger(Node, Field.SysName, Item.Id)
      else WriteInteger(Node, Field.SysName, 0);
  end else
    raise Exception.Create(Format(SUnsupportedDataType, [DataTypeStr[Field.DataType]]));
end;

class function TItem.GetFields: TItemFields;
begin
  Result := TItemFields.Create;
  Result.AddField(1, 'Name', SName, dtString);
end;

function TItem.GetField(Index: Integer): TItemField;
var
  Fields: TItemFields;
begin
  Result := TItemField.Create;
  Fields := GetFields;
  try
    Result.Assign(Fields.SearchByIndex(Index));
  finally
    Fields.Free;
  end;
end;

procedure TItem.GetValue(Index: Integer; out Value);
begin
  raise Exception.Create(Format(SUnsupportedValueIndex, [Index]));
end;

function TItem.GetValueString(Index: Integer): string;
begin
  GetValue(Index, Result);
end;

function TItem.GetValueInteger(Index: Integer): Integer;
begin
  GetValue(Index, Result);
end;

function TItem.GetValueColor(Index: Integer): TColor;
begin
  GetValue(Index, Result);
end;

function TItem.GetValueBoolean(Index: Integer): Boolean;
begin
  GetValue(Index, Result);
end;

function TItem.GetValueEnumeration(Index: Integer): TUndefinedEnum;
begin
  GetValue(Index, Result);
end;

function TItem.GetValueReference(Index: Integer): TItem;
begin
  GetValue(Index, Result);
end;

function TItem.GetValueAsText(Index: Integer): string;
var
  Field: TItemField;
  Item: TItem;
begin
  Field := GetField(Index);
  try
    if Field.DataType = dtInteger then Result := IntToStr(GetValueInteger(Index))
    else if Field.DataType = dtString then Result := GetValueString(Index)
    else if Field.DataType = dtColor then Result := ''
    else if Field.DataType = dtEnumeration then Result := Field.EnumStates[Integer(GetValueEnumeration(Index))]
    else if Field.DataType = dtReference then begin
      Item := TItem(GetValueReference(Index));
      if Assigned(Item) then Result := Item.Name
        else Result := '';
    end else if Field.DataType = dtBoolean then begin
      if GetValueBoolean(Index) then Result := SYes else Result := SNo;
    end else
      raise Exception.Create(Format(SUnsupportedDataType, [DataTypeStr[Field.DataType]]));
  finally
    Field.Free;
  end;
end;

procedure TItem.SetValue(Index: Integer; var Value);
begin
  raise Exception.Create(Format(SUnsupportedValueIndex, [Index]));
end;

procedure TItem.SetValueInteger(Index: Integer; Value: Integer);
begin
  SetValue(Index, Value);
end;

procedure TItem.SetValueString(Index: Integer; Value: string);
begin
  SetValue(Index, Value);
end;

procedure TItem.SetValueColor(Index: Integer; Value: TColor);
begin
  SetValue(Index, Value);
end;

procedure TItem.SetValueBoolean(Index: Integer; Value: Boolean);
begin
  SetValue(Index, Value);
end;

procedure TItem.SetValueEnumeration(Index: Integer;
  Value: TUndefinedEnum);
begin
  SetValue(Index, Value);
end;

procedure TItem.SetValueReference(Index: Integer; Value: TItem);
begin
  SetValue(Index, Value);
end;

procedure TItem.Assign(Source: TItem);
var
  I: Integer;
  Fields: TItemFields;
begin
  Id := Source.Id;
  if Source is ClassType then begin
    Fields := GetFields;
    try
      for I := 0 to Fields.Count - 1 do
        AssignValue(Source, Fields[I]);
    finally
      Fields.Free;
    end;
  end;
end;

function TItem.Compare(Item: TItem): Boolean;
var
  I: Integer;
  Fields: TItemFields;
begin
  Result := True;
  Result := Result and (Id = Item.Id);
  if Item is ClassType then begin
    Fields := GetFields;
    try
      for I := 0 to Fields.Count - 1 do begin
        Result := Result and CompareValue(Item, Fields[I]);
        if not Result then Break;
      end;
    finally
      Fields.Free;
    end;
  end;
end;

function TItem.ToString: string;
var
  Fields: TItemFields;
  I: Integer;
begin
  Result := 'Id: ' + IntToStr(Id) + LineEnding;
  Fields := GetFields;
  try
    for I := 0 to Fields.Count - 1 do begin
      Result := Result + Fields[I].SysName + ': ' + GetValueAsText(Fields[I].Index) + LineEnding;
    end;
  finally
    Fields.Free;
  end;
end;

procedure TItem.LoadFromNode(Node: TDOMNode);
var
  Fields: TItemFields;
  I: Integer;
begin
  Id := ReadInteger(Node, 'Id', 0);
  Fields := GetFields;
  try
    for I := 0 to Fields.Count - 1 do begin
      LoadValueFromNode(Node, Fields[I]);
    end;
  finally
    Fields.Free;
  end;
end;

procedure TItem.SaveToNode(Node: TDOMNode);
var
  Fields: TItemFields;
  I: Integer;
begin
  WriteInteger(Node, 'Id', Id);
  Fields := GetFields;
  try
    for I := 0 to Fields.Count - 1 do begin
      SaveValueToNode(Node, Fields[I]);
    end;
  finally
    Fields.Free;
  end;
end;

class function TItem.GetClassSysName: string;
begin
  Result := 'Item';
end;

class function TItem.GetClassName: string;
begin
  Result := SItem;
end;

function TItem.GetReferenceList(Index: Integer): TBaseItemList;
begin
  Result := nil;
end;

constructor TItem.Create;
begin
end;

{ TBaseItemList }

procedure TBaseItemList.SetItem(Index: SizeInt; AValue: TItem);
begin
  if Assigned(FOnSetItem) then FOnSetItem(Index, AValue)
    else raise Exception.Create('Undefined SetItem handler');
end;

function TBaseItemList.GetName: string;
var
  Name: string;
begin
  if Assigned(FOnGetName) then begin
    FOnGetName(Name);
    Result := Name;
  end else raise Exception.Create('Undefined GetName handler');
end;

function TBaseItemList.GetCount: SizeInt;
begin
  if Assigned(FOnGetCount) then Result := FOnGetCount
    else raise Exception.Create('Undefined GetCount handler');
end;

function TBaseItemList.GetItem(Index: SizeInt): TItem;
begin
  if Assigned(FOnGetItem) then Result := FOnGetItem(Index)
    else raise Exception.Create('Undefined GetItem handler');
end;

function TBaseItemList.Remove(constref AValue: TItem): SizeInt;
begin
  if Assigned(FOnRemove) then Result := FOnRemove(AValue)
    else raise Exception.Create('Undefined Remove handler');
end;

function TBaseItemList.Add(constref AValue: TItem): SizeInt;
begin
  if Assigned(FOnAdd) then Result := FOnAdd(AValue)
    else raise Exception.Create('Undefined Add handler');
end;

function TBaseItemList.CreateItem(Name: string): TItem;
begin
  if Assigned(FOnCreateItem) then Result := FOnCreateItem(Name)
    else raise Exception.Create('Undefined CreateItem handler');
end;

function TBaseItemList.GetNextAvailableName(Name: string): string;
var
  NewName: string;
begin
  if Assigned(FOnGetNextAvailableName) then begin
    FOnGetNextAvailableName(Name, NewName);
    Result := NewName;
  end else raise Exception.Create('Undefined GetNextAvailableName handler');
end;

function TBaseItemList.GetItemFields: TItemFields;
begin
  if Assigned(FOnGetItemFields) then Result := FOnGetItemFields
    else raise Exception.Create('Undefined GetItemFields handler');
end;

function TBaseItemList.FindById(Id: Integer): TItem;
begin
  if Assigned(FOnFindById) then Result := FOnFindById(Id)
    else raise Exception.Create('Undefined FindById handler');
end;

end.