Measure/Units/CacheTree.pas

unit CacheTree;
// Base Tree Class,

interface

uses
  Classes, Math;

type
  // 基础树类 -- 合并项目, 导入Excel等树以此树为基础
  TCacheTree = class;
  TCacheNode = class;

  TCacheNodeList = class
  private
    FList: TList;
    function GetCount: Integer;
    function GetFirst: TCacheNode;
    function GetItems(AIndex: Integer): TCacheNode;
    function GetLast: TCacheNode;
    procedure SetItems(AIndex: Integer; const Value: TCacheNode);
  public
    constructor Create;
    destructor Destroy; override;

    function Add(ANode: TCacheNode): Integer;
    procedure Insert(AIndex: Integer; ANode: TCacheNode);
    procedure Delete(AIndex: Integer);
    function Remove(ANode: TCacheNode): Integer;
    procedure Clear;

    function IndexOf(ANode: TCacheNode): Integer;

    property Count: Integer read GetCount;
    property First: TCacheNode read GetFirst;
    property Last: TCacheNode read GetLast;
    property Items[AIndex: Integer]: TCacheNode read GetItems write SetItems; default;
  end;

  TCacheNode = class
  private
    FID: Integer;

    FParent: TCacheNode;
    FNextSibling: TCacheNode;
    FPreSibling: TCacheNode;

    FChildren: TCacheNodeList;
    FCacheTree: TCacheTree;
    function GetFirstChild: TCacheNode;
    function GetLastChild: TCacheNode;
    function GetNextSiblingID: Integer;
    function GetParentID: Integer;
    function GetPreSiblingID: Integer;

    function GetNodeID(ANode: TCacheNode): Integer;
  public
    constructor Create(ACacheTree: TCacheTree; AID: Integer);
    destructor Destroy; override;

    procedure InsertChild(AChildNode: TCacheNode);
    procedure InsertNextSibling(ANextSibling: TCacheNode);
    procedure InsertPreSibling(APreSibling: TCacheNode);
    procedure RemoveChild(AChildNode: TCacheNode);
    procedure DeleteChild(AIndex: Integer);
    procedure ClearChildren;

    property ID: Integer read FID;
    property ParentID: Integer read GetParentID;
    property PreSiblingID: Integer read GetPreSiblingID;
    property NextSiblingID: Integer read GetNextSiblingID;
    property Parent: TCacheNode read FParent write FParent;
    property NextSibling: TCacheNode read FNextSibling write FNextSibling;
    property PreSibling: TCacheNode read FPreSibling write FPreSibling;

    property FirstChild: TCacheNode read GetFirstChild;
    property LastChild: TCacheNode read GetLastChild;
    property Children: TCacheNodeList read FChildren;
  end;

  TCacheTree = class
  private
    FCacheNodes: TCacheNodeList;
    FRoot: TCacheNode;
    FNewNodeID: Integer;

    function GetFirstNode: TCacheNode;
    procedure SetNewNodeID(const Value: Integer);
  protected
    function GetNewNodeID: Integer;   
    function GetNewNode: TCacheNode; virtual;
  public
    constructor Create; virtual;
    destructor Destroy; override;

    function AddNode(AParent: TCacheNode; ANextSibling: TCacheNode = nil): TCacheNode;
    procedure DeleteNode(ANode: TCacheNode);
    procedure ClearTreeNodes;

    property Root: TCacheNode read FRoot;
    property FirstNode: TCacheNode read GetFirstNode;
    property CacheNodes: TCacheNodeList read FCacheNodes;
    property NewNodeID: Integer read FNewNodeID write SetNewNodeID;
  end;

implementation

{ TCacheNodeList }

function TCacheNodeList.Add(ANode: TCacheNode): Integer;
begin
  Result := FList.Add(ANode);
end;

procedure TCacheNodeList.Clear;
begin
  FList.Clear;
end;

constructor TCacheNodeList.Create;
begin
  FList := TList.Create;
end;

procedure TCacheNodeList.Delete(AIndex: Integer);
begin
  FList.Delete(AIndex);
end;

destructor TCacheNodeList.Destroy;
begin
  FList.Free;
  inherited;
end;

function TCacheNodeList.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TCacheNodeList.GetFirst: TCacheNode;
begin
  Result := TCacheNode(FList.First);
end;

function TCacheNodeList.IndexOf(ANode: TCacheNode): Integer;
begin
  Result := FList.IndexOf(ANode);
end;

function TCacheNodeList.GetItems(AIndex: Integer): TCacheNode;
begin
  Result := TCacheNode(FList.Items[AIndex]);
end;

function TCacheNodeList.GetLast: TCacheNode;
begin
  Result := TCacheNode(FList.Last);
end;

procedure TCacheNodeList.Insert(AIndex: Integer; ANode: TCacheNode);
begin
  FList.Insert(AIndex, ANode);
end;

function TCacheNodeList.Remove(ANode: TCacheNode): Integer;
begin
  Result := FList.Remove(ANode);
end;

procedure TCacheNodeList.SetItems(AIndex: Integer;
  const Value: TCacheNode);
begin
  FList.Items[AIndex] := Value;
