Невизуальное дерево
01.01.2007
unit EctoSoftTree;
{===============================================================================
Класс TEctoSoftTree представляет собой невизуальное дерево для манипулирования
древоподобными структурами в памяти. Мной в очередной раз из любви к искусству
был изобретен велосипед :))), который тем не менее получился вполне съедобным
и несмотря на наличие других вариантов решения задачи будет использоваться мной
хотя бы назло врагам :) Буду рад если еще кому-то он придется по вкусу.
Просьба при внесении изменений и дополнений в код, а также обнаружении ошибок
(которых здесь нет ;) уведомить автора, т.е. меня
Малышев Владимир aka "мыш"
feedback@ectosoft.com
http://www.EctoSoft.com
================================================================================}
interface
uses SysUtils, {EctoSysUtils,} Classes {EctoTypes,};
{ TEctoTreeNode class --------------------------------------------------------}
type TEctoSoftTree = class;
TEctoTreeNode = class(TObject)
private
FParentNode: TEctoTreeNode;
function GetDescendantCount(): integer;
function GetAbsoluteIndex(): integer;
function GetChildIndex(): integer;
function GetLevel(): integer;
function GetPrevSibling(): TEctoTreeNode;
function GetNextSibling(): TEctoTreeNode;
function GetLastDescendant(): TEctoTreeNode;
procedure SetParent(NewParentNode: TEctoTreeNode);
public
ParentTree: TEctoSoftTree;
Children: TList;
Data: Pointer;
Caption: string;
destructor Destroy(); override;
constructor Create();
function GetPrevChild(TargetChildNode: TEctoTreeNode): TEctoTreeNode;
function GetNextChild(TargetChildNode: TEctoTreeNode): TEctoTreeNode;
function GetLastChild(): TEctoTreeNode;
function GetNext(): TEctoTreeNode;
function GetPrev(): TEctoTreeNode;
function IsRoot(): boolean;
function IsParentOf(Node: TEctoTreeNode): boolean;
procedure MoveUp();
procedure MoveDown();
procedure MoveLeft();
procedure MoveRight();
procedure Sort(Compare: TListSortCompare; SortSubtrees: boolean);
property AbsoluteIndex: integer read GetAbsoluteIndex;
property Index: integer read GetChildIndex;
property PrevSibling: TEctoTreeNode read GetPrevSibling;
property NextSibling: TEctoTreeNode read GetNextSibling;
property LastDescendant: TEctoTreeNode read GetLastDescendant;
property DescendantCount: integer read GetDescendantCount;
property Level: integer read GetLevel;
property ParentNode: TEctoTreeNode read FParentNode write SetParent;
end;
TOnFreeNodeEvent = procedure(Node: TEctoTreeNode) of object;
{ TEctoSoftTree class --------------------------------------------------------}
TEctoSoftTree = class(TObject)
private
FOnFreeNodeEvent: TOnFreeNodeEvent;
function GetNodeFromIndex(Index:integer): TEctoTreeNode;
function GetNodeCount(): integer;
public
Root: TEctoTreeNode;
function FindNode(FindCaption: string): TEctoTreeNode;
procedure DeleteNode(Index: integer); overload;
procedure DeleteNode(DeletingNode: TEctoTreeNode); overload;
function AddNode(aParentNode:TEctoTreeNode):
TEctoTreeNode; overload;
function AddNode(aParentNode:TEctoTreeNode; Caption: string):
TEctoTreeNode; overload;
function AddNode(aParentNode:TEctoTreeNode; Data: Pointer):
TEctoTreeNode; overload;
function AddNode(aParentNode:TEctoTreeNode; Caption: string; Data: Pointer):
TEctoTreeNode; overload;
procedure Clear();
destructor Destroy; override;
property Nodes[Index:integer] : TEctoTreeNode read GetNodeFromIndex;
property NodeCount: integer read GetNodeCount;
property OnFreeNode: TOnFreeNodeEvent read FOnFreeNodeEvent write
FOnFreeNodeEvent;
end;
implementation
{ TEctoSoftTree }
function TEctoSoftTree.AddNode(aParentNode: TEctoTreeNode; Caption: string;
Data: Pointer): TEctoTreeNode;
var
NewNode: TEctoTreeNode;
begin
NewNode := TEctoTreeNode.Create;
if Root=nil then
begin
NewNode.FParentNode := nil;
Root := NewNode;
end
else
begin
if aParentNode=nil then
Raise EInvalidOperation.Create('Parent node must exists');
NewNode.FParentNode := aParentNode;
aParentNode.Children.Add(NewNode);
end;
NewNode.Caption := Caption;
NewNode.Data := Data;
NewNode.ParentTree := self;
result := NewNode;
end;
function TEctoSoftTree.AddNode(aParentNode: TEctoTreeNode): TEctoTreeNode;
begin
result := AddNode(aParentNode,'',nil);
end;
function TEctoSoftTree.AddNode(aParentNode: TEctoTreeNode;
Caption: string): TEctoTreeNode;
begin
result := AddNode(aParentNode,Caption,nil);
end;
function TEctoSoftTree.AddNode(aParentNode: TEctoTreeNode;
Data: Pointer): TEctoTreeNode;
begin
result := AddNode(aParentNode,'',Data);
end;
procedure TEctoSoftTree.Clear;
begin
if Root=nil then exit;
Root.Free;
Root := nil;
end;
procedure TEctoSoftTree.DeleteNode(Index: integer);
begin
DeleteNode(Nodes[Index]);
end;
procedure TEctoSoftTree.DeleteNode(DeletingNode: TEctoTreeNode);
begin
if DeletingNode.IsRoot then
FreeAndNil(Root) // Рут не нужно исключать из родительского списка, поэтому просто
освобождаем
else
begin
DeletingNode.FParentNode.Children.Delete // обращение к ParentNode без проверки на его существование обусловлено тем,
что раз это не Root, значит у него обязательно есть Parent
(DeletingNode.FParentNode.Children.IndexOf(DeletingNode));
FreeAndNil(DeletingNode);
end;
end;
destructor TEctoSoftTree.Destroy;
begin
Clear();
inherited;
end;
{ функция FindNode пока ищет только первое вхождение узла с заданным сaption
- надо доработать}
function TEctoSoftTree.FindNode(FindCaption: string): TEctoTreeNode;
procedure FindNode_(TargetNode: TEctoTreeNode);
var
i:integer;
begin
if result<>nil then exit; // выходим из всех рекурсий, если где-то в одной из них ранее уже был найден
узел
{ проверяем вызванный узел TargetNode на соответствие }
if TargetNode.Caption = FindCaption then
begin
result := TargetNode;
exit;
end;
{ /проверяем вызванный узел TargetNode на соответствие }
{ вызываем всех детей узела TargetNode для их проверки }
i:=0;
while i<TargetNode.Children.Count do
begin
FindNode_(TEctoTreeNode(TargetNode.Children.Items[i]));
inc(i);
end;
{ /вызываем всех детей узела TargetNode для их проверки }
end;
begin
result := nil;
FindNode_(Root);
end;
function TEctoSoftTree.GetNodeCount: integer;
begin
if Root=nil then result := 0 else
result := Root.GetDescendantCount+1; // +1 - Учитываем Root
end;
{ функция GetNodeFromIndex - "движок" для Nodes[Index:integer] }
function TEctoSoftTree.GetNodeFromIndex(Index: integer): TEctoTreeNode;
var
IndexCounter: integer;
procedure CompareNodeIndex(Node: TEctoTreeNode);
var
i:integer;
begin
{ блок 1 проверяем вызванный узел }
inc(IndexCounter);
if IndexCounter=Index then
begin
result := Node;
exit;
end;
{ / блок 1 проверяем вызванный узел }
{ вызываем дочерние узлы чтобы выполнить в них предыдущий блок - блок 1 }
i:=0;
while i<Node.Children.Count do
begin
CompareNodeIndex(TEctoTreeNode(Node.Children[i]));
inc(i);
end;
{ /вызываем дочерние узлы чтобы выполнить в них предыдущий блок - блок 1 }
end;
begin
IndexCounter := -1;
result := nil;
CompareNodeIndex(Root);
if (result=nil) then Raise EInvalidOperation.Create('Wrong index');
end;
{ TEctoTreeNode }
constructor TEctoTreeNode.Create;
begin
Children := TList.Create;
end;
destructor TEctoTreeNode.Destroy;
var
i:integer;
begin
if assigned(ParentTree.FOnFreeNodeEvent) then
ParentTree.FOnFreeNodeEvent(self);
i:=0;
while i<Children.Count do
begin
TEctoTreeNode(Children.Items[i]).Free;
inc(i);
end;
Children.Free;
inherited;
end;
function TEctoTreeNode.GetAbsoluteIndex: integer;
var
Node: TEctoTreeNode;
begin
if IsRoot then Result := 0
else
begin
Result := -1;
Node := Self;
while Node <> nil do
begin
Inc(Result);
Node := Node.GetPrev;
end;
end;
end;
{ функция GetDescendantCount возвращает количество всех потомков данного узла,
включая дочерние узлы и их потомки }
function TEctoTreeNode.GetChildIndex: integer;
begin
result := -1;
if IsRoot then exit;
result := ParentNode.Children.IndexOf(self);
end;
function TEctoTreeNode.GetDescendantCount: integer;
var
Node: TEctoTreeNode;
begin
result := 0;
Node := Self.GetLastDescendant;
if Node = nil then exit;
while (Node <> self) do
begin
inc(result);
Node := Node.GetPrev;
end;
end;
{ функция GetLastChild возвращает последний дочерний узел текущего. Возвращает
nil в случае если узел не имеет дочерних узлов, что и обуславливает
необходимость данной функции }
function TEctoTreeNode.GetLastChild: TEctoTreeNode;
begin
result := nil;
if Children.Count>0 then
result := TEctoTreeNode(Children[Children.Count-1]);
end;
{ функция GetLastDescendant возвращает последнего потомка текущего узла. Учитываются не только
прямые потомки (дочерние узлы) но и дальние (их потомки) }
function TEctoTreeNode.GetLastDescendant(): TEctoTreeNode;
var
Node: TEctoTreeNode;
begin
Node := self;
while Node.GetLastChild<>nil do
Node := Node.GetLastChild();
if Node = self then Node := nil;
result := Node;
end;
function TEctoTreeNode.GetLevel: integer;
var
Node: TEctoTreeNode;
begin
result := 0;
if IsRoot then exit;
Node := self;
while Node<>ParentTree.Root do
begin
inc(result);
Node := Node.FParentNode;
end;
end;
{ GetNext возвращает следующий узел по ходу "рекурсивного" обхода дерева }
function TEctoTreeNode.GetNext: TEctoTreeNode;
var
Node : TEctoTreeNode;
begin
result := nil;
if Children.Count>0 then
result := TEctoTreeNode(Children[0]); // Если у узла есть дочерние узлы, то следующим за ним будет очевидно первый
дочерний
if result = nil then // Если дочерних нет...
result := GetNextSibling(); // то следующим будет следующий сестринский узел
if (result = nil) and (not IsRoot) then // Если и дочерних и сестринских нет, а также это не рут, то следующим будет
первый сестринский узел родителя
begin
Node := FParentNode;
while (Node.GetNextSibling = nil) and (not Node.IsRoot) do // У родителя может не оказаться сестринских узлов, тогда проводим поиск
(идя назад) первого родителя (беря "родителя родителя") у которого будет сестринский узел
Node := Node.FParentNode;
if not Node.IsRoot then
result := Node.GetNextSibling;
end;
end;
{ функция GetNextChild возвращает следующией дочерний узел отсчитывая от
заданного дочернего узла. Если заданный узел является последним дочерним
узлом, функция возвращает nil }
function TEctoTreeNode.GetNextChild(TargetChildNode: TEctoTreeNode): TEctoTreeNode;
var
NextChildIndex:integer;
begin
result := nil;
NextChildIndex := Children.IndexOf(TargetChildNode)+1;
if (NextChildIndex<Children.Count) and (NextChildIndex>0)
then result := TEctoTreeNode(Children[NextChildIndex]);
end;
function TEctoTreeNode.GetNextSibling: TEctoTreeNode;
begin
if IsRoot then result := nil
else result := FParentNode.GetNextChild(Self);
end;
{ GetPrev возвращает предыдущий узел по ходу рекурсивного обхода дерева }
function TEctoTreeNode.GetPrev: TEctoTreeNode;
var
Node: TEctoTreeNode;
begin
result := nil;
if IsRoot then
exit;
result := GetPrevSibling(); // получаем предыдущий сестринский узел
if result=nil then
result := FParentNode // если его нет, значит наш узел первый, значит предыдущим будет его родитель
else
begin // а если есть...
Node := result.LastDescendant; // получаем последнего потомка
if Node<>nil then result := Node; // если такой существует (если вообще есть потомки) то он и будет
предыдущим. Если же не существует, то result остается со значением полученным в строке result := GetPrevSibling();
end
end;
{ функция GetPrevChild возвращает предыдущий дочерний узел отсчитывая от
заданного дочернего узла. Если заданный узел является первым дочерним
узлом, функция возвращает nil }
function TEctoTreeNode.GetPrevChild(TargetChildNode: TEctoTreeNode): TEctoTreeNode;
var
PrevChildIndex:integer;
begin
result := nil;
PrevChildIndex := Children.IndexOf(TargetChildNode)-1;
if PrevChildIndex>-1 then result := TEctoTreeNode(Children[PrevChildIndex]);
end;
function TEctoTreeNode.GetPrevSibling: TEctoTreeNode;
begin
if IsRoot then result := nil
else result := FParentNode.GetPrevChild(Self);
end;
{ функция IsParentOf возвращает true если узел является предком заданного
в независимости от их уровня }
function TEctoTreeNode.IsParentOf(Node: TEctoTreeNode): boolean;
var
TempNode : TEctoTreeNode;
begin
result := false;
TempNode := Node.FParentNode;
while TempNode<>nil do
begin
if TempNode = self then
begin
result := true;
exit;
end;
TempNode := TempNode.FParentNode;
end;
end;
function TEctoTreeNode.IsRoot: boolean;
begin
result := (Self=ParentTree.Root);
end;
{ процедура MoveDown перемещает узел вниз. Перемещение возможно только в
пределах сестринских узлов, если узел является последним в списке детей
текущего родителя, то перемещение невозможно }
procedure TEctoTreeNode.MoveDown;
var
Temp: Pointer;
ChildIndex: integer;
begin
if IsRoot then exit;
if NextSibling<>nil then
begin
ChildIndex := Index; // временная переменная ChildIndex нужна т.к. Index - расчетное свойство,
незачем лишние вызовы. Кроме того после первого оператора индекс теряется
Temp := ParentNode.Children[ChildIndex];
ParentNode.Children[ChildIndex] := ParentNode.Children[ChildIndex+1];
ParentNode.Children[ChildIndex+1] := Temp;
end;
end;
{ процедура MoveLeft перемещает узел влево. Перемещение идет по принципу:
новым родителем становится родитель родителя, а узел вставляется в список
дочерних узлов родителя родителя таким образом, чтобы оказаться сразу после
текущего родителя (текущий родитель после перемещения становится предыдущим
сестринским узлом) }
procedure TEctoTreeNode.MoveLeft;
begin
if (ParentNode.IsRoot) or (IsRoot) then exit;
ParentNode.ParentNode.Children.Insert(ParentNode.Index+1,self);
ParentNode.Children.Delete(ParentNode.Children.IndexOf(self));
FParentNode := ParentNode.ParentNode; // FParentNode используем вместо ParentNode потому что нам не нужен вызов
всей процедуры присваивания родителя, мы всю работу делаем здесь сами и она специфична.
end;
{ процедура MoveRight перемещает узел вправо. Перемещение идет по принципу:
новым родителем становится предыдущий сестринский узел. Если предыдущего
сестринского узла нет, перемещение считается невозможным }
procedure TEctoTreeNode.MoveRight;
begin
if (IsRoot) or (PrevSibling=nil) then exit; // Если нет сестринского узла перед этим, то невозможно движение вправо
ParentNode := PrevSibling; // Здесь вызов процедуры присваивания родителя.
end;
{ процедура MoveUp перемещает узел вверх. Перемещение идет по принципу:
если у узла есть сестринские узлы выше него, то узел просто встает выше
предыдущего сестринского узла. Если же сестринских узлов выше нет (узел первый
дочерний у родителя), то узел становится выше родительского, т.е. в конец
дочерних узлов предыдущего сестринского узла родителя. }
procedure TEctoTreeNode.MoveUp;
var
Temp: Pointer;
ChildIndex: integer;
begin
if IsRoot then exit;
if PrevSibling<>nil then
begin
ChildIndex := Index; // временная переменная ChildIndex нужна т.к. Index - расчетное свойство,
незачем лишние вызовы. Кроме того после первого оператора индекс теряется
Temp := ParentNode.Children[ChildIndex];
ParentNode.Children[ChildIndex] := ParentNode.Children[ChildIndex-1];
ParentNode.Children[ChildIndex-1] := Temp;
end
else
begin
if not ParentNode.IsRoot then
begin
ParentNode := ParentNode.ParentNode; // Это присваивание автоматически добавит узел в конец, последним дочерним.
MoveUp;
end;
end;
end;
{ установка нового родителя функцией SetParent фактически означает перенос
ветви дерева в другую ветвь }
procedure TEctoTreeNode.SetParent(NewParentNode: TEctoTreeNode);
begin
if (NewParentNode=nil) or (NewParentNode=self) then exit;
ParentNode.Children.Delete(ParentNode.Children.IndexOf(self));
NewParentNode.Children.Add(self);
self.FParentNode := NewParentNode;
end;
procedure TEctoTreeNode.Sort(Compare: TListSortCompare; SortSubtrees: boolean);
var
i,j,CompareResult: integer;
Temp : Pointer;
begin
j:=0;
while j<Children.Count do
begin
i:=Children.Count-1;
while i>j do
begin
if i>j then
begin
CompareResult := Compare(Children[i],Children[i-1]);
if CompareResult>0 then
begin
Temp := Children[i-1];
Children[i-1] := Children[i];
Children[i] := Temp;
end;
end;
dec(i);
end;
if SortSubtrees then
TEctoTreeNode(Children[j]).Sort(Compare,true);
inc(j);
end;
end;
end.
Взято из https://forum.sources.ru