Вывод дерева на экран

uses crt,GraphABC;
type
PNode=^Node;  {Указатель на узел}
 Node=record  {Тип запись в котором будет храниться информация}
 data:1..31;
 name: shortstring;
 left,right:PNode; {Ссылки на левого и правого сыновей}
end;
 
 const
  Fn = 'tree.txt';
var
 Tree,p1:PNode; {Tree адрес корня дерева, p1-вспомогательная переменная}
 n,data:integer;
 name: shortstring;
 c:char; {для работы менюшки}
 FileName: string;
{Процедура добавления элемента }
procedure AddToTree (var Tree:PNode;data:integer;name: shortstring); {Входные параметры - адрес корня дерева и добавл элемент }
begin
 ClearWindow;
 if Tree=nil then  {Если дерево пустое то создаём его корень}
 begin
  New(Tree);   {Выделяем память }
  Tree^.data:=data;     {Добавляем данные }
  Tree^.name:=name;
  Tree^.left:=nil;     {Зануляем указатели на левого }
  Tree^.right:=nil;  {и правого сыновей }
  exit;
 end;
 if data < Tree^.data then   {Доб к левому или правому поддереву это завсит от вводимого элемента}
     AddToTree(Tree^.left,data,name)  {если меньше корня то в левое поддерево }
  else
    AddToTree(Tree^.right,data,name);  {если больше то в правое}
end;
 
 
 
{Процедура удаления дерева}
procedure DeleteTree(var Tree1:PNode );
begin
 if Tree1 <> nil then
 begin
  DeleteTree (Tree1^.LEFT);
  DeleteTree (Tree1^.RIGHT);
  Dispose(Tree1);
 end;
end;
 
procedure Create();
var i:integer;
begin
 write('Количество ');
 readln(n);
 for i:=1 to n do
 begin
  write('Введите имя: ');
  readln(name);
  write('Введите дату: ');
  readln(data);
  AddToTree(Tree,data,name);
  end;
end;
 
 
procedure NodeSave(var Tree : PNode; var aF : TextFile);
begin
  if Tree = nil then
    Write(aF)
  else
  begin
    Writeln(aF,Tree^.name);
    Writeln(aF,Tree^.data);
    NodeSave(Tree^.left, aF);
    NodeSave(Tree^.right, aF);
  end;
end;
procedure TreeSave(var Tree:PNode; const aFileName : String);
var
  F : TextFile;
begin
 ClearWindow;
  AssignFile(F, aFileName);
  Rewrite(F);
  try
    NodeSave(Tree, F);
  finally
    CloseFile(F);
  end;
end;
 
//Рекурсивная процедура для освобождения памяти, занятой деревом. (Удаление дерева).
procedure TreeFree(var Tree : PNode);
begin
  if Tree = nil then
    Exit;
  TreeFree(Tree^.left); {Рекурсивный вызов для освобождения памяти в левой ветви.}
  TreeFree(Tree^.right); {Рекурсивный вызов для освобождения памяти в правой ветви.}
  Dispose(Tree); {Освобождение памяти, занятой для текущего узла.}
  Tree := nil; {Обнуление указателя на текущий узел.}
end;
//Рекурсивная процедура загрузки дерева из файла. С обходом в прямом направлении слева - направо.
procedure NodeLoad(var Tree : PNode; var aF : TextFile);
var
data:integer;
  S : String;
  Code : Integer;
   name: shortstring;
  
   
begin
 //Tree := nil;
  if Eof(aF) then   //Если обнаружен конец файла - значит, обнаружен конец ветви./
    Exit;
 
    Readln(aF, S);
  name:=s;
    Readln(aF, S);
  Val(S, data, Code);
   
  if Code <> 0  then //Если прочитанные данные НЕ являются числом - значит, обнаружен конец ветви.
    Exit;
  //AddToTree(Tree,data,name);
  New(Tree);
  Tree^.data := data;
  Tree^.name:=name;
 
  NodeLoad(Tree^.left, aF);
  NodeLoad(Tree^.right, aF);
   
end;
 
//Процедура для загрузка дерева из файла. С обходом в прямом направлении слева - направо.
procedure TreeLoad(var Tree : PNode; const aFileName : String);
var
  F : TextFile;
begin
 ClearWindow;
  TreeFree(Tree);
  AssignFile(F, aFileName);
  Reset(F);
  try
    NodeLoad(Tree, F);
  finally
    CloseFile(F);
  end;
end;
 
{Функция поиска по дереву}
function Search(Tree:PNode;x:integer):PNode; {Возвращает адрес искомого элемента, nil если не найден}
var
p:PNode;   {вспомог переменнная }
begin
 ClearWindow;
  if Tree=nil then   {если дерево пустое то}
     begin
       Search:=nil;  {присваеваем функции результат нил}
       exit; {и выходим }
     end;
  if x=Tree^.data then  {если искомый элемент равен корню дерева то }
    p:=Tree  {Пзапоминаем его адрес }
     else   {иначе}
       if x < Tree^.data then {если вводимый элемент менньше корня то }
          p:=Search(Tree^.left,data) {то ищем его в левом поддереве}
       else     {иначе }
         p:=Search(Tree^.right,data);  {ищем в правом поддереве }
  Search:=p; {присваеваем переменной с именем функции результат работы}
end;
 
 
{Обход дерева по принципу Левый-корень-правый }
procedure Lkp(Tree:PNode);
 
begin
 
 
  if Tree=nil then  {Если дерево пустое }
   exit;      {то выход }
  Lkp(Tree^.left);  {иначе начинаем обход с левого подднрева}
 
 
  Writeln('Имя: ',Tree^.name);
  Writeln('Дата: ', Tree^.data);
  writeln;  {выводим данные }
 
  Lkp(Tree^.right);  {обходим правое поддерево}
 
end;
 
procedure Print();
 
begin
 ClearWindow;
ClrScr;
 writeln;
  writeln('Генеалогическое дерево');
 Lkp(Tree);
 writeln;
end;
 
procedure Find();
begin
 ClearWindow;
 write('Введите дату: ');
 readln(data);
 p1:=Search(Tree,data);
 if p1 <> nil then writeln('Найден')
 else writeln('Такого элемента нет!');
end;
 
begin {основная пограмма}
Tree := nil; //Начальная инициализация дерева.
  FileName := ExtractFilePath(ParamStr(0)) + Fn; //Полный путь к файлу.
 
 
 SetWindowCaption('Генеалогическое дерево');
 
 repeat {цикл для нашего меню}
 
  writeln(' Генеалогическое дерево:');
  writeln('[c] добавление'); 
  writeln('[f] поиск'); 
  writeln('[p] печать');
  writeln('[z] запись в файл');
  writeln('[g] загрузка из файла');
  writeln('--------------------------'); 
  writeln('[q] выход'); 
  c := ReadKey; 
  case c of 
   'c': Create;
   'f': Find;
   'p': Print;
   'z': begin
        TreeSave(Tree, FileName);
        Write('Дерево сохранено в файл: "', Fn, '".');
      end;
      'g': begin
        TreeLoad(Tree, FileName);
        Write('Дерево загружено из файла: "', Fn, '".');
      end;
  end; 
 until c = 'q'; 
  //DeleteTree(Tree);
end.