Umístnení souboru www.TrSek.com/pas/telefon.pas{ TELEFON.PAS Copyright (c) TrSek alias Zdeno Sekerak }
{ Program na uchovavanie telefonnych cisel a simulovanie funkcii }
{ databazy. Obsahuje uzivatelske prostredie. Data vsak neuchovava }
{ v ziadnom subore. }
{ }
{ Datum:02.06.1994 http://www.trsek.com }
program zadanie_telefonny_zoznam;
uses crt,dos;
const poc=100;potel=6;
text:array[1..5] of string=
(' Vstup udajov ',
' Vyhladavanie ',
' Zmena udajov ',
' Vypis zoznamu ',
' Koniec (ESC) ');
text1:array[1..5] of string=
(' mena ',
' priezviska ',
' mena a priezviska ',
' adresy ',
' Spat do menu ');
type zaz=record
meno :string[10];
priezvisko:string[20];
adresa :string[30];
telefon :string[potel];
end;
var zoznam:array[1..poc] of zaz;
pomocna:zaz;
i,i2,zpoc,p,min,max:integer;
s,meno,meno2:string;
ok:boolean;
ch:char;
function upcase_s(meno:string):string;
var i:integer;
pmeno:string;
begin
pmeno:='';
for i:=1 to length(meno) do pmeno:=pmeno+UpCase(meno[i]);
upcase_s:=pmeno;
end;
procedure farba(x,y:byte);
begin textbackground(x);
textcolor(y);
end;
procedure open_win(xl,yl,xp,yp:integer;text:string;color:integer);
var i,xs,ys:integer;
p:real;
begin
window(xl,yl,xp,yp);
p:=(yp-yl)/(xp-xl);
xs:=round((xp-xl)/2)+xl;
ys:=round((yp-yl)/2)+yl-1;
textbackground(color);
for i:=1 to round((xp-xl)/2) do begin
window(xs-i,ys-round(i*p-0.6),xs+i,ys+round(i*p));
clrscr;
delay(8);
end;
window(1,1,80,24);
for i:=xl to xp do begin
gotoxy(i,yl);write('Í');end;
gotoxy(xp,yl);write('»');
for i:=yl+1 to yp do begin
gotoxy(xp,i);write('º');end;
gotoxy(xp,yp);write('¼');
for i:=xp-1 downto xl do begin
gotoxy(i,yp);write('Í');end;
gotoxy(xl,yp);write('È');
for i:=yp-1 downto yl do begin
gotoxy(xl,i);write('º');end;
gotoxy(xl,yl);write('É');
if text<>'' then begin
gotoxy(xs-(length(text) div 2),yl);write(' ',text,' ');end;
window(xl+1,yl+1,xp-1,yp-1);
end;
function tread(x,y:integer;d:byte;s:string):string;
var s1,s2,sz:string;
st:char;
x1,i,ins:integer;
label tam;
begin
x1:=x;farba(15,0);ins:=1;
s:=copy(s,1,d);
if length(s)<d then for i:=length(s) to d-1 do s:=s+' ';
gotoxy(x,y);write(s);sz:=s;
if (x>0) and (x<81) and (y>0) and (y<25) and(x+d<81) then
begin
gotoxy(x,y);
repeat
st:=readkey;
if (st=#27) or (st=#8) or (st=#0) or (st=#13) then
begin if st=#0 then
begin st:=readkey;
if st=#75 then x1:=x1-1;
if st=#77 then x1:=x1+1;
if st=#71 then x1:=x;
if st=#79 then begin i:=d+1;x1:=x+d;
repeat
i:=i-1;
s1:=copy(s,i,1);
if (s1=' ') then x1:=x+i-1;
until (i=0) or (not(s1=' '));
end;
end;
if st=#27 then begin gotoxy(x,y);write(sz);tread:=sz;exit;end;
if st=#8 then begin s1:=copy(s,1,x1-x-1);
s2:=copy(s,x1-x+1,d-x1+x);
s:=s1+s2+' ';
x1:=x1-1;
end;
if st=#83 then begin s1:=copy(s,1,x1-x);
s2:=copy(s,x1-x+2,d-x1+x);
s:=s1+s2+' ';
end;
if st=#82 then begin if ins=2 then ins:=1
else ins:=2;
end;
end
else begin
s1:=copy(s,1,x1-x);
s2:=copy(s,x1+ins-x,d-x1+x);
s:=s1+copy(st,1,1)+s2;
s:=copy(s,1,d);
x1:=x1+1;if (x1>x+d) then x1:=x+d;
end;
if x1<x then x1:=x;
if x1>x+d then x1:=x+d;
s:=copy(s,1,d);
gotoxy(x,y);writeln(s);gotoxy(x1,y);
until st=#13;
while pos(' ',s)>0 do delete(s,pos(' ',s),1);
tread:=s;farba(0,15);
end;
textbackground(blue);textcolor(yellow);writeln;
end;
procedure zamen(x,y:integer);
begin
pomocna.meno:=zoznam[x].meno;
zoznam[x].meno:=zoznam[y].meno;
zoznam[y].meno:=pomocna.meno;
procedure tclrscr;
var i:integer;
begin
for i:=1 to 24 do writeln;
gotoxy(1,1);
end;
begin
s:=' ';zpoc:=0;
repeat
window(1,1,80,25);
textbackground(black);
textcolor(yellow);
clrscr;
open_win(15,5,65,18,'Hlavne menu',blue);
textbackground(blue);
clrscr;
writeln;
writeln(' T E L E F O N N Y Z O Z N A M ');
writeln(' ----------------------------------');
writeln(' Definovanych ',zpoc,' ucastnikov.');
writeln(' ----------------------------------');
for i:=1 to 5 do begin
gotoxy(7,i+5);write(text[i]);end;
writeln;
writeln(' -----------------');
i:=1;
textbackground(7);gotoxy(7,i+5);write(text[i]);
repeat
ch:=readkey;
if ch=#27 then begin i:=5;ch:=#13;end;
if ch=#0 then begin
ch:=readkey;
if ch=#80 then begin
textbackground(1);gotoxy(7,i+5);write(text[i]);
i:=i+1;if i>5 then i:=1;
textbackground(7);gotoxy(7,i+5);write(text[i]);
end;
if ch=#72 then begin
textbackground(1);gotoxy(7,i+5);write(text[i]);
i:=i-1;if i<1 then i:=5;
textbackground(7);gotoxy(7,i+5);write(text[i]);
end;
end;
until (ch=#13);
if i=5 then begin
textbackground(blue);open_win(1,2,80,23,'',blue);clrscr;
gotoxy(19,10);
write (' Naozaj chces skoncit ??? [A/..]: ');ch:=readkey;
if (ch in ['a','A']) then i:=5
else i:=0;
end;
case i of
1:begin
textbackground(blue);open_win(1,2,80,23,'',blue);clrscr;
repeat
clrscr;zpoc:=zpoc+1;
if zpoc>poc then begin
zpoc:=poc;
writeln('Viac udajov uz nemozem natlacit do pamete, predefinuj konstantu poc.');
readln;
end
else begin
writeln;
writeln(' 1.Vstup udajov');
writeln(' --------------');
writeln(' Maximalny pocet je:',poc,' . Zatial je ',zpoc-1,' zadefinovanych.');
writeln(' -----------------------------------------------------------');
write (' Zadaj meno:');zoznam[zpoc].meno:=tread(wherex,wherey,10,'');
write (' priezvisko:');zoznam[zpoc].priezvisko:=tread(wherex,wherey,20,'');
write (' adresu:');zoznam[zpoc].adresa:=tread(wherex,wherey,30,'');
repeat
ok:=true;
for i:=1 to potel do zoznam[zpoc].telefon[i]:=' ';
write (' telefon:');readln(zoznam[zpoc].telefon);
for i:=1 to potel do
if not(zoznam[zpoc].telefon[i] in ['0'..'9',' ','/']) then ok:=false;
if not(ok) then writeln(' Zle zadanne telefonne cislo.');
until ok;
end;
writeln;
writeln(' Definovat dalsieho. [../N]:');
ch:=readkey;
until (ch in ['n','N']);
end;
2:begin
repeat
window(1,1,80,25);
textbackground(black);
clrscr;
open_win(15,5,65,18,'Menu hladaj',blue);
textbackground(blue);
clrscr;
writeln;
writeln(' Vyhladavanie podla');
writeln(' ------------------');
for i2:=1 to 5 do begin
gotoxy(7,i2+3);write(text1[i2]);end;
writeln;
writeln(' ------------------');
i2:=1;
textbackground(7);gotoxy(7,i2+3);write(text1[i2]);
repeat
ch:=readkey;
if ch=#0 then begin
ch:=readkey;
if ch=#80 then begin
textbackground(1);gotoxy(7,i2+3);write(text1[i2]);
i2:=i2+1;if i2>5 then i2:=1;
textbackground(7);gotoxy(7,i2+3);write(text1[i2]);
end;
if ch=#72 then begin
textbackground(1);gotoxy(7,i2+3);write(text1[i2]);
i2:=i2-1;if i2<1 then i2:=5;
textbackground(7);gotoxy(7,i2+3);write(text1[i2]);
end;
end;
until (ch=#13);
if i2<>5 then begin
textbackground(blue);open_win(1,3,80,22,'',blue);clrscr;end;
case i2 of
1:begin
write(' Zadaj meno:');meno:=tread(wherex,wherey,10,'');
write('ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
write('³ Meno ³ Priezvisko ³ Adresa ³ Tel. cislo ³');
write('ÃÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´');
for i:=1 to zpoc do
if upcase_s(meno)=upcase_s(zoznam[i].meno) then
write('³',zoznam[i].meno:10,'³',zoznam[i].priezvisko:20,'³',zoznam[i].adresa:30,'³',zoznam[i].telefon:13,'³');
write('ÀÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
readln;
end;
2:begin
write(' Zadaj priezvisko:');meno:=tread(wherex,wherey,20,'');
write('ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
write('³ Meno ³ Priezvisko ³ Adresa ³ Tel. cislo ³');
write('ÃÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´');
for i:=1 to zpoc do
if upcase_s(meno)=upcase_s(zoznam[i].priezvisko) then
write('³',zoznam[i].meno:10,'³',zoznam[i].priezvisko:20,'³',zoznam[i].adresa:30,'³',zoznam[i].telefon:13,'³');
write('ÀÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
readln;
end;
3:begin
write(' Zadaj meno:');meno:=tread(wherex,wherey,10,'');
write(' priezvisko:');meno2:=tread(wherex,wherey,20,'');
write('ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
write('³ Meno ³ Priezvisko ³ Adresa ³ Tel. cislo ³');
write('ÃÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´');
for i:=1 to zpoc do
if (upcase_s(meno)=upcase_s(zoznam[i].meno)) and
(upcase_s(meno2)=upcase_s(zoznam[i].priezvisko)) then
write('³',zoznam[i].meno:10,'³',zoznam[i].priezvisko:20,'³',zoznam[i].adresa:30,'³',zoznam[i].telefon:13,'³');
write('ÀÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
readln;
end;
4:begin
write(' Zadaj adresu:');meno:=tread(wherex,wherey,30,'');
write('ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
write('³ Meno ³ Priezvisko ³ Adresa ³ Tel. cislo ³');
write('ÃÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄ´');
for i:=1 to zpoc do
if upcase_s(meno)=upcase_s(zoznam[i].adresa) then
write('³',zoznam[i].meno:10,'³',zoznam[i].priezvisko:20,'³',zoznam[i].adresa:30,'³',zoznam[i].telefon:13,'³');
write('ÀÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
readln;
end;
end;
until (i2=5);
end;
3:begin
textbackground(blue);open_win(1,2,80,23,'Zmena',blue);clrscr;
repeat
clrscr;
writeln;
writeln(' Zmena udajov');
writeln(' ------------');
write (' Zadaj meno:');pomocna.meno:=tread(wherex,wherey,10,'');
write (' priezvisko:');pomocna.priezvisko:=tread(wherex,wherey,20,'');
write (' adresu:');pomocna.adresa:=tread(wherex,wherey,30,'');
repeat
ok:=true;
for i:=1 to potel do pomocna.telefon[i]:=' ';
write (' telefon:');readln(pomocna.telefon);
for i:=1 to potel do
if not(pomocna.telefon[i] in ['0'..'9',' ','/']) then ok:=false;
if not(ok) then writeln(' Zle zadanne telefonne cislo.');
until ok;
ok:=false;
for i:=1 to zpoc do
if (upcase_s(pomocna.meno)=upcase_s(zoznam[i].meno)) and
(upcase_s(pomocna.priezvisko)=upcase_s(zoznam[i].priezvisko)) then begin
write('ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
write('³',zoznam[i].meno:10,'³',zoznam[i].priezvisko:20,'³',zoznam[i].adresa:30,'³',zoznam[i].telefon:13,'³');
write('ÀÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
writeln(' Zmenit tohto ucastnika ??? [A/..]:');ch:=readkey;
if (ch in ['a','A']) then begin
ok:=true;
zoznam[i].adresa :=pomocna.adresa;
zoznam[i].telefon:=pomocna.telefon;end;
end;
if (not(ok) and (zpoc<poc)) then begin
writeln(' Takyto ucastnik neexistuje. Mam ho zaradit ??? ../N:');
ch:=readkey;;
if not(ch in ['n','N']) then begin
zpoc:=zpoc+1;
zoznam[zpoc].meno :=pomocna.meno;
zoznam[zpoc].priezvisko:=pomocna.priezvisko;
zoznam[zpoc].adresa :=pomocna.adresa;
zoznam[zpoc].telefon :=pomocna.telefon;end;
end;
writeln(' Chces previest dalsiu zmenu [../N]:');ch:=readkey;
until (ch in ['n','N']);
end;
4:begin
textbackground(blue);window(1,1,80,25);clrscr;
if zpoc>0 then begin
writeln('Prebieha triedenie zoznamu udajov.');
write ('Prechod zoznamom: 0');
p:=0; {*** Usporiadava podla mena a priezviska ***}
repeat
ok:=true;
for i:=1 to zpoc-1 do
if (zoznam[i].priezvisko>zoznam[i+1].priezvisko) then begin
zamen(i,i+1);
ok:=false;end;
for i:=zpoc downto 2 do
if (zoznam[i].priezvisko<zoznam[i-1].priezvisko) then begin
zamen(i-1,i);
ok:=false;end;
p:=p+1;write(chr(8)+chr(8)+chr(8),p:3);
until ok;
window(1,1,80,25);clrscr;
writeln;
writeln('ÚÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
writeln('³ Meno ³ Priezvisko ³ Adresa ³ Telefonne cis³');
writeln('ÃÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´');
for i:=1 to zpoc do begin
writeln('³',zoznam[i].meno:10,'³',zoznam[i].priezvisko:20,'³',zoznam[i].adresa:30,'³',zoznam[i].telefon:14,'³');
if (i mod 20)=0 then begin
write('Stlac Enter pre dalsi vypis ....');readln;
gotoxy(1,wherey-1);delline;end;
end;
writeln('ÀÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
write('Stlac Enter ....');readln;
end;
end;
end;
until (i=5);
window(1,1,80,25);
textbackground(black);
textcolor(white);
clrscr;
end.