Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
18
Добавлен:
28.06.2014
Размер:
7.6 Кб
Скачать
program Lab8_Zaharov;
uses crt;
type
Pol = (man,woman);
Tperson = record
FIO : string [30];
tall : 150..230;
case S : Pol of
man : (ves : 30..100; old : 15..30; sport : string [15]);
woman : (ob1,ob2,ob3 : 40..120; color : string [10]);
end;
var
fin : text;
fout : file of Tperson;
person : Tperson;
fl : boolean;

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


{ѓ« ў­ п Їа®Ја ¬¬ }
begin
repeat
clrscr;
writeln;
writeln (' ‹ Ў®а в®а­ п а Ў®в  # 7');
writeln (' ‡ ЇЁбЁ б ў аЁ ­в ¬Ё.');
writeln;
writeln ('ћ­®иЁ, ў ў®§а б⥠®в 17 ¤® 19 «Ґв, а®б⮬ 195 б¬:');
assign (fin,'H:\LAB8\fin.txt');
reset (fin);

{‘®§¤ ­ЁҐ вЁЇЁ§Ёа®ў ­­®Ј® д ©« }
assign (fout,'H:\LAB8\fout.dat');
rewrite (fout);
while not eof (fin) do
begin
with person do
begin
read (fin,FIO,tall);
case S of
man : readln (fin,ves,old,sport);
woman : readln (fin,ob1,ob2,ob3,color);
end;
write (fout,person);
end;
end;

{Џ®ЁбЄ ў вЁЇЁ§Ёа®ў ­­®¬ д ©«Ґ}
fl:=true;
reset (fout);
read (fout,person);
while not eof (fout) do
begin
if ((person.S=man) and
((person.old=17) or (person.old=18) or (person.old=19)) and
(person.tall=195))
then
begin
Write_Name (person.FIO);
fl:=false;
end;
read (fout,person);
end;

{Џа®ўҐаЄ   ­®¬ «м­®© бЁвг жЁЁ}
if fl=false
then
begin
readln;
Anomaliya ('Џа®Ја ¬¬  ўлЇ®«­Ґ­  гбЇҐи­®.','',fl);
end
else Anomaliya ('‚­Ё¬ ­ЁҐ! ЋиЁЎЄ !','‚ д ©«Ґ ®вбгвбвўгов ЁбЄ®¬лҐ н«Ґ¬Ґ­вл',fl);
until fl=false;
end.
Соседние файлы в папке LAB8