在VCL中包含有一个TList类，几乎可以实现<链表>所有功能，Delphi的工程师真是伟大。但是在实际应用中需要TTree类，来实现<树>的功能，我写了两个类TyuTree，TYuNode。可以方便实现，树创建，结点增删、移动功能。请大家指教。
代码实例：
Var
YuTree: TyuTree;
Node: TYuNode;
Begin
//第1步：创建树、增加第一个结点0
YuTree := TYuTree.Create;
Node := YuTree.Add(nil);//nil,表示增加根结点
Node.Data := Pointer(0);
//第2步：在结点0下增加子结点1
Node := YuTree.AddChild(Node);Node指向结点0
Node.Data := Pointer(1);
//第3步：在结点1下增加子结点2
Node := YuTree.AddChild(Node);
Node.Data := Pointer(2);
//第4步：切换到结点2的父结点1
Node := Node.GetParent;
//第5步：在结点1下增加子结点3，并作为第1个子结点
Node := YuTree.AddChildFirst(Node);
Node.Data := Pointer(3);
//第6步：切换到结点3的父结点1
Node := Node.GetParent;
//第7步：增加结点1下子结点4，作为最后一个子结点
Node := YuTree.AddChild (Node);
Node.Data := Pointer(4);
//第8步：增加结点4的兄弟结点5，作为第一个兄弟结点
Node := YuTree.AddFirst(Node);
Node.Data := Pointer(5);
//t第9步：切换到结点5的下一个兄弟结点3
Node := Node.GetNextBrother;
//第10步：在结点3下插入一个兄弟结点6
Node := YuTree.Add(Node);
Node.Data := Pointer(6 );
//第11步：删除结点6
Node.Delete; //或YuTree.Delete(Node);
//其它用法
//结点2.GetNextBrother() = 结点4 返回该结点的下一个兄弟
//结点2.GetPrevBrother() = 结点3 返回该结点的上一个兄弟
//结点1.GetFirstChild() = 结点5; 返回该结点的第一个子结点
//结点1.GetLastChild() = 结点4 返回该结点的最后一个子结点
//结点1.GetNext = 结点5
//结点1.GetPrev = 结点0
//结点2.GetFirstBrother() = 结点5 返回该结点的第一个兄弟
//结点2.GetLastBrother() = 结点4 返回该结点最后一个兄弟
//YuTree.FirstNode = 结点0
//YuTree.Clear(); 清空所有结点
End;
说明：该在程序中是以二叉树来表示的，FDownLeft，FDownRight分别表示二叉树的左指针、右指针。
原代码如下：
//――――――开始―――――――――――――――――――――――――――－
unit uYuTree;
interface
type
TYuNodeAttachMode = (ynaAdd, ynaAddFirst, ynaAddChild, ynaAddChildFirst, ynaInsert);
TYuTree = class;
TYuNode = class(TObject)
private
//Self.Tree中除Root外, FUpLeft, FUpRight有且只有一个为空
FUpLeft: TYuNode; //Self.FUpLeft.FDownLeft = Self （该指针指向的结点是该结点的父结点）
FUpRight: TYuNode; //Self.FUpRight.FDownRight = Self （该指针指向的结点是该结点的上一个兄弟）
FDownLeft: TYuNode; //二叉树的左指针，表树的子结点
FDownRight: TYuNode; //二叉树的右指针，表示树的下一个兄弟
FOwner: TYuTree;
//结点的状态信息
FDeleting: Boolean;
FIsRootOfDeleted: Boolean;
function GetLevel(): Integer;
function GetParent(): TYuNode;
procedure CutFromTree();
protected
constructor Create(AOwner: TYuTree);
public
//Property Data: Pointer read FData write FData;
Data: Pointer;
//以下四个函数是基础函数,不调用其它函数，独立完成指定功能
function GetNextBrother(): TYuNode;
function GetPrevBrother(): TYuNode;
function GetFirstChild(): TYuNode;
function GetLastChild(): TYuNode;
function GetNext: TYuNode;
function GetPrev: TYuNode;
function GetFirstBrother(): TYuNode;
function GetLastBrother(): TYuNode;
procedure MoveTo(Destination: TYuNode; Mode: TYuNodeAttachMode);
procedure Delete();
property Level: Integer read GetLevel;
property Parent: TYuNode read GetParent;
destructor Destroy();override;
end;
TYuTree = class(TObject)
private
FFirstNode: TYuNode;
public
function Add(Brother: TYuNode):TYuNode;
function AddFirst(Brother: TYuNode):TYuNode;
function AddChild(Parent: TYuNode):TYuNode;
function AddChildFirst(Parent: TYuNode):TYuNode;
function Insert(Brother: TYuNode):TYuNode;
procedure Clear();
procedure Delete(Node: TYuNode);
property FirstNode: TYuNode read FFirstNode;
constructor Create();
destructor Destroy();override;
end;
implementation
uses SysUtils, Math;
{ TYuNode }
constructor TYuNode.Create(AOwner: TYuTree);
begin
if not Assigned(AOwner) then
raise Exception.Create('AOwner is nil In TYuNode.Create');
FOwner := AOwner;
FUpLeft := nil;
FUpRight := nil;
FDownLeft := nil;
FDownRight := nil;
FDeleting := False;
FIsRootOfDeleted := False;
end;
destructor TYuNode.Destroy;
var
SubNode, WillDeleteNode: TYuNode;
begin
FDeleting := True;
if FIsRootOfDeleted then //维护指针
CutFromTree;
SubNode := GetFirstChild;
while SubNode <> nil do
begin
WillDeleteNode := SubNode;
SubNode := SubNode.GetNextBrother;
WillDeleteNode.Free;
end;
inherited;
end;
function TYuNode.GetFirstChild: TYuNode;
begin
Result := FDownLeft;
end;
function TYuNode.GetFirstBrother: TYuNode;
begin
Result := Self;
while Result.GetPrevBrother <> nil do
Result := Result.GetPrevBrother;
end;
function TYuNode.GetLastBrother: TYuNode;
begin
Result := Self;
while Result.GetNextBrother <> nil do
Result := Result.GetNextBrother;
end;
function TYuNode.GetLastChild: TYuNode;
begin
Result := FDownLeft;
if Result = nil then Exit;
while Result.FDownRight <> nil do
Result := Result.FDownRight;
end;
function TYuNode.GetLevel: Integer;
var
Node: TYuNode;
begin
Node := Self;
Result := -1;
repeat
Node := Node.Parent;
Inc(Result);
until Node = nil;
end;
function TYuNode.GetNext: TYuNode;
var
Node: TYuNode;
begin
//1.查看第一个子结点
Result := GetFirstChild;
//2.如果第1步不成功，查看下一个兄弟
if Result = nil then
Result := GetNextBrother;
//3.如果第2步不成功，查看父结点的下一个兄弟
//退出条件，成功找到(Result <> nil) 或 直到根结点仍没有找到(Node = nil)
Node := Self.Parent;
while (Result = nil) and (Node <> nil) do
begin
Result := Node.GetNextBrother;
Node := Node.Parent;
end;
end;
function TYuNode.GetNextBrother: TYuNode;
begin
Result := FDownRight;
end;
function TYuNode.GetParent: TYuNode;
begin
Result := GetFirstBrother.FUpLeft;
end;
function TYuNode.GetPrev: TYuNode;
var
Node: TYuNode;
begin
//1.得到上一个兄弟
Node := GetPrevBrother;
//如果没有上一个兄弟，返回父结点
if Node = nil then
begin
Result := Self.Parent;
Exit;
end;
//否则，返回PrevBrother.GetLastChild.GetLastChild.........
Result := Node;
while Node <> nil do
begin
Result := Node;
Node := Node.GetLastChild;
end;
end;
function TYuNode.GetPrevBrother: TYuNode;
begin
Result := FUpRight;
end;
procedure TYuNode.MoveTo(Destination: TYuNode; Mode: TYuNodeAttachMode);
var
DestParent, AddNode: TYuNode;
begin
if Destination = nil then
begin
Delete;
Exit;
end;
if Destination.FOwner <> FOwner then
raise Exception.CreateFmt('YuNode[@%d] Move To Another Tree In TYuNode.MoveTo', [Integer(@Self)]);
DestParent := Destination.Parent;
while DestParent <> nil do
begin
if DestParent = Self then
raise Exception.CreateFmt('Destination Is YuNode[@%d]''s SubNode In TYuNode.MoveTo', [Integer(@Self)]);
DestParent := DestParent.Parent;
end;
CutFromTree;
case Mode of
ynaAdd: AddNode := FOwner.Add(Destination);
ynaAddFirst: AddNode := FOwner.AddFirst(Destination);
ynaAddChild: AddNode := FOwner.AddChild(Destination);
ynaAddChildFirst: AddNode := FOwner.AddChildFirst(Destination);
ynaInsert: AddNode := FOwner.Insert(Destination);
end;
FUpLeft := AddNode.FUpLeft;
FUpRight := AddNode.FUpRight;
FDownRight := AddNode.FDownRight;
if FUpLeft <> nil then FUpLeft.FDownLeft := Self;
if FUpRight <> nil then FUpRight.FDownRight := Self;
if FDownRight <> nil then FDownRight.FUpRight := Self;
AddNode.Free;
end;
procedure TYuNode.Delete;
begin
if not FDeleting then
begin
FIsRootOfDeleted := True;
Free;
end;
end;
procedure TYuNode.CutFromTree;
begin
if Self = FOwner.FFirstNode then
begin
FOwner.FFirstNode := GetNextBrother;
if FOwner.FFirstNode <> nil then
FOwner.FFirstNode.FUpRight := nil;
Exit;
end;
if FDownRight <> nil then //有下一个兄弟
if FUpRight <> nil then //有上一个兄弟
begin
FUpRight.FDownRight := FDownRight;
FDownRight.FUpRight := FUpRight;
end
else //直接指向父结点
begin
FUpLeft.FDownLeft := FDownRight;
FDownRight.FUpRight := nil;
FDownRight.FUpLeft := FUpLeft;
end
else
if FUpRight <> nil then //有上一个兄弟
FUpRight.FDownRight := nil
else //直接指向父结点
FUpLeft.FDownLeft := nil;
end;
{ TYuTree }
function TYuTree.Add(Brother: TYuNode): TYuNode;
var
Node: TYuNode;
begin
if Brother = nil then
if FFirstNode = nil then
begin
Result := TYuNode.Create(Self);
FFirstNode := Result;
Exit;
end
else
Brother := FFirstNode;
Node := Brother.GetLastBrother;
Result := TYuNode.Create(Self);
Node.FDownRight := Result;
Result.FUpRight := Node;
end;
function TYuTree.AddChild(Parent: TYuNode): TYuNode;
var
Node: TYuNode;
begin
if Parent = nil then
begin
Result := Add(nil);
Exit;
end;
Node := Parent.GetLastChild;
Result := TYuNode.Create(Self);
if Node = nil then
begin
Parent.FDownLeft := Result;
Result.FUpLeft := Parent;
end
else
begin
Node.FDownRight := Result;
Result.FUpRight := Node;
end;
end;
function TYuTree.AddChildFirst(Parent: TYuNode): TYuNode;
var
Node: TYuNode;
begin
if Parent = nil then
begin
Result := Add(nil);
Exit;
end;
Node := Parent.GetFirstChild;
Result := TYuNode.Create(Self);
if Node <> nil then
begin
Node.FUpLeft := nil;
Node.FUpRight := Result;
end;
Result.FUpLeft := Parent;
Result.FDownRight := Node;
Parent.FDownLeft := Result;
end;
function TYuTree.AddFirst(Brother: TYuNode): TYuNode;
var
Node, Parent: TYuNode;
begin
if Brother = nil then
begin
Result := Add(nil);
Exit;
end;
Node := Brother.GetFirstBrother;
Parent := Node.Parent;
Result := TYuNode.Create(Self);
Node.FUpLeft := nil;
Node.FUpRight := Result;
Result.FUpLeft := Parent;
Result.FDownRight := Node;
if Parent <> nil then
Parent.FDownLeft := Result
else
FFirstNode := Result;
end;
procedure TYuTree.Clear;
begin
while FFirstNode <> nil do
FFirstNode.Delete;
end;
constructor TYuTree.Create;
begin
FFirstNode := nil;
end;
procedure TYuTree.Delete(Node: TYuNode);
begin
Node.Delete;
end;
destructor TYuTree.Destroy;
begin
Clear;
inherited;
end;
function TYuTree.Insert(Brother: TYuNode): TYuNode;
var
Prev, Next: TYuNode;
begin
if Brother = nil then
begin
Result := Add(nil);
Exit;
end;
if Brother.GetNextBrother = nil then
Result := Add(Brother)
else
begin
Prev := Brother;
Next := Brother.GetNextBrother;
Result := TYuNode.Create(Self);
Prev.FDownRight := Result;
Next.FUpRight := Result;
Result.FUpRight := Prev;
Result.FDownRight := Next;
end;
end;
end.
//――――――结束―――――――――――――――――――――――――――－
