Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
Разработка программного обеспечения
KANSoftWare

Не визуальное дерево

Delphi , Программа и Интерфейс , TListView

Не визуальное дерево

Code:

Unit EctoSoftTree;
 
{===============================================================================
Класс TEctoSoftTree представляет собой невизуальное дерево для манипулирования
древоподобными структурами в памяти. Мной в очередной раз из любви к искусству
был изобретен велосипед :))), который тем не менее получился вполне съедобным
и несмотря на наличие других вариантов решения задачи будет использоваться мной
хотя бы назло врагам :) Буду рад если еще кому-то он придется по вкусу.
 
Просьба при внесении изменений и дополнений в код, а также обнаружении ошибок
(которых здесь нет ;) уведомить автора, т.е. меня
 
Малышев Владимир aka "мыш"
feedback@ectosoft.com
http://www.EctoSoft.com
================================================================================}
 
{©Drkb v.3(2007): www.drkb.ru}
 
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.

Автор: Мыш

Взято из http://forum.sources.ru

Статья Не визуальное дерево раздела Программа и Интерфейс TListView может быть полезна для разработчиков на Delphi и FreePascal.


Комментарии и вопросы


Ваше мнение или вопрос к статье в виде простого текста (Tag <a href=... Disabled). Все комментарии модерируются, модератор оставляет за собой право удалить непонравившейся ему комментарий.

заголовок

e-mail

Ваше имя

Сообщение

Введите код




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.



:: Главная :: TListView ::


реклама



©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru Rambler's Top100
19.03.2024 08:46:43/0.032953023910522/0