Лабораторные работы_2 / LAB9 / LAB9

program Lab_9(fin);
uses crt;
type pnt=^TElem;
TElem = record
number : integer;
adres : string [40];
next : pnt;
end;
pnt2=^TElem2;
TElem2 = record
number : integer;
adres : string [40];
phone : 1000000..9999999;
next : pnt2;
end;
MAS = array [1..100] of 1000000..9999999;
var fin:text;
an : pnt;
bn : pnt2;
k:integer;
num:char;
fl : boolean;
N : MAS;

{Џа®жҐ¤га  ЇҐаҐў®¤  Ё¬Ґ­Ё ­  агббЄЁ© п§лЄ}
procedure Write_Name (St : string);
var
i : byte;
st1,st2:string;
ch:char;
begin
for i:=1 to 40 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;
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 del_list (var an : pnt);
begin
New (an);
an:=nil;
end;

{„®Ў ўЁвм н«Ґ¬Ґ­в ў ­ з «® бЇЁбЄ }
procedure add_beg (var an:pnt; a:integer; st : string);
var k : pnt;
begin
new(k);
k^.next:=an;
k^.number:=a;
k^.adres:=st;
an:=k;
end;

{„®Ў ўЁвм н«Ґ¬Ґ­в ў Є®­Ґж бЇЁбЄ }
procedure add_end (an:pnt; a : integer; st : string);
var k,ak:pnt;
procedure last_address(an:pnt;var ak:pnt);
begin
while an^.next^.next<>nil do
an^.next:=an^.next^.next;
ak:=an^.next;
end;
begin
new(k);
last_address(an,ak);
k^.next:=nil;
k^.number:=a;
k^.adres:=st;
ak^.next:=k;
ak:=k;
end;

{”®а¬Ёа®ў ­ЁҐ бЇЁбЄ  Ё§ д ©« }
procedure CreateList (var fin:text; var aX:pnt);
var a : integer;
st : string [40];
ar,ak:pnt;
begin
new(aX);
readln (fin,aX^.number,aX^.adres);
ar:=aX;
while not (eof(fin)) do
begin
readln (fin,a,st);
new(ak);
ak^.number:=a;
ak^.adres:=st;
ar^.next:=ak;
ar:=ak;
end;
ar^.next:=nil;
end;

{”®а¬Ёа®ў ­ЁҐ ­®ў®Ј® бЇЁбЄ  Ё§ k Ґ«Ґ¬Ґ­в®ў б а бЇаҐ¤Ґ«Ґ­ЁҐ¬ ⥫Ґд®­­ле ­®¬Ґа®ў}
procedure NEWlist (aX:pnt; var bX : pnt2; X : MAS; var k : integer);
var ac : pnt;
bc,ar : pnt2;
begin
new (bX);
bX^.number:=aX^.number;
bX^.adres:=aX^.adres;
bX^.phone:=N[k];
k:=k-1;
ac:=AX^.next;
{ bX^.next:=bc;}bc:=bx;
while k>0 do
begin
new(ar);
ar^.number:=ac^.number;
ar^.adres:=ac^.adres;
ar^.phone:=N[k];
bc^.next:=ar;
bc:=bc^.next;
ac:=ac^.next;
k:=k-1;
end;
ar^.next:=nil;
end;

{‚лў®¤ бЇЁбЄ  ­  нЄа ­}
procedure VIVODlist (aX : pnt);
var ak : pnt;
begin
ak:=aX;
repeat
write (ak^.number:2,' ');
write_name (ak^.adres); writeln;
ak:=ak^.next;
until ak^.next=nil;
write (ak^.number:2,' ');
write_name (ak^.adres);
end;

{‚лў®¤ бЇЁбЄ  2 ­  нЄа ­}
procedure VIVODlist2 (bX : pnt2);
var bk : pnt2;
begin
bk:=bX;
repeat
write (bk^.number:2,' ');
write_name (bk^.adres);
writeln (' ⥫. ',bk^.phone);
bk:=bk^.next;
until bk^.next=nil;
write (bk^.number:2,' ');
write_name (bk^.adres);
writeln (' ⥫. ',bk^.phone);
end;

{Џа®жҐ¤га  д®а¬Ёа®ў ­Ёп ¬ ббЁў  ­®¬Ґа®ў ⥫Ґд®­®ў}
procedure phone_numbers (var X : MAS; z : integer);
var y : integer;
begin
randomize;
for y:=1 to z do
X[y]:=random(8999)*random(1000)+1000000;
end;

{ѓ‹Ђ‚ЂЌЂџ ЏђЋѓђЂЊЊЂ}
begin
repeat
clrscr;
writeln;
writeln (' ‹ Ў®а в®а­ п а Ў®в  # 9');
writeln (' Ћ¤­®­ Їа ў«Ґ­­лҐ бЇЁбЄЁ.');
writeln;
write ('‚ўҐ¤ЁвҐ ­®¬Ґа д ©«  (1,2,3) >>> ');
readln (num);
if (num<>'1') and (num<>'2') and (num<>'3') then
begin
fl:=true;
Anomaliya ('‚­Ё¬ ­ЁҐ! ЋиЁЎЄ !','€бЄ®¬л© д ©« ­Ґ бгйҐбвўгҐв',fl);
end
else
begin
assign(fin,'H:\LAB9\fin'+num+'.txt');
reset(fin);
CreateList (fin,an);
writeln;
writeln ('‘ЇЁб®Є § пў®Є ­  гбв ­®ўЄг ⥫Ґд®­®ў:');
VIVODlist (an);
writeln;
writeln;
write ('‚ўҐ¤ЁвҐ зЁб«® «о¤Ґ©, Є®в®ал¬ б«Ґ¤гҐв ўл¤ вм ­®¬Ґа  ⥫Ґд®­®ў k >>> ');
readln (k);
if (k<=0) then
begin
fl:=true;
Anomaliya ('‚­Ё¬ ­ЁҐ! ЋиЁЎЄ !','Џ® б¬лб«г 0<=k<={—Ёб«® «о¤Ґ© ў бЇЁбЄҐ}',fl);
end
else
begin
phone_numbers (N,k);
NEWlist (an,bn,N,k);
writeln;
writeln ('‘ЇЁб®Є, Ї®«гзЁўиЁе ⥫Ґд®­­лҐ ­®¬Ґа :');
VIVODlist2 (bn);
readln;
fl:=false;
readln;
Anomaliya ('Џа®Ја ¬¬  ўлЇ®«­Ґ­  гбЇҐи­®.','',fl);
end;
end;
until fl=false;
end.