{(c) 2001 Emur http://emur.org}

{Program pouziva typovy soubor "adresar.dat"}

program ADRESAR;
uses crt;
type osoba=record
             jmeno :string[10];
             vek :0..99;
             plat :word;
             pohl :boolean;
           end;
var f :file of osoba;
    pom :osoba;
    ch :char;

procedure Ramecek(x1,y1,x2,y2:integer; Title:string);
var i:integer;
begin
  GotoXY(x1,y1); Write('É');
  GotoXY(x2,y1); Write('»');
  GotoXY(x1,y2); Write('È');
  GotoXY(x2,y2); Write('¼');
  for i:=x1+1 to x2-1 do
  begin
    GotoXY(i,y1); Write('Í');
    GotoXY(i,y1+2); Write('Ä');
    GotoXY(i,y2); Write('Í');
  end;
  for i:=y1+1 to y2-1 do
  begin
    GotoXY(x1,i); Write('º');
    GotoXY(x2,i); Write('º');
  end;
  GotoXY(x1,y1+2); Write('Ç');
  GotoXY(x2,y1+2); Write('¶');
  GotoXY((x1+x2-Length(Title)) div 2,y1+1);
  Write(Title);
end;

procedure Menu;
begin
  ClrScr;
  Ramecek(4,2,77,23,'A D R E S A R');
  GotoXY(29,7);  Write('Vlozeni ................. 1');
  GotoXY(29,8);  Write('Vlozeni podle abecedy ... 2');
  GotoXY(29,10); Write('Smazani osoby ........... 3');
  GotoXY(29,11); Write('Smazani vseho ........... 4');
  GotoXY(29,13); Write('Vypis ................... 5');
  GotoXY(29,15); Write('Vyhledat ................ 6');
  GotoXY(29,17); Write('Konec ................... Esc');
  GotoXY(29,19); Write('Pocet lidi v adresari: ',FileSize(f):4)
end;

procedure Vloz;
var ch :char;
begin
clrscr;
Ramecek(4,2,77,23,'Vlozeni zaznamu');
GotoXY(29,5);
Write('Zaznam cislo: ',FilePos(f)+1);
GotoXY(29,7);
Write('Jmeno: ');readln(pom.jmeno);GotoXY(29,8);
Write('Vek:   ');readln(pom.vek);GotoXY(29,9);
Write('Plat:  ');readln(pom.plat);GotoXY(29,10);
Write('Muz? (a/n) ');ch:=readkey;
if (ch='a') or (ch='A') then pom.pohl:=True
 else pom.pohl:=False;
GotoXY(29,11);
seek(f,filesize(f));
write(f,pom);
end;

procedure Vloz2;                        {Setrideni podle abecedy}
var pole :array [1..10] of osoba;
    pocet,i,j :integer;
    pom2 :osoba;
begin
Vloz;
seek(f,0);
pocet:=filesize(f);
for i:=1 to pocet do    {Vlozeni zaznamu ze souboru do pole}
  begin
  read(f,pom);
  pole[i]:=pom;
  end;
for i:=1 to pocet do            {setrideni pole podle abecedy}
  for j:=i to pocet do
    if pole[i].jmeno>pole[j].jmeno then
      begin
      pom2:=pole[i];            {prohozeni promenych}
      pole[i]:=pole[j];
      pole[j]:=pom2;
      end;
rewrite(f);
for i:=1 to pocet do    {Vlozeni vsech zaznamu zpet z pole do souboru}
  begin
  pom:=pole[i];
  write(f,pom);
  end;
end;

procedure Vypis;
begin
seek(f,0);
while not (eof(f)) do
  begin
  clrscr;
  Ramecek(4,2,77,23,'Vypis zaznamu');
  read(f,pom);
  gotoxy(29,7);
  Write('Zaznam cislo: ',FilePos(f));
  GotoXY(29,9);
  write('Jmeno: ',pom.jmeno);GotoXY(29,10);
  write('Vek:   ',pom.vek);GotoXY(29,11);
  write('Plat:  ',pom.plat);GotoXY(29,12);
  write('Muz?:  ',pom.pohl);
  readkey;
  end;
end;

procedure Smaz;
var jm :string[10];
    f2 :file of osoba;
begin
clrscr;
Ramecek(4,2,77,23,'Smazani zaznamu');
GotoXY(18,7);
write('Zadej jmeno, ktere chces smazat z adresare: ');
readln(jm);
assign(f2,'pomfile.dat');               {pomocny soubor s prom f2}
rewrite(f2);
seek(f,0);
while not (eof(f)) do
  begin
  read(f,pom);
  if pom.jmeno<>jm then write(f2,pom)
    else continue;
  end;
close(f); close(f2);
erase(f);
rename(f2,'adresar.dat');
assign(f,'adresar.dat');
reset(f);
end;

{********************nasleduji 4 procedury na vyhledavani*******************}

procedure Pohl;                        {Hledani podle pohlavi}
var a :char;
begin
Ramecek(4,2,77,23,'Hledani v adresari');
GotoXY(18,9);
write('Hledat: 1.muze, 2.zeny: ');a:=readkey;
gotoxy(18,10);
write('Vyhovuji osoby: ');
seek(f,0);
while not eof(f) do
  begin
  read(f,pom);
  if a='1' then if pom.pohl=True then write(pom.jmeno,', ');
  if a='2' then if pom.pohl=False then write(pom.jmeno,', ');
  end;
readkey;
end;

procedure Vek;                        {Hledani podle veku}
var a,b :integer;
begin
Ramecek(4,2,77,23,'Hledani v adresari');
GotoXY(18,9);
write('Zadej rozmezi: ');read(a,b);
gotoxy(18,10);
write('Vyhovuji osoby: ');
seek(f,0);
while not eof(f) do
  begin
  read(f,pom);
  if (pom.vek>a) and (pom.vek<b) then write(pom.jmeno,', ');
  end;
readkey;
end;

procedure Plat;                        {Hledani podle platu}
var a,b :integer;
begin
Ramecek(4,2,77,23,'Hledani v adresari');
GotoXY(18,9);
write('Zadej rozmezi: ');read(a,b);
gotoxy(18,10);
write('Vyhovuji osoby: ');
seek(f,0);
while not eof(f) do
  begin
  read(f,pom);
  if (pom.plat>a) and (pom.plat<b) then write(pom.jmeno,', ');
  end;
readkey;
end;

procedure Hledej;
var i :char;
begin
clrscr;
Ramecek(4,2,77,23,'Hledani v adresari');
GotoXY(15,7);
write('Podle ceho hledat: 1.pohlavi, 2.vek, 3.plat: ');
i:=readkey;
case i of
  '1' :Pohl;
  '2' :Vek;
  '3' :Plat;
end;
end;
{***********************nahore 4 procedury na vyhledavani*******************}


BEGIN
Assign(f,'adresar.dat');
{$I-} Reset(f);{$I+}
if IOResult<>0 then Rewrite(f);
Menu;
ch:=readkey;
repeat
case ch of
  '1' :Vloz;
  '2' :Vloz2;
  '3' :Smaz;
  '4' :rewrite(f);
  '5' :Vypis;
  '6' :Hledej;
  #27 :Exit;
end;
Menu;
ch:=readkey;
until ch=#27;
close(f);
END.