Программа
program Lab_2_Tree_3;
Uses Crt,Dos;
Type ObjS=^Obj;
Obj=record
Name:string[5];
NalM:boolean;
L,R:ObjS
end;
Var SKoren,SVspom:ObjS;
Ex:boolean;
function St2(St:byte):integer;
Var J:integer;
I:byte;
Begin
J:=1;
for I:=1 to St do J:=J*2;
St2:=J
End;
procedure Menu(S:ObjS);
Var I:byte;
Begin
for I:=12 to 18 do begin GotoXY(52,I); write(' ') end;
if S=nil then begin GotoXY(52,12); write('1.Добавление') end;
GotoXY(52,13); write('2.Удаление');
if S<>nil then begin GotoXY(52,14); write('3.Изменение имени') end;
if S<>nil then begin GotoXY(52,15); write('4.Просмотр предков') end;
GotoXY(52,16); write('5.Сохранение');
if S=nil then begin GotoXY(52,17); write('6.Считывание') end;
GotoXY(52,18); write('8.Выход');
End;
procedure Writ(STV:ObjS);
Begin
if STV=nil then begin
GotoXY(62,3); write(' nil ');
GotoXY(58,6); write(' ');
GotoXY(66,6); write(' ');
end
else begin
GotoXY(62,3); write(STV^.Name);
GotoXY(58,6);
if STV^.L<>nil then write(STV^.L^.Name)
else write(' nil ');
GotoXY(66,6);
if STV^.R<>nil then write(STV^.R^.Name)
else write(' nil ');
end;
End;
function ReaderNameF:string;
Var K:char;
Name:string;
Begin
ReaderNameF:='b1';
Name:='';
repeat
K:=ReadKey;
if K in ['A'..'Z','a'..'z','0'..'9','/',':'] then
begin
Name:=Name+K;
write(K)
end
until Ord(K)=13;
ReaderNameF:=Name
End;
procedure DisposeRTree(Var S:ObjS);
Begin
if S<>nil then begin
DisposeRTree(S^.L);
DisposeRTree(S^.R);
Dispose(S);
S:=nil
end
End;
procedure Add(Var S:ObjS);
var i:byte;
Begin
if S=nil then
begin
new(S); S^.L:=nil; S^.R:=nil;
GotoXY(52,22);
write(' ?: имя ');
GotoXY(60,22);
{ глюк }
I:=0;
S^.Name:='';
while I<5 do
begin { глюк кончился }
S^.Name:=S^.Name+Readkey;
I:=I+1;
GotoXY(62,3);
write(S^.Name)
end;
GotoXY(52,22); write(' ');
Writ(S)
end
End;
procedure ChangeName(S:ObjS);
var I:byte;
Begin
GotoXY(52,22);
write(' ?: новое имя ');
GotoXY(60,22);
{ глюк }
I:=0;
S^.Name:='';
while I<5 do
begin { глюк кончился }
S^.Name:=S^.Name+Readkey;
I:=I+1;
GotoXY(62,3);
write(S^.Name)
end;
GotoXY(52,22); write(' ');
Writ(S)
End;
procedure ReviewAncestors(S:ObjS);
var L,LG,K,I,J:byte; { L:тек.; LG:треб. }
LGC:char;
procedure RAW(S:ObjS;LG:byte);
begin
if S=nil
then K:=K+St2(LG-1)
else begin
if LG=1
then begin
GotoXY(K div 25*12+1,K mod 25+1);
if S^.L<>nil then write(S^.L^.Name);
GotoXY(K div 25*12+7,K mod 25+1);
if S^.R<>nil then write (S^.R^.Name);
K:=K+1
end
else begin
RAW(S^.L,LG-1);
RAW(S^.R,LG-1)
end
end
end;
Begin
L:=0;
GotoXY(52,22); write('Введите # уровня ');
repeat
LGC:=ReadKey;
until LGC in ['1'..'9'];
LG:=Ord(LGC)-48;
GotoXY(52,22);
write(' ');
for I:=1 to 48 do
for J:=1 to 25 do begin GotoXY(I,J); write(Chr(196)) end;
for I:=1 to 7 do
for J:=1 to 25 do begin GotoXY(I*6,J); write(Chr(179)) end;
for I:=1 to 4 do
for J:=1 to 25 do begin GotoXY(I*12,J); write(Chr(186)) end;
K:=0;
if S<>nil then RAW(S,LG)
End;
procedure SaverTree(S:ObjS);
Type SR=record
Name:string[5];
MG,NalM:boolean
end;
Var Buf:SR;
F:file of SR;
NameF:string[29];
I:byte;
procedure ST(S:ObjS;MG:boolean);
begin
if S<>nil then
begin
Buf.Name:=S^.Name;
Buf.MG:=MG;
Buf.NalM:=S^.R<>nil;
write(F,Buf);
ST(S^.L,true);
ST(S^.R,false)
end
end;
Begin
GotoXY(52,21); write('?: Имя файла ');
GotoXY(52,23);
NameF:=ReaderNameF;
Assign(F,NameF);
{$I-} Rewrite(F) {$I+} ;
if IOresult=0
then begin
ST(S,true);
Close(F)
end
else begin
GotoXY(52,25);
write('Неверное имя файла');
while not KeyPressed do
end;
for I:=0 to 2 do begin GotoXY(52,21+I*2);
write(' ')
end
End;
procedure ReaderTree(Var S:ObjS);
Type SR=record
Name:string[5];
MG,NalM:boolean
end;
Var Buf,Buf2:SR;
F:file of SR;
NameF:string[29];
I:byte;
procedure RT(Var S:ObjS);
begin
if not eof(F)
then begin
Buf:=Buf2; read(F,Buf2);
new(S); S^.L:=nil; S^.R:=nil;
S^.NalM:=Buf.NalM;
S^.Name:=Buf.Name;
if Buf2.MG then RT(S^.L);
if S^.NalM then RT(S^.R)
end
else begin
if Buf2.MG then begin
new(S);
S^.Name:=Buf2.Name;
S^.R:=nil;
S^.L:=nil
end
else begin
new(S);
S^.Name:=Buf2.Name;
S^.R:=nil;
S^.L:=nil
end;
end;
end;
Begin
GotoXY(52,21); write('?: Имя файла ');
GotoXY(52,23);
NameF:=ReaderNameF;
Assign(F,NameF);
{$I+} Reset(F); {$I-}
if IOresult=0
then begin { Seek(F,0); }
if not eof(F) then begin
read(F,Buf2);
RT(S)
end;
Close(F)
end
else begin
GotoXY(52,25);
write('Фaйл не найден');
while not KeyPressed do
end;
for I:=0 to 2 do begin GotoXY(52,21+I*2);
write(' ')
end
End;
procedure W(Var S:ObjS; Var ExV:boolean);
Var OtvK:byte;
Begin
repeat
Writ(S);
Menu(S);
repeat
OtvK:=Ord(ReadKey);
case OtvK of
72:;
75: if S<>nil then W(S^.L,ExV);
77: if S<>nil then W(S^.R,ExV);
1+48: if S=nil then Add(S);
2+48: DisposeRTree(S);
3+48: if s<>nil then ChangeName(S);
4+48: if s<>nil then ReviewAncestors(S);
5+48: SaverTree(S);
6+48: if S=nil then ReaderTree(S);
8+48,27: ExV:=true;
end
until OtvK in [27,1+48..6+48,8+48,72,75,77]
until ExV or (OtvK=72)
End;
BEGIN
ClrScr;
SKoren:=nil;new(SVspom);
Ex:=false;
repeat
W(SKoren,Ex)
until Ex;
DisposeRTree(SKoren)
END.
Бесплатные примеры программ
Примеры написанных программ
Помощь студентам по программированию