end;

{ TCacheNode }

procedure TCacheNode.ClearChildren;
var
  I: Integer;
begin
  for I := 0 to FChildren.Count - 1 do
  begin
    FChildren[I].ClearChildren;
    FChildren[I].Free;
  end;
  FChildren.Clear;
end;

constructor TCacheNode.Create(ACacheTree: TCacheTree; AID: Integer);
begin
  FChildren := TCacheNodeList.Create;
  FCacheTree := ACacheTree;
  FID := AID;
end;

procedure TCacheNode.DeleteChild(AIndex: Integer);
begin
  if (AIndex >= 0) and (AIndex < FChildren.Count) then
    RemoveChild(FChildren[AIndex]);
end;

destructor TCacheNode.Destroy;
begin
  FChildren.Free;
  inherited;
end;

function TCacheNode.GetFirstChild: TCacheNode;
begin
  if FChildren.Count > 0 then
    Result := FChildren.First
  else
    Result := nil;
end;

function TCacheNode.GetLastChild: TCacheNode;
begin
  if FChildren.Count > 0 then
    Result := FChildren.Last
  else
    Result := nil;
end;

function TCacheNode.GetNextSiblingID: Integer;
begin
  Result := GetNodeID(FNextSibling);
end;

function TCacheNode.GetNodeID(ANode: TCacheNode): Integer;
begin
  if Assigned(ANode) then
    Result := ANode.ID
  else
    Result := -1;
end;

function TCacheNode.GetParentID: Integer;
begin
  Result := GetNodeID(FParent);
end;

function TCacheNode.GetPreSiblingID: Integer;
begin
  Result := GetNodeID(FPreSibling);
end;

procedure TCacheNode.InsertChild(AChildNode: TCacheNode);
begin
  AChildNode.FParent := Self;
  AChildNode.FPreSibling := LastChild;
  if LastChild <> nil then
    LastChild.FNextSibling := AChildNode;
  FChildren.Add(AChildNode);
end;

procedure TCacheNode.InsertNextSibling(ANextSibling: TCacheNode);
begin
  if Assigned(FNextSibling) then
    FNextSibling.FPreSibling := ANextSibling;
  ANextSibling.FNextSibling := FNextSibling;
  FNextSibling := ANextSibling;
  ANextSibling.FPreSibling := Self;
  ANextSibling.FParent := FParent;
  FParent.Children.Insert(FParent.Children.IndexOf(Self) + 1, ANextSibling);
end;

procedure TCacheNode.InsertPreSibling(APreSibling: TCacheNode);
begin
  if Assigned(FPreSibling) then
    FPreSibling.FNextSibling := APreSibling;
  APreSibling.FPreSibling := FPreSibling;
  FPreSibling := APreSibling;
  APreSibling.FNextSibling := Self;
  APreSibling.FParent := FParent;
  FParent.Children.Insert(FParent.Children.IndexOf(Self), APreSibling);
end;

procedure TCacheNode.RemoveChild(AChildNode: TCacheNode);
begin
  if AChildNode.FPreSibling <> nil then
    AChildNode.FPreSibling.FNextSibling := AChildNode.FNextSibling;
  if AChildNode.FNextSibling <> nil then
    AChildNode.FNextSibling.FPreSibling := AChildNode.FPreSibling;
  FChildren.Remove(AChildNode);
end;

{ TCacheTree }

function TCacheTree.AddNode(AParent, ANextSibling: TCacheNode): TCacheNode;
begin
  Result := GetNewNode;
  if Assigned(ANextSibling) then
    ANextSibling.InsertPreSibling(Result)
  else if Assigned(AParent) then
    AParent.InsertChild(Result)
  else
    FRoot.InsertChild(Result);
end;

procedure TCacheTree.ClearTreeNodes;
begin
  FNewNodeID := 1;
  FRoot.ClearChildren;
  FCacheNodes.Clear;
end;

constructor TCacheTree.Create;
begin
  FCacheNodes := TCacheNodeList.Create;
  FRoot := TCacheNode.Create(Self, -1);
  FNewNodeID := 1;
end;

procedure TCacheTree.DeleteNode(ANode: TCacheNode);
begin
  ANode.FParent.RemoveChild(ANode);
  ANode.ClearChildren;
  FCacheNodes.Remove(ANode);
  ANode.Free;
end;

destructor TCacheTree.Destroy;
begin
  ClearTreeNodes;
  FRoot.Free;
  FCacheNodes.Free;
  inherited;
end;

function TCacheTree.GetFirstNode: TCacheNode;
begin
  if FCacheNodes.Count > 0 then
    Result := FCacheNodes.First
  else
    Result := nil;
end;

function TCacheTree.GetNewNode: TCacheNode;
begin
  Result := TCacheNode.Create(Self, GetNewNodeID);
  FCacheNodes.Add(Result);
end;

function TCacheTree.GetNewNodeID: Integer;
begin
  Result := FNewNodeID;
  Inc(FNewNodeID);
end;

procedure TCacheTree.SetNewNodeID(const Value: Integer);
begin
  FNewNodeID := Max(FNewNodeID, Value);
end;

end.