source: tags/1.4.0/UItems.pas

unit UItems;

interface

uses
  Classes, SysUtils, Generics.Collections, DOM, UXMLUtils;

type
  { TItem }

  TItem = class
    Id: Integer;
    procedure LoadFromXmlNode(Node: TDOMNode); virtual;
    procedure SaveToXmlNode(Node: TDOMNode); virtual;
    procedure Assign(Source: TItem); virtual;
    class function GetClassSysName: string; virtual;
  end;

  TItemClass = class of TItem;

  { TItems }

  TItems<T: TItem> = class(TObjectList<T>)
  public
  type
    TTClass = class of T;
  var
    NewId: Integer;
    class function GetItemClass: TTClass; virtual;
    class function GetClassSysName: string; virtual;
    function GetNewId: Integer;
    function AddItem: T; virtual;
    procedure Assign(Source: TItems<T>); virtual;
    function CreateItem: T; virtual;
    procedure LoadFromXmlNodeRef(Node: TDOMNode; Target: TItems<T>);
    procedure SaveToXmlNodeRef(Node: TDOMNode);
    procedure LoadFromXmlNode(Node: TDOMNode); virtual;
    procedure SaveToXmlNode(Node: TDOMNode); virtual;
    procedure RebuildItemsId;
    function FindById(Id: Integer): T;
    constructor Create(AOwnsObjects: Boolean = True); virtual;
  end;

resourcestring
  SReferenceNotFound = 'Reference %s to class %s not found.';


implementation


{ TItem }

procedure TItem.LoadFromXmlNode(Node: TDOMNode);
begin
  Id := ReadInteger(Node, 'Id', Id);
end;

procedure TItem.SaveToXmlNode(Node: TDOMNode);
begin
  WriteInteger(Node, 'Id', Id);
end;

procedure TItem.Assign(Source: TItem);
begin
  Id := Source.Id;
end;

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

{ TItems }

procedure TItems<T>.Assign(Source: TItems<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;

class function TItems<T>.GetItemClass: TTClass;
begin
  Result := TTClass(T.ClassType);
end;

class function TItems<T>.GetClassSysName: string;
begin
  Result := ClassName;
end;

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

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

function TItems<T>.CreateItem: T;
begin
  Result := GetItemClass.Create;
end;

procedure TItems<T>.LoadFromXmlNodeRef(Node: TDOMNode; Target: TItems<T>);
var
  Node2: TDOMNode;
  NewItem: T;
  RefId: Integer;
begin
  Node2 := Node.FirstChild;
  while Assigned(Node2) and (Node2.NodeName = DOMString(T.GetClassSysName)) do begin
    RefId := StrToInt(string(Node2.TextContent));
    NewItem := Target.FindById(RefId);
    if Assigned(NewItem) then Add(NewItem)
      else raise Exception.Create(Format(SReferenceNotFound, [string(Node.TextContent),
        T.GetClassSysName]));
    Node2 := Node2.NextSibling;
  end;
end;

procedure TItems<T>.SaveToXmlNodeRef(Node: TDOMNode);
var
  I: Integer;
begin
  for I := 0 to Count - 1 do begin;
    WriteInteger(Node, T.GetClassSysName, Items[I].Id);
  end;
end;

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

function TItems<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;

constructor TItems<T>.Create(AOwnsObjects: Boolean = True);
begin
  inherited;
  NewId := 1;
end;

procedure TItems<T>.LoadFromXmlNode(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.LoadFromXmlNode(Node2);
    Add(NewItem);
    Node2 := Node2.NextSibling;
  end;
end;

procedure TItems<T>.SaveToXmlNode(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);
    SaveToXmlNode(NewNode2);
  end;
end;


end.