在VCL中包含有一個TList類，幾乎可以實現<鏈表>所有功能，Delphi的工程師真是偉大。但是在實際應用中需要TTree類，來實現<樹>的功能，我寫了兩個類TyuTree，TYuNode。可以方便實現，樹創建，結點增刪、移動功能。請大家指教。
代碼實例：
Procedure Test();
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.
//――――――結束―――――――――――――――――――――――――――－
