delphi/Common/MemTreeEh.pas
2022-09-19 01:04:19 +08:00

1070 lines
29 KiB
ObjectPascal

{*******************************************************}
{ }
{ EhLib v8.0 }
{ TMemTreeListEh component }
{ (Build 8.0.04) }
{ }
{ Copyright (c) 2004-13 by EhLib Team and }
{ Dmitry V. Bolshakov }
{ }
{*******************************************************}
{$I EhLib.Inc}
unit MemTreeEh;
interface
uses SysUtils, Classes, ComCtrls, ToolCtrlsEh;
type
TTreeListEh = class;
TBaseTreeNodeEh = class;
TNodeAttachModeEh = (naAddEh, naAddFirstEh, naAddChildEh, naAddChildFirstEh, naInsertEh, naAddAfterEh);
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;
TTreeNodeIterativeEvent = procedure (Sender: TBaseTreeNodeEh; Param: TObject) of object;
TTreeListNotificationEh = (tlnNodeAddedEh, tlnNodeDeletedEh, tlnTreeListChangedEh);
{ TBaseTreeNodeEh }
// TBaseTreeNodeEh = class(TComponent)
TBaseTreeNodeEh = class(TPersistent)
private
FData: TObject;
FExpanded: Boolean;
FHasChildren: Boolean;
FHasVisibleChildren: Boolean;
FIndex: Integer;
FItems: TList;
FLevel: Integer;
FOwner: TTreeListEh;
FParent: TBaseTreeNodeEh;
FText: string;
FVisible: Boolean;
FVisibleCount: Integer;
FVisibleIndex: Integer;
FVisibleItems: TList;
FVisibleItemsObsolete: Boolean;
// FVisibleIndex: Integer;
function GetHasVisibleChildren: Boolean;
function GetVisibleItem(const Index: Integer): TBaseTreeNodeEh;
procedure InternalBuildVisibleItems;
procedure SetExpanded(const Value: Boolean);
procedure SetVisible(const Value: Boolean);
protected
function Add(Item: TBaseTreeNodeEh): Integer;
function ExpandedChanging: Boolean; virtual;
function GetCount: Integer;
function GetItem(const Index: Integer): TBaseTreeNodeEh; {$IFDEF EH_LIB_9} inline; {virtual;} {$ENDIF}
function GetVisibleCount: Integer;
function HasParentOf(Node: TBaseTreeNodeEh): Boolean;
function VisibleChanging: Boolean; virtual;
function VisibleItems: TList;
procedure BuildVisibleItems; virtual;
procedure ChildVisibleChanged(ChildNode: TBaseTreeNodeEh); virtual;
procedure Clear; virtual;
procedure Delete(Index: Integer);
procedure Exchange(Index1, Index2: Integer);
procedure ExpandedChanged; virtual;
procedure Insert(Index: Integer; Item: TBaseTreeNodeEh);
procedure QuickSort(L, R: Integer; Compare: TCompareNodesEh; ParamSort: TObject);
procedure SetLevel(ALevel: Integer);
procedure SortData(CompareProg: TCompareNodesEh; ParamSort: TObject; ARecurse: Boolean = True); virtual;
procedure VisibleChanged; virtual;
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 HasVisibleChildren: Boolean read GetHasVisibleChildren write FHasVisibleChildren;
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 VisibleIndex: Integer read FVisibleIndex;
property VisibleItem[const Index: Integer]: TBaseTreeNodeEh read GetVisibleItem;
public
// constructor Create(AOwner: TComponent); override;
constructor Create; virtual;
destructor Destroy; override;
end;
TTreeNodeClassEh = class of TBaseTreeNodeEh;
{ TTreeListEh }
TTreeListEh = class(TComponent)
private
FItemClass: TTreeNodeClassEh;
FMaxLevel: Integer;
FOnExpandedChanged: TTreeNodeNotifyEvent;
FOnExpandedChanging: TTreeNodeNotifyResultEvent;
FRoot: TBaseTreeNodeEh;
protected
function ExpandedChanging(Node: TBaseTreeNodeEh): Boolean; virtual;
function IsHasChildren(Node: TBaseTreeNodeEh = nil): Boolean; // if Node is nil then Node = RootNode
procedure ExpandedChanged(Node: TBaseTreeNodeEh); virtual;
procedure QuickSort(L, R: Integer; Compare: TCompareNodesEh);
property MaxLevel: Integer read FMaxLevel write FMaxLevel default 1000;
function AddChild(const Text: string; Parent: TBaseTreeNodeEh; Data: TObject): TBaseTreeNodeEh; // if Parent is nil then Parent = RootNode
function CompareTreeNodes(Rec1, Rec2: TBaseTreeNodeEh; ParamSort: TObject): Integer; virtual;
function CountChildren(Node: TBaseTreeNodeEh = nil): Integer; // if Node is nil then Node = RootNode
function CreateNodeApart(const Text: string; Data: TObject): TBaseTreeNodeEh;
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 GetNextVisible(Node: TBaseTreeNodeEh; ConsiderCollapsed: Boolean): TBaseTreeNodeEh;
function GetNextVisibleSibling(Node: TBaseTreeNodeEh): 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; FromIndex: Integer = -1; ToIndex: Integer = -1);
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 ExtractNode(Node: TBaseTreeNodeEh; ReIndex: Boolean);
procedure MoveTo(Node: TBaseTreeNodeEh; Destination: TBaseTreeNodeEh; Mode: TNodeAttachModeEh; ReIndex: Boolean); virtual;
procedure SortData(CompareProg: TCompareNodesEh; ParamSort: TObject; ARecurse: Boolean = True); virtual;
procedure TreeChanged(Node: TBaseTreeNodeEh; Operation: TTreeListNotificationEh; OldIndex: Integer; OldParentNode: TBaseTreeNodeEh); virtual;
property Root: TBaseTreeNodeEh read FRoot write FRoot;
property OnExpandedChanged: TTreeNodeNotifyEvent read FOnExpandedChanged write FOnExpandedChanged;
property OnExpandedChanging: TTreeNodeNotifyResultEvent read FOnExpandedChanging write FOnExpandedChanging;
public
constructor Create(ItemClass: TTreeNodeClassEh); reintroduce;
destructor Destroy; override;
end;
implementation
{ TBaseTreeNodeEh }
//constructor TBaseTreeNodeEh.Create(AOwner: TComponent);
constructor TBaseTreeNodeEh.Create;
begin
// inherited Create(AOwner);
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 FVisibleItemsObsolete then
InternalBuildVisibleItems;
if FVisibleCount = Count
then Result := Count
else Result := FVisibleItems.Count;
end;
function TBaseTreeNodeEh.GetVisibleItem(const Index: Integer): TBaseTreeNodeEh;
begin
if FVisibleItemsObsolete then
InternalBuildVisibleItems;
Result := TBaseTreeNodeEh(VisibleItems[Index]);
end;
function TBaseTreeNodeEh.VisibleItems: TList;
begin
if FVisibleItemsObsolete then
InternalBuildVisibleItems;
if Count = VisibleCount
then Result := FItems
else Result := FVisibleItems;
end;
procedure TBaseTreeNodeEh.BuildVisibleItems;
begin
FVisibleItemsObsolete := True;
// InternalBuildVisibleItems;
end;
procedure TBaseTreeNodeEh.InternalBuildVisibleItems;
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;
FVisibleItemsObsolete := False;
// if (Count > 0) {and HasChildren} then
HasVisibleChildren := (VisibleCount > 0);
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;
function TBaseTreeNodeEh.GetHasVisibleChildren: Boolean;
begin
if FVisibleItemsObsolete then
InternalBuildVisibleItems;
Result := FHasVisibleChildren;
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
if Owner <> nil then
Owner.ExpandedChanged(Self);
end;
function TBaseTreeNodeEh.ExpandedChanging: Boolean;
begin
if Owner <> nil
then Result := Owner.ExpandedChanging(Self)
else Result := True;
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.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);
BuildVisibleItems();
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
FItems.Delete(Index);
BuildVisibleItems();
{ 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;
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(nil);
FItemClass := ItemClass;
// FRoot := FItemClass.Create(Self);
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;
Result := CreateNodeApart(Text, Data);
AddNode(Result, ParentNode, naAddChildEh, True);
{
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;
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);
ExtractNode(Node, ReIndex);
FreeAndNil(Node);
end;
procedure TTreeListEh.ExtractNode(Node: TBaseTreeNodeEh; ReIndex: Boolean);
var
BuildChildrenIndexRequired: Boolean;
DeletedIndex: Integer;
OldParentNode: TBaseTreeNodeEh;
begin
if Node.Parent = nil then
Exit;
BuildChildrenIndexRequired := (Node.Index < Node.Parent.Count-1);
DeletedIndex := Node.Index;
OldParentNode := Node.Parent;
Node.Parent.Delete(Node.Index);
Node.Parent.HasChildren := (Node.Parent.Count > 0);
if ReIndex then
begin
if BuildChildrenIndexRequired then
BuildChildrenIndex(Node.Parent, False);
// Node.Parent.FItemsIndexesObsolete := True;
end;
TreeChanged(Node, tlnNodeDeletedEh, DeletedIndex, OldParentNode);
end;
procedure TTreeListEh.Expand(Node: TBaseTreeNodeEh; Recurse: Boolean);
var
I: Integer;
begin
if Node = nil then Node := FRoot;
if Node.Count > 0 then
begin
if Node <> FRoot then
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: TBaseTreeNodeEh; 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: TBaseTreeNodeEh; Destination: TBaseTreeNodeEh; 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.Add(Node);
Node.SetLevel(Destination.Level + 1);
end;
naAddChildFirstEh:
begin
Node.Parent := Destination;
Destination.HasChildren := True;
Destination.Insert(0, Node);
Node.FIndex := 0;
Node.SetLevel(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.Insert(Destination.Index, Node);
Node.FIndex := Destination.Index;
Node.SetLevel(Destination.Parent.Level + 1);
if ReIndex then BuildChildrenIndex(Destination.Parent, False, Node.Index);
end;
naAddAfterEh:
begin
if Destination.Parent[Destination.Parent.Count-1] = Destination then
AddNode(Node, Destination, naAddEh, ReIndex)
else
AddNode(Node, Destination.Parent[Destination.Index+1], naInsertEh, ReIndex);
end;
end;
TreeChanged(Node, tlnNodeAddedEh, -1, nil);
end;
procedure TTreeListEh.MoveTo(Node: TBaseTreeNodeEh; Destination: TBaseTreeNodeEh;
Mode: TNodeAttachModeEh; ReIndex: Boolean);
begin
if {(Destination = nil) or} (Node = nil) or (Node = FRoot) then Exit;
if (Destination = FRoot) and (Mode <> naAddChildEh) and (Mode <> naAddChildFirstEh) then
Exit;
if Destination.HasParentOf(Node) then
raise Exception.Create('Reference-loop found');
Node.Parent.Delete(Node.Index);
Node.Parent.HasChildren := (Node.Parent.Count > 0);
//
if ReIndex then BuildChildrenIndex(Node.Parent, False);
AddNode(Node, Destination, Mode, ReIndex);
end;
function TTreeListEh.GetNode(StartNode: TBaseTreeNodeEh; Data: TObject): TBaseTreeNodeEh;
var
I: Integer;
CurNode: TBaseTreeNodeEh;
begin
Result := nil;
if StartNode = nil then StartNode := FRoot;
for I := 0 to StartNode.Count - 1 do
begin
CurNode := StartNode.Items[I];
if CurNode.Data = Data then
begin
Result := CurNode;
Break;
end
else
begin
Result := GetNode(CurNode, Data);
if result <> nil then
Break;
end;
end
end;
function TTreeListEh.GetPrevSibling(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
begin
if (Node = nil) or (Node.Index = 0) or (Node.Parent = nil) then
begin
Result := nil;
exit;
end;
Result := TBaseTreeNodeEh(Node.Parent.Items[Node.Index - 1]);
end;
function TTreeListEh.GetNextSibling(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
begin
if (Node = nil) or (Node.Parent = nil) or (Node.Index = Node.Parent.Count - 1) then
begin
Result := nil;
Exit;
end;
Result := Node.Parent.Items[Node.Index + 1];
end;
function TTreeListEh.GetFirstChild(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
begin
if (Node = nil) or (Node.Count = 0) then
begin
Result := nil;
Exit;
end;
Result := Node.Items[0];
end;
function TTreeListEh.GetLastChild(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
begin
if (Node = nil) or (Node.Count = 0) then
begin
result := nil;
Exit;
end;
Result := Node.Items[Node.Count - 1];
end;
function TTreeListEh.GetFirst: TBaseTreeNodeEh;
begin
Result := GetFirstChild(FRoot);
end;
function TTreeListEh.GetPrevious(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
var
PrevSiblingNode: TBaseTreeNodeEh;
begin
Result := Node;
if (Result = nil) or (Result = FRoot) then exit;
PrevSiblingNode := GetPrevSibling(Result);
if PrevSiblingNode <> nil then
begin
Result := GetLast(PrevSiblingNode);
if Result = nil then
Result := PrevSiblingNode;
end
else
if Node.Parent <> FRoot then
Result := Node.Parent
else
Result := nil;
end;
function TTreeListEh.GetNext(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
var
FirstChild, NextSibling: TBaseTreeNodeEh;
begin
Result := Node;
if (Result = nil) or (Result = FRoot) then
Exit;
FirstChild := GetFirstChild(Result);
if FirstChild <> nil then
begin
Result := FirstChild;
Exit;
end;
repeat
NextSibling := GetNextSibling(Result);
if NextSibling <> nil then
begin
Result := NextSibling;
Break;
end
else
begin
if Result.Parent <> FRoot then
Result := Result.Parent
else
begin
Result := nil;
Break;
end;
end;
until False;
end;
function TTreeListEh.GetLast(Node: TBaseTreeNodeEh = nil): TBaseTreeNodeEh;
var
Next: TBaseTreeNodeEh;
begin
if Node = nil then
Node := FRoot;
Result := GetLastChild(Node);
while Result <> nil do
begin
Next := GetLastChild(Result);
if Next = nil then
Break;
Result := Next;
end;
end;
function TTreeListEh.IsHasChildren(Node: TBaseTreeNodeEh = nil): Boolean;
begin
if Node = nil then
Node := FRoot;
Result := Node.Count > 0;
end;
function TTreeListEh.CountChildren(Node: TBaseTreeNodeEh = nil): Integer;
begin
if Node = nil then
Node := FRoot;
Result := Node.Count;
end;
function TTreeListEh.GetParentAtLevel(Node: TBaseTreeNodeEh; ParentLevel: Integer): TBaseTreeNodeEh;
begin
Result := nil;
if (Node = nil) or (Node = FRoot) then
Exit;
if (ParentLevel >= Node.Level) or (ParentLevel < 0) then
Exit;
if ParentLevel = 0 then
begin
Result := FRoot;
Exit;
end;
Result := Node;
while Result <> nil do
begin
Result := Result.Parent;
if Result <> nil then
if Result.Level = ParentLevel then
Break;
end;
end;
function TTreeListEh.GetFirstVisible: TBaseTreeNodeEh;
var
CurNode: TBaseTreeNodeEh;
begin
Result := nil;
if not IsHasChildren then
Exit;
CurNode := GetFirstChild(FRoot);
if CurNode = nil then
Exit;
Result := CurNode;
if not Result.Visible then
begin
repeat
CurNode := GetNextSibling(Result);
if CurNode <> nil then
begin
Result := CurNode;
if Result.Visible then
Break;
end else
begin
if Result.Parent <> FRoot then
Result := Result.Parent
else
begin
Result := nil;
Break;
end;
end;
until False;
end;
end;
function TTreeListEh.GetPathVisible(Node: TBaseTreeNodeEh; ConsiderCollapsed: Boolean): Boolean;
begin
Result := False;
if (Node = nil) or (Node = FRoot) then exit;
repeat
Node := Node.Parent;
until (Node = FRoot) or not (Node.Expanded or not ConsiderCollapsed) or not (Node.Visible);
Result := (Node = FRoot);
end;
function TTreeListEh.GetParentVisible(Node: TBaseTreeNodeEh; ConsiderCollapsed: Boolean): TBaseTreeNodeEh;
begin
Result := Node;
while Result <> FRoot do
begin
repeat
Result := Result.Parent;
until (Result.Expanded or not ConsiderCollapsed);
if (Result = FRoot) or (Result.Visible and GetPathVisible(Result, ConsiderCollapsed)) then
Break;
while (Result <> FRoot) and (Result.Parent.Expanded or not ConsiderCollapsed) do
Result := Result.Parent;
end;
end;
function TTreeListEh.GetNextVisible(Node: TBaseTreeNodeEh; ConsiderCollapsed: Boolean): TBaseTreeNodeEh;
var
ForceSearch: Boolean;
FirstChild, NextSibling: TBaseTreeNodeEh;
begin
Result := Node;
if Result <> nil then
begin
if Result = FRoot then
begin
Result := nil;
Exit;
end;
if not (Result.Visible) or not (GetPathVisible(Result, ConsiderCollapsed)) then
Result := GetParentVisible(Result, ConsiderCollapsed);
FirstChild := GetFirstChild(Result);
if (Result.Expanded or not ConsiderCollapsed) and (FirstChild <> nil) then
begin
Result := FirstChild;
ForceSearch := False;
end
else
ForceSearch := True;
if (Result <> nil) and (ForceSearch or not (Result.Visible)) then
begin
repeat
NextSibling := GetNextSibling(Result);
if NextSibling <> nil then
begin
Result := NextSibling;
if Result.Visible then
Break;
end
else
begin
if Result.Parent <> FRoot then
Result := Result.Parent
else
begin
Result := nil;
Break;
end;
end;
until False;
end;
end;
end;
procedure TTreeListEh.Clear;
begin
DeleteChildren(FRoot);
end;
procedure TTreeListEh.BuildChildrenIndex(Node: TBaseTreeNodeEh = nil; Recurse: Boolean = True; FromIndex: Integer = -1; ToIndex: Integer = -1);
var
I: Integer;
CurNode: TBaseTreeNodeEh;
AFromIndex, AToIndex: Integer;
begin
if Node = nil then
Node := FRoot;
Node.FVisibleItems.Clear;
if FromIndex = -1
then AFromIndex := 0
else AFromIndex := FromIndex;
if ToIndex = -1
then AToIndex := Node.Count - 1
else AToIndex := ToIndex;
for I := AFromIndex to AToIndex do
begin
CurNode := Node.Items[I];
CurNode.FIndex := I;
{ if CurNode.Visible
then CurNode.FVisibleIndex := Node.FVisibleItems.Add(CurNode)
else CurNode.FVisibleIndex := -1;}
if Recurse then
BuildChildrenIndex(CurNode, True);
end;
Node.BuildVisibleItems;
end;
procedure TTreeListEh.ExportToTreeView(TreeView:TTreeView; Node: TBaseTreeNodeEh; NodeTree: TTreeNode;AddChild:Boolean);
var
CurNode:TBaseTreeNodeEh;
TreeNode:TTreeNode;
begin
CurNode := Node;
while CurNode <> nil do
begin
if AddChild then
TreeNode:=TreeView.Items.AddChildObject(NodeTree, CurNode.Text, CurNode.Data)
else
TreeNode:=TreeView.Items.AddObject(NodeTree, CurNode.Text, CurNode.Data);
TreeNode.Expanded := CurNode.Expanded;
ExportToTreeView(TreeView, GetFirstChild(CurNode), TreeNode,True);
CurNode:=GetNextSibling(CurNode);
end;
end;
procedure TTreeListEh.QuickSort(L, R: Integer; Compare: TCompareNodesEh);
begin
end;
procedure TTreeListEh.SortData(CompareProg: TCompareNodesEh; ParamSort: TObject; ARecurse: Boolean);
begin
FRoot.SortData(CompareProg, ParamSort, ARecurse);
end;
function TTreeListEh.CompareTreeNodes(Rec1, Rec2: TBaseTreeNodeEh; ParamSort: TObject): Integer;
begin
Result := 0;
end;
function TTreeListEh.GetNextVisibleSibling(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
begin
if Node.Parent.Count = Node.Parent.VisibleCount then
Result := GetNextSibling(Node)
else
begin
if (Node = nil) or (Node.Parent = nil) or (Node.VisibleIndex = Node.Parent.VisibleCount - 1) then
begin
Result := nil;
Exit;
end;
Result := Node.Parent.VisibleItem[Node.VisibleIndex + 1];
end;
end;
function TTreeListEh.GetPrevVisibleSibling(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
begin
if Node.Parent.Count = Node.Parent.VisibleCount then
Result := GetPrevSibling(Node)
else
begin
if (Node = nil) or (Node.Parent = nil) or (Node.VisibleIndex = 0) then
begin
Result := nil;
Exit;
end;
Result := Node.Parent.VisibleItem[Node.VisibleIndex - 1];
end;
end;
procedure TTreeListEh.ExpandedChanged(Node: TBaseTreeNodeEh);
begin
if Assigned(OnExpandedChanged) then
OnExpandedChanged(Node);
end;
procedure TTreeListEh.TreeChanged(Node: TBaseTreeNodeEh;
Operation: TTreeListNotificationEh; OldIndex: Integer;
OldParentNode: TBaseTreeNodeEh);
begin
end;
function TTreeListEh.ExpandedChanging(Node: TBaseTreeNodeEh): Boolean;
begin
Result := True;
if Assigned(OnExpandedChanging) then
Result := OnExpandedChanging(Node);
end;
function TTreeListEh.CreateNodeApart(const Text: string; Data: TObject): TBaseTreeNodeEh;
var
NewNode: TBaseTreeNodeEh;
begin
// NewNode := FItemClass.Create(Self);
NewNode := FItemClass.Create;
NewNode.Parent := nil;
NewNode.FOwner := Self;
NewNode.Data := Data;
NewNode.Text := Text;
NewNode.FLevel := 0;
NewNode.FIndex := -1;
Result := NewNode;
end;
end.