memtreeeh.pas

Ehlib.v3.4.for.Delphi5678.rar是DELPHI的三方控件源码.此控件适用于DELPHI5,6,7,8.

{*******************************************************}
{                                                       }
{                     EhLib vX.X                        }
{                                                       }
{            TMemTreeListEh component (Build 11)        }
{                                                       }
{        Copyright (c) 2004 by EhLib Team and           }
{                Dmitry V. Bolshakov                    }
{                                                       }
{*******************************************************}



unit MemTreeEh;

interface

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

type

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

  TCompareNodesEh = function (Node1, Node2: TTreeNodeEh; ParamSort: TObject): Integer of object;

{ TTreeNodeEh }

  TTreeNodeEh = class(TObject)
  private
    FOwner: TTreeListEh;
    FText: string;
    FData: TObject;
    FExpanded: Boolean;
    FHasChildren: Boolean;
    FIndex: Integer;
    FItems: TList;
    FLevel: Integer;
    FParent: TTreeNodeEh;
    FVisible: Boolean;
    procedure SetExpanded(const Value: Boolean);
    procedure SetVisible(const Value: Boolean);
  protected
    function GetCount: Integer;
    function GetItem(const Index: Integer): TTreeNodeEh; virtual;
    procedure Exchange(Index1, Index2: Integer);
    procedure QuickSort(L, R: Integer; Compare: TCompareNodesEh; ParamSort: TObject);
    function ExpandedChanging: Boolean; virtual;
    procedure ExpandedChanged; virtual;
    function VisibleChanging: Boolean; virtual;
    procedure VisibleChanged; virtual;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    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]: TTreeNodeEh read GetItem; default;
    property Level: Integer read FLevel;
    property Parent: TTreeNodeEh read FParent write FParent;
    property Owner: TTreeListEh read FOwner;
    property Text: string read FText write FText;
    property Visible: Boolean read FVisible write SetVisible;
  end;

  TTreeNodeClassEh = class of TTreeNodeEh;

{ TTreeListEh }

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

implementation

{ TTreeNodeEh }

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

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

procedure TTreeNodeEh.Exchange(Index1, Index2: Integer);
begin
  if Index1 = Index2 then Exit;
  FItems.Exchange(Index1, Index2);
  Items[Index2].FIndex := Index2;
  Items[Index1].FIndex := Index1;
end;

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

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

procedure TTreeNodeEh.QuickSort(L, R: Integer; Compare: TCompareNodesEh; ParamSort: TObject);
var
  I, J: Integer;
  P: TTreeNodeEh;
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;
end;

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

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

procedure TTreeNodeEh.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 TTreeNodeEh.ExpandedChanged;
begin
end;

function TTreeNodeEh.ExpandedChanging: Boolean;
begin
  Result := True;
end;

procedure TTreeNodeEh.VisibleChanged;
begin
end;

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

{ TTreeListEh }

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

destructor TTreeListEh.Destroy;
begin
  Root.Free;
  inherited Destroy;
end;

function TTreeListEh.AddChild(const Text: string; Parent: TTreeNodeEh; Data: TObject): TTreeNodeEh;
var
  ParentNode: TTreeNodeEh;
  NewNode: TTreeNodeEh;
  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.FItems.Add(NewNode);
  NewNode.Text := Text;
  NewNode.FLevel := ParentNode.Level + 1;
  NewNode.FIndex := ChildIndex;
  Result := NewNode;
end;

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

procedure TTreeListEh.DeleteNode(Node: TTreeNodeEh; ReIndex: Boolean);
begin
  DeleteChildren(Node);
  if Node.Parent = nil then
    Exit;
  Node.Parent.FItems.Delete(Node.Index);
  Node.Free;
  if ReIndex then
    BuildChildrenIndex(Node.Parent, false);
end;

procedure TTreeListEh.Expand(Node: TTreeNodeEh; Recurse: Boolean);
var
  I: Integer;
begin
  if Node = nil then Node := FRoot;
  if Node.Count > 0 then
  begin
    Node.Expanded := true;
    if Recurse then
      for I := 0 to Node.Count-1 do
        Expand(Node.Items[I], true);
  end;
end;

procedure TTreeListEh.Collapse(Node: TTreeNodeEh; Recurse: Boolean);
var
  I: Integer;
begin
  if Node = nil then Node := FRoot;
  Node.Expanded := false;
  if Recurse then
    for I := 0 to Node.Count-1 do
      Collapse(Node.Items[I], true);
end;


procedure TTreeListEh.AddNode(Node: TTreeNodeEh; Destination: TTreeNodeEh; Mode: TNodeAttachModeEh; ReIndex: Boolean);
begin
  if (Node = nil) or (Node = FRoot) then Exit;
  if Destination = nil then Destination := FRoot;
  if (Destination = FRoot) and (Mode <> naAddChildEh) and
     (Mode <> naAddChildFirstEh) then exit;

  case Mode of
    naAddChildEh:
      begin
        Node.Parent := Destination;
        Destination.HasChildren := True;
        Node.FIndex := Destination.FItems.Add(Node);
        Node.FLevel := Destination.Level + 1;
      end;
    naAddChildFirstEh:
      begin
        Node.Parent := Destination;
        Destination.HasChildren := True;
        Destination.FItems.Insert(0,Node);
        Node.FIndex :=0;
        Node.FLevel := Destination.Level + 1;
        if ReIndex then BuildChildrenIndex(Node.Parent, false);
      end;
    naAddEh:
      begin
        AddNode(Node, Destination.Parent, naAddChildEh, false);
      end;
    naAddFirstEh:
      begin
        AddNode(Node, Destination.Parent, naAddChildFirstEh, ReIndex);
      end;
    naInsertEh:
      begin
        Node.Parent := Destination.Parent;
        Destination.Parent.HasChildren := True;
        Destination.Parent.FItems.Insert(Destination.Index,Node);
        Node.FIndex :=Destination.Index;