Хорошо вот текстовый файл и оновленный вариант программы.
Код
program laba11;
Uses CRT;
type
DTree = record
Data: integer;
Name: string;
stat: String;
end;
PTree = ^TTree;
TTree = record
head : DTree;
left,right: PTree;
end;
var
fin:text;
temp:PTree;
root:PTree;
ch: char;
Procedure Trash(var ch:char);
begin
if (ch =#13) or (ch =#10) or (ch =' ') or (ch =#0) then
begin
read(fin,ch);
Trash(ch);
end;
end;
Procedure ReadStat(var fin: text; ch : char; var str: string);
begin
str:='';
read(fin, ch);
Trash(ch);
str:=str+ch;
repeat
read(fin, ch);
if not (ch = ' ') and not (ch=';') then
str:=str+ch;
until (ch=' ') or eoln(fin) or (ch=';');
end;
Procedure ReadFile(var fin: text; ch : char; var str: string);
begin
str:='';
repeat
read(fin, ch);
if not (ch = ' ') and not (ch=';') then
str:=str+ch;
until (ch=' ') or eoln(fin) or (ch=';');
end;
Procedure CreateNode(temp : PTree;var root:PTree);
Begin
new(root);
root^.head.stat := temp^.head.stat;
root^.head.name := temp^.head.name;
root^.head.data := temp^.head.data;
root^.left := nil;
root^.right := nil;
End;
Procedure AddItem(Var root: PTree; temp: PTree);
{ Функция, создающая новый лист дерева с заданным значением Data }
var
parent, pwalk: PTree;
Begin
if root = nil then CreateNode(temp,root)
else
begin
pWalk := root; { "гулять" начнем с корня }
while pWalk <> nil do begin { пока не добрались до пустого указателя - делаем следующее }
parent := pWalk;
if pWalk^.head.stat='male' then pWalk := pWalk^.left
else pWalk := pWalk^.right
end;
if temp^.head.stat='male' then CreateNode(temp,root^.left)
else CreateNode(temp,root^.right);
end;
End;
Procedure CreateTree(var root: PTree;var fin : text);
var
temp : PTree;
begin
new(temp);
while not eof(fin) do
begin
readstat(fin,ch,temp^.head.stat);
readfile(fin,ch,temp^.head.name);
read(fin,temp^.head.data);
AddItem(root,temp);
end;
end;
procedure printKLP(root:PTree);
begin
if (root<>NIL) then (* Если дерево не пустое *)
begin
write(root^.head.name,' '); (* Распечатать корень дерево *)
printKLP(root^.left); (* Распечатать левое поддерево *)
printKLP(root^.right);(* Распечатать правое поддерево *)
end;
end;
procedure printKLP_wrapper(root:PTree);
begin
clrscr;
if (root=NIL) then (* Если дерево пустое *)
writeln('Дерево пусто!') (* Сообщить об этом *)
else (* Иначе *)
PrintKLP(root); (* Распечатать дерево *)
writeln;
writeln('Нажмите любую клавишу для выхода в главное меню');
end;
begin
clrscr;
chdir('C:\TPascal');
assign(fin,'test.txt');
reset(fin);
CreateTree(root,fin);
printKLP_wrapper(root);
close(fin);
readkey;
end.