Невизуальное дерево
Материал из DRKB
Невизуальное дерево[править | править код]
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
// обращение к ParentNode без проверки на его существование обусловлено тем,
// что раз это не Root, значит у него обязательно есть Parent
DeletingNode.FParentNode.Children.Delete
(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 для их проверки }
i := 0;
while i < TargetNode.Children.Count do
begin
FindNode_(TEctoTreeNode(TargetNode.Children.Items[i]));
Inc(i);
end;
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 }
i := 0;
while i < Node.Children.Count do
begin
CompareNodeIndex(TEctoTreeNode(Node.Children[i]));
Inc(i);
end;
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;
// если такой существует (если вообще есть потомки) то он и будет предыдущим.
// Если же не существует, то result остается со значением полученным в строке result := GetPrevSibling();
if Node <> nil then Result := Node;
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 потому что нам не нужен вызов
// всей процедуры присваивания родителя, мы всю работу делаем здесь сами и она специфична.
FParentNode := ParentNode.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.
Source: Взято из http://forum.sources.ru
ID: 00640