memtreeeh.pas

最新的 DBGRIDEH4.0

{*******************************************************}
{                                                       }
{                     EhLib v4.0                        }
{              TMemTreeListEh component                 }
{                   (Build 4.0.15)                      }
{                                                       }
{        Copyright (c) 2004-05 by EhLib Team and        }
{                Dmitry V. Bolshakov                    }
{                                                       }
{*******************************************************}



unit MemTreeEh;

interface

uses Windows, SysUtils, Classes, ComCtrls, ToolCtrlsEh, Contnrs;

type

  TTreeListEh = class;
  TBaseTreeNodeEh = class;
  TNodeAttachModeEh = (naAddEh, naAddFirstEh, naAddChildEh, naAddChildFirstEh, naInsertEh);
  TAddModeEh = (taAddFirstEh, taAddEh, taInsertEh);

  TCompareNodesEh = function (Node1, Node2: TBaseTreeNodeEh; ParamSort: TObject): Integer of object;
  TTreeNodeNotifyEvent = procedure (Sender: TBaseTreeNodeEh) of object;
  TTreeNodeNotifyResultEvent = function (Sender: TBaseTreeNodeEh): Boolean of object;

{ TBaseTreeNodeEh }

  TBaseTreeNodeEh = class(TObject)
  private
    FOwner: TTreeListEh;
    FText: string;
    FData: TObject;
    FExpanded: Boolean;
    FHasChildren: Boolean;
    FIndex: Integer;
    FItems: TList;
    FVisibleItems: TList;
    FLevel: Integer;
    FParent: TBaseTreeNodeEh;
    FVisible: Boolean;
    FVisibleCount: Integer;
    FVisibleIndex: Integer;
//    FVisibleIndex: Integer;
    procedure SetExpanded(const Value: Boolean);
    procedure SetVisible(const Value: Boolean);
    function GetVisibleItem(const Index: Integer): TBaseTreeNodeEh;
  protected
    function ExpandedChanging: Boolean; virtual;
    function GetCount: Integer;
    function GetItem(const Index: Integer): TBaseTreeNodeEh; virtual;
    function GetVisibleCount: Integer;
    function VisibleChanging: Boolean; virtual;
    function VisibleItems: TList;
    function Add(Item: TBaseTreeNodeEh): Integer;
    function HasParentOf(Node: TBaseTreeNodeEh): Boolean;
    procedure Delete(Index: Integer);
    procedure Clear; virtual;
    procedure Insert(Index: Integer; Item: TBaseTreeNodeEh);
    procedure ChildVisibleChanged(ChildNode: TBaseTreeNodeEh); virtual;
    procedure Exchange(Index1, Index2: Integer);
    procedure ExpandedChanged; virtual;
    procedure QuickSort(L, R: Integer; Compare: TCompareNodesEh; ParamSort: TObject);
    procedure SetLevel(ALevel: Integer);
    procedure VisibleChanged; virtual;
    procedure BuildVisibleItems; virtual;
    procedure SortData(CompareProg: TCompareNodesEh; ParamSort: TObject; ARecurse: Boolean = True);
    property Count: Integer read GetCount;
    property Data: TObject read FData write FData;
    property Expanded: Boolean read FExpanded write SetExpanded;
    property HasChildren: Boolean read FHasChildren write FHasChildren;
    property Index: Integer read FIndex;
    property Items[const Index: Integer]: TBaseTreeNodeEh read GetItem; default;
    property Level: Integer read FLevel;
    property Owner: TTreeListEh read FOwner;
    property Parent: TBaseTreeNodeEh read FParent write FParent;
    property Text: string read FText write FText;
    property Visible: Boolean read FVisible write SetVisible default True;
    property VisibleCount: Integer read GetVisibleCount;
    property VisibleItem[const Index: Integer]: TBaseTreeNodeEh read GetVisibleItem;
    property VisibleIndex: Integer read FVisibleIndex;
  public
    constructor Create; virtual;
    destructor Destroy; override;
  end;

  TTreeNodeClassEh = class of TBaseTreeNodeEh;

