Добавил:
Tushkan
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:Лабораторные работы_2 / LAB11 / LAB11
.PAS program Lab11_Zaharov;
uses crt;
type str=string[13];
ref = ^person;
person = record
FIO : string[13];
father, mother : ref;
end;
var root, root1, p, an : ref;
fin : text;
sername : string;
num : char;
fl,found : boolean;
n : str;
{Џа®жҐ¤га ЇҐаҐў®¤ бва®ЄЁ агббЄЁ© п§лЄ}
procedure Write_Name (St : string);
var
i : byte;
st1,st2:string;
ch:char;
begin
for i:=1 to 13 do
begin
case St[i] of
'A' : write ('Ђ'); 'a' : write (' ');
'B' : write ('Ѓ'); 'b' : write ('Ў');
'V' : write ('‚'); 'v' : write ('ў');
'G' : write ('ѓ'); 'g' : write ('Ј');
'D' : write ('„'); 'd' : write ('¤');
'E' : write ('…'); 'e' : write ('Ґ');
'J' : begin
if st[i+1]='U' then
begin i:=i+1; write ('ћ'); end
else if st[i+1]='A' then
begin i:=i+1; write ('џ'); end
else write ('†');
end;
'j' : begin
if st[i+1]='u' then
begin i:=i+1; write ('о'); end
else if st[i+1]='a' then
begin i:=i+1; write ('п'); end
else write ('¦');
end;
'Z' : write ('‡'); 'z' : write ('§');
'I' : write ('€'); 'i' : write ('Ё');
'K' : write ('Љ'); 'k' : write ('Є');
'L' : write ('‹'); 'l' : write ('«');
'M' : write ('Њ'); 'm' : write ('¬');
'N' : write ('Ќ'); 'n' : write ('');
'O' : write ('Ћ'); 'o' : write ('®');
'P' : write ('Џ'); 'p' : write ('Ї');
'R' : write ('ђ'); 'r' : write ('а');
'S' : begin
if st[i+1]='H' then
begin i:=i+1; write (''); end
else write ('‘');
end;
's' : begin
if st[i+1]='h' then
begin i:=i+1; write ('и'); end
else write ('б');
end;
'T' : write ('’'); 't' : write ('в');
'U' : write ('“'); 'u' : write ('г');
'F' : write ('”'); 'f' : write ('д');
'H' : write ('•'); 'h' : write ('е');
'C' : begin
if st[i+1]='H' then
begin i:=i+1; write ('—'); end
else write ('–');
end;
'c' : begin
if st[i+1]='h' then
begin i:=i+1; write ('з'); end
else write ('ж');
end;
'^' : write ('м');
' ' : write (' ');
else write (st[i]);
end;
end;
writeln;
end;
{Џа®жҐ¤га ўлў®¤ ®¬ «ЁЁ нЄа }
procedure Anomaliya (text1, text2 : string; var p_repeat : boolean);
var p_key : char;
y : integer;
i,k : byte;
begin
clrscr;
if p_repeat=true then k:=4 else k:=2;
textcolor(k);
y:=(82 - 4 - length (text1)) div 2;
gotoxy (y,10); write ('Й'); for i:=1 to length (text1)+2 do write ('Н'); write ('»');
gotoxy (y,11); write ('є '); textcolor (k+240); write (text1); textcolor (k); write (' є');
gotoxy (y,12); write ('И'); for i:=1 to length (text1)+2 do write ('Н'); write ('ј');
if length(text2)<>0
then
begin
textcolor (8);
y:=(82 - 8 - length (text2)) div 2;
gotoxy (y,13); write ('Ъ'); for i:=1 to length (text2)+6 do write ('Д'); write ('ї');
gotoxy (y,14); write ('і ',text2,' і');
gotoxy (y,15); write ('А'); for i:=1 to length (text2)+6 do write ('Д'); write ('Щ');
end;
gotoxy(1,1);
if p_repeat=true then
repeat
sound (800); delay (40000);
nosound; delay (50000);
until keypressed
else repeat until keypressed;
k:=1; p_repeat:=true;
gotoxy (60,20); textcolor (blue); write ('ЪДДДДДДДДДДДї');
gotoxy (60,23); textcolor (blue); write ('АДДДДДДДДДДДЩ');
repeat gotoxy (60,21); clreol;
textcolor (15);
textbackground (0);
textcolor (blue); write ('і');
textcolor (15);
if k=1 then textbackground(blue) else textbackground(0);
write (' ЏЋ‚’Ћђ€’њ ');
textbackground (0);
textcolor (blue); write ('і');
textcolor (15);
gotoxy (60,22); clreol;
textcolor (15);
textbackground (0);
textcolor (blue); write ('і');
textcolor(15);
if k=2 then textbackground(blue) else textbackground(0);
write (' ‡Ђ‚…ђ€’њ ');
textbackground (0);
textcolor (blue); write ('і');
textcolor (15);
repeat
p_key:=readkey;
until (p_key=chr(72)) or (p_key=chr(80)) or (p_key=chr(13));
if ((p_key=chr(72)) or (p_key=chr(80))) and (k=1)
then begin k:=2; p_repeat:=false; end
else if ((p_key=chr(72)) or (p_key=chr(80))) and (k=2)
then begin k:=1; p_repeat:=true; end
else
if p_key=chr(13)
then k:=3;
until (k=3);
clrscr;
end;
{”®а¬Ёа®ў ЁҐ ¤ҐаҐў Ё§ д ©« }
procedure PreCreate (var f : text; var root : ref);
var FIOt : string[13];
t : ref;
begin
if not eof(f) then
begin
new(t);
read(f,FIOt);
if FIOt[1]='*'
then
t:=nil
else
with t^ do
begin
FIO:=FIOt;
PreCreate (f,father);
PreCreate (f,mother);
end;
root:=t;
end;
end;
{ЋЎе®¤ ¤ҐаҐў Ё Ї®ЁбЄ ®вўҐв § Їа®б}
procedure PreOrder (t:ref; var sername : string);
var st : string [13];
begin
if t<>nil then
begin
st:=t^.FIO;
delete (st,1,pos(' ',st));
delete (st,pos(' ',st),length(st)-pos(' ',st)+1);
if ('N.'<>st) then
begin
PreOrder(t^.father,sername);
PreOrder(t^.mother,sername);
end
else
begin
sername:=t^.mother^.FIO;
delete (sername,pos(' ',sername),length(sername)-pos(' ',sername)+1);
sername:=sername+' ';
end;
end;
end;
{‚лў®¤ ¤ҐаҐў нЄа }
procedure PrintTree (root:ref; n:integer);
var z:integer;
begin
if root<>nil then
with root^ do
begin
PrintTree (father,n+1);
if (n>1) then
for z:=2 to n do
write(' ');
write_name(FIO);
PrintTree (mother,n+1);
end;
end;
{‘®§¤ ЁҐ Ё¤Ґ «м® бв ЎЁ«Ё§Ёа®ў ®Ј® ¤ҐаҐў }
procedure PreCreate2 (var t:ref; n:integer; var f : text);
var p : ref;
nr,nl : integer;
FIOt : str;
begin
if n=0 then
t:=nil
else
begin
nl:=n div 2;
nr:=n-nl-1;
read (f,FIOt);
new (p);
with p^ do
begin
FIO:=FIOt;
PreCreate2 (father,nl,f);
PreCreate2 (mother,nr,f);
end;
t:=p;
end;
end;
{pechat dereva;
n - kolichestvo simvolov v imeni;
t - adres korna}
procedure print(t:ref;n:integer);
var
i:integer;
begin
if t<>nil then
with t^ do
begin
print(father,n+1);
for i:=1 to n do
write(' ');
writeln(FIO);
print(mother,n+1);
end;
end;
procedure AddElem (var t : ref; var n : str);
begin
if t=nil then
begin
new (t);
with t^ do
begin
FIO:=n;
father:=nil;
end;
end
else
if t^.FIO>n then
AddElem (t^.father,n)
else
AddElem (t^.mother,n);
end;
{Џ®ЁбЄ Ё¬ҐЁ ў ¤ҐаҐўҐ}
procedure Search (t : ref; n : str; var found:boolean);
begin
while (t<>nil) and (not found) do
begin
if t^.FIO=n then
found:=true
else
if t^.FIO>n then
t:=t^.father
else
t:=t^.mother;
search(t,n,found);
end;
end;
{ѓ‹Ђ‚ЂЌЂџ ЏђЋѓђЂЊЊЂ}
begin
repeat
clrscr;
writeln;
writeln (' ‹ Ў®а в®а п а Ў®в # 11');
writeln (' ѓҐҐ «®ЈЁзҐбЄ®Ґ ¤ҐаҐў®.');
writeln;
write ('‚ўҐ¤ЁвҐ ®¬Ґа д ©« (1 Ё«Ё 2) >>> ');
readln (num);
if (num<>'1') and (num<>'2') then
begin
fl:=true;
Anomaliya ('‚Ё¬ ЁҐ! ЋиЁЎЄ !','€бЄ®¬л© д ©« Ґ бгйҐбвўгҐв',fl);
end
else
begin
assign (fin,'E:\LAB11\fin'+num+'.txt');
reset (fin);
PreCreate (fin,an);
writeln;
PrintTree (an,1);
readln;
sername:='';
PreOrder (an,sername);
textcolor (yellow);
writeln ('— бвм I');
textcolor (white);
writeln;
if sername='' then
writeln ('Ќ ¤Ґ¦¤ ў ЈҐҐ «®ЈЁзҐбЄ®¬ ¤ҐаҐўҐ Ґ ©¤Ґ .')
else
begin
write ('” ¬Ё«Ёп ¬ вҐаЁ Ќ ¤Ґ¦¤л - ');
write_name(sername);
end;
readln;
writeln;
textcolor (yellow);
writeln ('— бвм II');
textcolor (white);
writeln;
reset (fin);
PreCreate2 (root1,13,fin);
PrintTree (root1,1);
write ('‚ўҐ¤ЁвҐ ЁбЄ®¬®Ґ Ё¬п: ');
found:=false;
readln (n);
search (root1,n,found);
if found then
writeln ('€бЄ®¬®Ґ Ё¬п ©¤Ґ®.')
else
begin
writeln ('€бЄ®¬®Ґ Ё¬п Ґ ©¤Ґ®.');
AddElem (root1,n);
gotoxy (1,wherey-20);
Print (root1,1);
end;
readln;
Anomaliya ('Џа®Ја ¬¬ ўлЇ®«Ґ гбЇҐи®.','',fl)
end;
until fl=false;
end.
uses crt;
type str=string[13];
ref = ^person;
person = record
FIO : string[13];
father, mother : ref;
end;
var root, root1, p, an : ref;
fin : text;
sername : string;
num : char;
fl,found : boolean;
n : str;
{Џа®жҐ¤га ЇҐаҐў®¤ бва®ЄЁ агббЄЁ© п§лЄ}
procedure Write_Name (St : string);
var
i : byte;
st1,st2:string;
ch:char;
begin
for i:=1 to 13 do
begin
case St[i] of
'A' : write ('Ђ'); 'a' : write (' ');
'B' : write ('Ѓ'); 'b' : write ('Ў');
'V' : write ('‚'); 'v' : write ('ў');
'G' : write ('ѓ'); 'g' : write ('Ј');
'D' : write ('„'); 'd' : write ('¤');
'E' : write ('…'); 'e' : write ('Ґ');
'J' : begin
if st[i+1]='U' then
begin i:=i+1; write ('ћ'); end
else if st[i+1]='A' then
begin i:=i+1; write ('џ'); end
else write ('†');
end;
'j' : begin
if st[i+1]='u' then
begin i:=i+1; write ('о'); end
else if st[i+1]='a' then
begin i:=i+1; write ('п'); end
else write ('¦');
end;
'Z' : write ('‡'); 'z' : write ('§');
'I' : write ('€'); 'i' : write ('Ё');
'K' : write ('Љ'); 'k' : write ('Є');
'L' : write ('‹'); 'l' : write ('«');
'M' : write ('Њ'); 'm' : write ('¬');
'N' : write ('Ќ'); 'n' : write ('');
'O' : write ('Ћ'); 'o' : write ('®');
'P' : write ('Џ'); 'p' : write ('Ї');
'R' : write ('ђ'); 'r' : write ('а');
'S' : begin
if st[i+1]='H' then
begin i:=i+1; write (''); end
else write ('‘');
end;
's' : begin
if st[i+1]='h' then
begin i:=i+1; write ('и'); end
else write ('б');
end;
'T' : write ('’'); 't' : write ('в');
'U' : write ('“'); 'u' : write ('г');
'F' : write ('”'); 'f' : write ('д');
'H' : write ('•'); 'h' : write ('е');
'C' : begin
if st[i+1]='H' then
begin i:=i+1; write ('—'); end
else write ('–');
end;
'c' : begin
if st[i+1]='h' then
begin i:=i+1; write ('з'); end
else write ('ж');
end;
'^' : write ('м');
' ' : write (' ');
else write (st[i]);
end;
end;
writeln;
end;
{Џа®жҐ¤га ўлў®¤ ®¬ «ЁЁ нЄа }
procedure Anomaliya (text1, text2 : string; var p_repeat : boolean);
var p_key : char;
y : integer;
i,k : byte;
begin
clrscr;
if p_repeat=true then k:=4 else k:=2;
textcolor(k);
y:=(82 - 4 - length (text1)) div 2;
gotoxy (y,10); write ('Й'); for i:=1 to length (text1)+2 do write ('Н'); write ('»');
gotoxy (y,11); write ('є '); textcolor (k+240); write (text1); textcolor (k); write (' є');
gotoxy (y,12); write ('И'); for i:=1 to length (text1)+2 do write ('Н'); write ('ј');
if length(text2)<>0
then
begin
textcolor (8);
y:=(82 - 8 - length (text2)) div 2;
gotoxy (y,13); write ('Ъ'); for i:=1 to length (text2)+6 do write ('Д'); write ('ї');
gotoxy (y,14); write ('і ',text2,' і');
gotoxy (y,15); write ('А'); for i:=1 to length (text2)+6 do write ('Д'); write ('Щ');
end;
gotoxy(1,1);
if p_repeat=true then
repeat
sound (800); delay (40000);
nosound; delay (50000);
until keypressed
else repeat until keypressed;
k:=1; p_repeat:=true;
gotoxy (60,20); textcolor (blue); write ('ЪДДДДДДДДДДДї');
gotoxy (60,23); textcolor (blue); write ('АДДДДДДДДДДДЩ');
repeat gotoxy (60,21); clreol;
textcolor (15);
textbackground (0);
textcolor (blue); write ('і');
textcolor (15);
if k=1 then textbackground(blue) else textbackground(0);
write (' ЏЋ‚’Ћђ€’њ ');
textbackground (0);
textcolor (blue); write ('і');
textcolor (15);
gotoxy (60,22); clreol;
textcolor (15);
textbackground (0);
textcolor (blue); write ('і');
textcolor(15);
if k=2 then textbackground(blue) else textbackground(0);
write (' ‡Ђ‚…ђ€’њ ');
textbackground (0);
textcolor (blue); write ('і');
textcolor (15);
repeat
p_key:=readkey;
until (p_key=chr(72)) or (p_key=chr(80)) or (p_key=chr(13));
if ((p_key=chr(72)) or (p_key=chr(80))) and (k=1)
then begin k:=2; p_repeat:=false; end
else if ((p_key=chr(72)) or (p_key=chr(80))) and (k=2)
then begin k:=1; p_repeat:=true; end
else
if p_key=chr(13)
then k:=3;
until (k=3);
clrscr;
end;
{”®а¬Ёа®ў ЁҐ ¤ҐаҐў Ё§ д ©« }
procedure PreCreate (var f : text; var root : ref);
var FIOt : string[13];
t : ref;
begin
if not eof(f) then
begin
new(t);
read(f,FIOt);
if FIOt[1]='*'
then
t:=nil
else
with t^ do
begin
FIO:=FIOt;
PreCreate (f,father);
PreCreate (f,mother);
end;
root:=t;
end;
end;
{ЋЎе®¤ ¤ҐаҐў Ё Ї®ЁбЄ ®вўҐв § Їа®б}
procedure PreOrder (t:ref; var sername : string);
var st : string [13];
begin
if t<>nil then
begin
st:=t^.FIO;
delete (st,1,pos(' ',st));
delete (st,pos(' ',st),length(st)-pos(' ',st)+1);
if ('N.'<>st) then
begin
PreOrder(t^.father,sername);
PreOrder(t^.mother,sername);
end
else
begin
sername:=t^.mother^.FIO;
delete (sername,pos(' ',sername),length(sername)-pos(' ',sername)+1);
sername:=sername+' ';
end;
end;
end;
{‚лў®¤ ¤ҐаҐў нЄа }
procedure PrintTree (root:ref; n:integer);
var z:integer;
begin
if root<>nil then
with root^ do
begin
PrintTree (father,n+1);
if (n>1) then
for z:=2 to n do
write(' ');
write_name(FIO);
PrintTree (mother,n+1);
end;
end;
{‘®§¤ ЁҐ Ё¤Ґ «м® бв ЎЁ«Ё§Ёа®ў ®Ј® ¤ҐаҐў }
procedure PreCreate2 (var t:ref; n:integer; var f : text);
var p : ref;
nr,nl : integer;
FIOt : str;
begin
if n=0 then
t:=nil
else
begin
nl:=n div 2;
nr:=n-nl-1;
read (f,FIOt);
new (p);
with p^ do
begin
FIO:=FIOt;
PreCreate2 (father,nl,f);
PreCreate2 (mother,nr,f);
end;
t:=p;
end;
end;
{pechat dereva;
n - kolichestvo simvolov v imeni;
t - adres korna}
procedure print(t:ref;n:integer);
var
i:integer;
begin
if t<>nil then
with t^ do
begin
print(father,n+1);
for i:=1 to n do
write(' ');
writeln(FIO);
print(mother,n+1);
end;
end;
procedure AddElem (var t : ref; var n : str);
begin
if t=nil then
begin
new (t);
with t^ do
begin
FIO:=n;
father:=nil;
end;
end
else
if t^.FIO>n then
AddElem (t^.father,n)
else
AddElem (t^.mother,n);
end;
{Џ®ЁбЄ Ё¬ҐЁ ў ¤ҐаҐўҐ}
procedure Search (t : ref; n : str; var found:boolean);
begin
while (t<>nil) and (not found) do
begin
if t^.FIO=n then
found:=true
else
if t^.FIO>n then
t:=t^.father
else
t:=t^.mother;
search(t,n,found);
end;
end;
{ѓ‹Ђ‚ЂЌЂџ ЏђЋѓђЂЊЊЂ}
begin
repeat
clrscr;
writeln;
writeln (' ‹ Ў®а в®а п а Ў®в # 11');
writeln (' ѓҐҐ «®ЈЁзҐбЄ®Ґ ¤ҐаҐў®.');
writeln;
write ('‚ўҐ¤ЁвҐ ®¬Ґа д ©« (1 Ё«Ё 2) >>> ');
readln (num);
if (num<>'1') and (num<>'2') then
begin
fl:=true;
Anomaliya ('‚Ё¬ ЁҐ! ЋиЁЎЄ !','€бЄ®¬л© д ©« Ґ бгйҐбвўгҐв',fl);
end
else
begin
assign (fin,'E:\LAB11\fin'+num+'.txt');
reset (fin);
PreCreate (fin,an);
writeln;
PrintTree (an,1);
readln;
sername:='';
PreOrder (an,sername);
textcolor (yellow);
writeln ('— бвм I');
textcolor (white);
writeln;
if sername='' then
writeln ('Ќ ¤Ґ¦¤ ў ЈҐҐ «®ЈЁзҐбЄ®¬ ¤ҐаҐўҐ Ґ ©¤Ґ .')
else
begin
write ('” ¬Ё«Ёп ¬ вҐаЁ Ќ ¤Ґ¦¤л - ');
write_name(sername);
end;
readln;
writeln;
textcolor (yellow);
writeln ('— бвм II');
textcolor (white);
writeln;
reset (fin);
PreCreate2 (root1,13,fin);
PrintTree (root1,1);
write ('‚ўҐ¤ЁвҐ ЁбЄ®¬®Ґ Ё¬п: ');
found:=false;
readln (n);
search (root1,n,found);
if found then
writeln ('€бЄ®¬®Ґ Ё¬п ©¤Ґ®.')
else
begin
writeln ('€бЄ®¬®Ґ Ё¬п Ґ ©¤Ґ®.');
AddElem (root1,n);
gotoxy (1,wherey-20);
Print (root1,1);
end;
readln;
Anomaliya ('Џа®Ја ¬¬ ўлЇ®«Ґ гбЇҐи®.','',fl)
end;
until fl=false;
end.