{ TTreeListEh }

  TTreeListEh = class(TObject)
  private
    FItemClass: TTreeNodeClassEh;
    FOnExpandedChanged: TTreeNodeNotifyEvent;
    FOnExpandedChanging: TTreeNodeNotifyResultEvent;
    FMaxLevel: Integer;
  protected
    FRoot: TBaseTreeNodeEh;
    function IsHasChildren(Node: TBaseTreeNodeEh = nil): Boolean; // if Node is nil then Node = RootNode
    function ExpandedChanging(Node: TBaseTreeNodeEh): Boolean; virtual;
    procedure ExpandedChanged(Node: TBaseTreeNodeEh); virtual;
    procedure QuickSort(L, R: Integer; Compare: TCompareNodesEh);
    property MaxLevel: Integer read FMaxLevel write FMaxLevel default 1000;
  public
    constructor Create(ItemClass: TTreeNodeClassEh);
    destructor Destroy; override;
    function AddChild(const Text: string; Parent: TBaseTreeNodeEh; Data: TObject): TBaseTreeNodeEh; // if Parent is nil then Parent = RootNode
    function CountChildren(Node: TBaseTreeNodeEh = nil): Integer; // if Node is nil then Node = RootNode
    function GetFirst: TBaseTreeNodeEh;
    function GetFirstChild(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
    function GetFirstVisible: TBaseTreeNodeEh;
    function GetLast(Node: TBaseTreeNodeEh = nil): TBaseTreeNodeEh; // if Node is nil then Node = RootNode
    function GetLastChild(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
    function GetNext(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
    function GetNextSibling(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
    function GetNextVisibleSibling(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
    function GetNextVisible(Node: TBaseTreeNodeEh; ConsiderCollapsed: Boolean): TBaseTreeNodeEh;
    function GetNode(StartNode: TBaseTreeNodeEh; Data: TObject): TBaseTreeNodeEh;
    function GetParentAtLevel(Node: TBaseTreeNodeEh; ParentLevel: Integer): TBaseTreeNodeEh;   //
    function GetParentVisible(Node: TBaseTreeNodeEh; ConsiderCollapsed: Boolean): TBaseTreeNodeEh;
    function GetPathVisible(Node: TBaseTreeNodeEh; ConsiderCollapsed: Boolean): Boolean;
    function GetPrevious(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
    function GetPrevSibling(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
    function GetPrevVisibleSibling(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
    procedure AddNode(Node: TBaseTreeNodeEh; Destination: TBaseTreeNodeEh; Mode: TNodeAttachModeEh; ReIndex: Boolean);
    procedure BuildChildrenIndex(Node: TBaseTreeNodeEh = nil; Recurse: Boolean = True);
    procedure Clear;
    procedure Collapse(Node: TBaseTreeNodeEh; Recurse: Boolean);
    procedure DeleteChildren(Node: TBaseTreeNodeEh);
    procedure DeleteNode(Node: TBaseTreeNodeEh; ReIndex: Boolean);
    procedure Expand(Node: TBaseTreeNodeEh; Recurse: Boolean);
    procedure ExportToTreeView(TreeView: TTreeView; Node: TBaseTreeNodeEh; NodeTree: TTreeNode; AddChild: Boolean);
    procedure MoveTo(Node: TBaseTreeNodeEh; Destination: TBaseTreeNodeEh; Mode: TNodeAttachModeEh; ReIndex: Boolean); virtual;
    procedure SortData(CompareProg: TCompareNodesEh; ParamSort: TObject; ARecurse: Boolean = True); virtual;
    property Root: TBaseTreeNodeEh read FRoot write FRoot;
    property OnExpandedChanged: TTreeNodeNotifyEvent read FOnExpandedChanged write FOnExpandedChanged;
    property OnExpandedChanging: TTreeNodeNotifyResultEvent read FOnExpandedChanging write FOnExpandedChanging;
  end;

implementation

{ TBaseTreeNodeEh }

constructor TBaseTreeNodeEh.Create;
begin
  inherited Create;
  FItems := TList.Create;
  FVisibleItems := TList.Create;
  FVisible := True;
end;

destructor TBaseTreeNodeEh.Destroy;
var
  I: Integer;
begin
  for I := 0  to FItems.Count - 1  do
    TBaseTreeNodeEh(FItems[I]).Free;
  FreeAndNil(FItems);
  FreeAndNil(FVisibleItems);
  inherited Destroy;
end;

procedure TBaseTreeNodeEh.Exchange(Index1, Index2: Integer);
begin
  if Index1 = Index2 then Exit;
  FItems.Exchange(Index1, Index2);
  Items[Index2].FIndex := Index2;
  Items[Index1].FIndex := Index1;
  //Visible Index now invalid.
end;

function TBaseTreeNodeEh.GetCount;
begin
  Result := FItems.Count;
end;

function TBaseTreeNodeEh.GetVisibleCount: Integer;
begin
  if FVisibleCount = Count
    then Result := Count
    else Result := FVisibleItems.Count;
end;

function TBaseTreeNodeEh.GetItem(const Index: Integer): TBaseTreeNodeEh;
begin
  if (Index < 0) or (Index > FItems.Count-1) then
    begin
      Result := nil;
      Exit;
    end;
  Result := TBaseTreeNodeEh(FItems.Items[Index]);
end;

procedure TBaseTreeNodeEh.QuickSort(L, R: Integer; Compare: TCompareNodesEh; ParamSort: TObject);
var
  I, J: Integer;
  P: TBaseTreeNodeEh;
begin
  repeat
    I := L;
    J := R;
    P := Items[(L + R) shr 1];
    repeat
      while Compare(Items[I], P, ParamSort) < 0 do
        Inc(I);
      while Compare(Items[J], P, ParamSort) > 0 do
        Dec(J);
      if I <= J then
      begin
        Exchange(I, J);
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      QuickSort(L, J, Compare, ParamSort);
    L := I;
  until I >= R;
  
  if FVisibleCount <> Count then
    BuildVisibleItems();
//  Owner.BuildChildrenIndex(Self, False); // To reset visible index.
end;

procedure TBaseTreeNodeEh.SetExpanded(const Value: Boolean);
begin
  if FExpanded = Value then Exit;
  if ExpandedChanging then
  begin
    FExpanded := Value;
    ExpandedChanged;
  end;
end;

procedure TBaseTreeNodeEh.SetVisible(const Value: Boolean);
begin
  if FVisible = Value then Exit;
  if VisibleChanging then
  begin
    FVisible := Value;
    VisibleChanged;
  end;  
end;

procedure TBaseTreeNodeEh.SortData(CompareProg: TCompareNodesEh; ParamSort: TObject; ARecurse: Boolean);
var
  i: Integer;
begin
  if Count = 0 then Exit;
  QuickSort(0, Count-1, CompareProg, ParamSort);
  if ARecurse then
    for i := 0 to Count-1  do
      Items[i].SortData(CompareProg, ParamSort, ARecurse);
//  Owner.BuildChildrenIndex(Self, False);
end;

procedure TBaseTreeNodeEh.ExpandedChanged;
begin
  Owner.ExpandedChanged(Self);
end;

function TBaseTreeNodeEh.ExpandedChanging: Boolean;
begin
  Result := Owner.ExpandedChanging(Self);
end;

procedure TBaseTreeNodeEh.VisibleChanged;
begin
//  if Visible then
  FParent.ChildVisibleChanged(Self);
end;

procedure TBaseTreeNodeEh.ChildVisibleChanged(ChildNode: TBaseTreeNodeEh);
//var
//  i{, j}: Integer;
begin
  BuildVisibleItems();
{  if Visible then
  begin
    for i := 0 to Count-1 do
      if Items[i].Index > ChildNode.Index then
      begin
        FVisibleItems.Insert(i, ChildNode);
        ChildNode.FVisibleIndex := i;
        for j := i+1 to FVisibleItems.Count-1 do
          Inc(TBaseTreeNodeEh(FVisibleItems[i]).FVisibleIndex);
        Exit;
      end;
    ChildNode.FVisibleIndex := FVisibleItems.Add(ChildNode);
  end else
    for i := 0 to Count-1 do
      if Items[i].Index = ChildNode.Index then
      begin
        FVisibleItems.Delete(i);
        for j := i to FVisibleItems.Count-1 do
          Dec(TBaseTreeNodeEh(FVisibleItems[i]).FVisibleIndex);
        Exit;
      end;}
end;

function TBaseTreeNodeEh.VisibleChanging: Boolean;
begin
  Result := True;
end;

procedure TBaseTreeNodeEh.SetLevel(ALevel: Integer);
var
  i: Integer;
begin
  if FLevel <> ALevel then
  begin
    if ALevel > Owner.MaxLevel then
      raise Exception.Create('TBaseTreeNodeEh.SetLevel: Max level exceed - ' + IntToStr(Owner.MaxLevel));
    FLevel := ALevel;
    for i := 0 to Count-1  do
      Items[i].SetLevel(FLevel+1);
  end;
end;

function TBaseTreeNodeEh.GetVisibleItem(const Index: Integer): TBaseTreeNodeEh;
begin
  Result := TBaseTreeNodeEh(VisibleItems[Index]);
end;

function TBaseTreeNodeEh.VisibleItems: TList;
begin
  if Count = VisibleCount
    then Result := FItems
    else Result := FVisibleItems;
end;

function TBaseTreeNodeEh.Add(Item: TBaseTreeNodeEh): Integer;
begin
  if Item.Owner <> Owner then
    raise Exception.Create('TBaseTreeNodeEh.Add: Tree nodes can not has different Owners');
  if (FVisibleCount = Count) and Item.Visible then
  begin
    Result := FItems.Add(Item);
    Item.FVisibleIndex := Result;
    Inc(FVisibleCount);
  end else
  begin
    Result := FItems.Add(Item);
    BuildVisibleItems();
  end;
end;

procedure TBaseTreeNodeEh.Clear;
begin
  FItems.Clear;
  FVisibleItems.Clear;
end;

procedure TBaseTreeNodeEh.Delete(Index: Integer);
begin
  if FVisibleCount = Count then
  begin
    FItems.Delete(Index);
    Dec(FVisibleCount);
  end else
  begin
    FItems.Delete(Index);
    BuildVisibleItems();
  end;
end;

procedure TBaseTreeNodeEh.Insert(Index: Integer; Item: TBaseTreeNodeEh);
begin
  if Item.Owner <> Owner then
    raise Exception.Create('TBaseTreeNodeEh.Add: Tree nodes can not has different Owners');
  if (FVisibleCount = Count) and Item.Visible then
  begin
    FItems.Insert(Index, Item);
    Inc(FVisibleCount);
  end else
  begin
    FItems.Insert(Index, Item);
    BuildVisibleItems();
  end;
end;

procedure TBaseTreeNodeEh.BuildVisibleItems;
var
  i: Integer;
begin
  FVisibleItems.Clear;
  for i := 0 to Count-1 do
    if Items[i].Visible then
      Items[i].FVisibleIndex := FVisibleItems.Add(Items[i]);
  FVisibleCount := FVisibleItems.Count;
  if (Count > 0) {and HasChildren} then
    HasChildren := (VisibleCount > 0);
end;

function TBaseTreeNodeEh.HasParentOf(Node: TBaseTreeNodeEh): Boolean;
var
  ANode: TBaseTreeNodeEh;
begin
  Result := False;
  ANode := Self;
  while ANode <> Owner.Root do
  begin
    if ANode = Node then
    begin
      Result := True;
      Exit;
    end;
    ANode := ANode.Parent;
  end;
end;

{ TTreeListEh }

constructor TTreeListEh.Create(ItemClass: TTreeNodeClassEh);
begin
  inherited Create;
  FItemClass := ItemClass;
  FRoot := FItemClass.Create;
  Root.Parent := nil;
  Root.FLevel := 0;
  Root.FOwner := Self;
  FMaxLevel := 1000;
end;

destructor TTreeListEh.Destroy;
begin
  FreeAndNil(FRoot);
  inherited Destroy;
end;

function TTreeListEh.AddChild(const Text: string; Parent: TBaseTreeNodeEh; Data: TObject): TBaseTreeNodeEh;
var
  ParentNode: TBaseTreeNodeEh;
  NewNode: TBaseTreeNodeEh;
  ChildIndex: Integer;
begin
  if Parent = nil
    then ParentNode := FRoot
    else ParentNode := Parent;
  NewNode := FItemClass.Create;
  NewNode.Parent := ParentNode;
  ParentNode.HasChildren := True;
  NewNode.FOwner := Self;
  NewNode.Data := Data;
  ChildIndex := ParentNode.Add(NewNode);
  NewNode.Text := Text;
  NewNode.SetLevel(ParentNode.Level + 1);
  NewNode.FIndex := ChildIndex;
//  NewNode.FVisibleIndex := ParentNode.FVisibleItems.Add(NewNode);
  Result := NewNode;
end;

procedure TTreeListEh.DeleteChildren(Node: TBaseTreeNodeEh);
var
  I: Integer;
begin
 for I := 0  to Node.Count - 1  do
   Node.Items[I].Free;
 Node.Clear;
end;

procedure TTreeListEh.DeleteNode(Node: TBaseTreeNodeEh; ReIndex: Boolean);
begin
  DeleteChildren(Node);
  if Node.Parent = nil then
    Exit;
  Node.Parent.Delete(Node.Index);
  Node.Parent.HasChildren := (Node.Parent.Count > 0);
  if ReIndex then
    BuildChildrenIndex(Node.Parent, False);
  FreeAndNil(Node);