Kód: Vybrať všetko

{ Ziacka DB v0.5 - Rocnikova praca by Marek Milkovic}
program rocPraca;
uses crt;
type class=record
     id:integer;
     name:string[25];
     surname:string[25];
     address:string[25];
     city:string[25];
     tel:string[25];
     date:string[25];
     end;
var mFile,delFile:file of class;
    loader:class;       { Nacitava/zapisuje data z/do suboru }
    i,j:integer;

{ Vyplni hlavicku programu }
procedure header;
begin
clrscr;
TextColor(green);
writeLn('Ziacka DB v0.5 - Rocnikova Praca by Marek Milkovic');
TextColor(white);
end;

{ Kompletne zmaze subor a nasledne vyzve na naplnenie }
procedure napln;
var n:integer;
begin
rewrite(mFile);
header;
write('Zadaj pocet ziakov ktorych chces pridat: ');
readLn(n);
for i:=1 to n do begin
    loader.id:=i;
    write('Meno ziaka: ');
    readLn(loader.name);
    write('Priezvysko ziaka: ');
    readLn(loader.surname);
    write('Adresa ziaka: ');
    readLn(loader.address);
    write('Miesto trvaleho pobytu ziaka: ');
    readLn(loader.city);
    write('Telefonne cislo ziaka: ');
    readLn(loader.tel);
    write('Datum narodenia ziaka: ');
    readLn(loader.date);
    write(mFile,loader);
    end;
TextColor(red);
write('Databaza bola uspesne naplnena. Pokracujte stlacenim tlacidla ENTER.');
TextColor(white);
close(mFile);
readLn;
end;

{ Vypis celej DB }
procedure vypis;
const PocZnakov = 12;
var XSur,YSur:integer;
begin
header;
reset(mFile);
XSur:=0;
YSur:=3;
{ Hlavicka pre vypisovu tabulku }
GoToXY(XSur,YSur-1);
for i:=1 to PocZnakov*6+5 do write('#');
writeLn;
for i:=1 to (PocZnakov div 2)+1 do begin
    GoToXY(XSur,YSur);
    write('#');
    TextColor(6);
      case i of
         1:write('Id');
         2:write('Meno');
         3:write('Priezvysko');
         4:write('Adresa');
         5:write('Mesto');
         6:write('Tel.c.');
         7:write('Datum nar.');
         end;
    TextColor(white);
    if (i<>1) then XSur:=XSur+PocZnakov else XSur:=XSur+5;
    if (i = 7) then begin
       GoToXY(XSur,YSur);
       write('#');
       end;
    end;
writeLn;
YSur:=5;
XSur:=0;
GoToXY(XSur,YSur-1);
for i:=1 to PocZnakov*6+5 do write('#');
writeLn;
{ Koniec hlavicky }
{ Vypis samotnych dat }
while not eof(mFile) do begin
      read(mFile,loader);
      for i:=1 to 7 do begin
          GoToXY(XSur,YSur);
          write('#');
          TextColor(yellow);
          case i of
               1:write(loader.id);
               2:write(loader.name);
               3:write(loader.surname);
               4:write(loader.address);
               5:write(loader.city);
               6:write(loader.tel);
               7:write(loader.date);
               end;
          TextColor(white);
          if (i<>1) then XSur:=XSur+PocZnakov else XSur:=XSur+5;
          if (i = 7) then begin
             GoToXY(XSur,YSur);
             write('#');
             end;
          end;
      inc(YSur);
      XSur:=0;
      writeLn;
      GoToXY(XSur,YSur);
      end;
{ Koniec vypisu dat }
{ Zakoncenie tabulky }
for i:=1 to PocZnakov*6+5 do write('#');
writeLn;
TextColor(red);
write('Pokracujte stlacenim tlacidla ENTER.');
TextColor(white);
readLn;
end;

{ Prida ziaka na zadanu poziciu }
procedure pridaj;
var good_id,new_pos:integer;
    new_loader:class;
begin
header;
write('Zadaj poziciu na aku chces pridat ziaka: ');
readLn(new_pos);
reset(mFile);
if (new_pos >= filesize(mFile)) then new_pos:=filesize(mFile); { Prevencia }
rewrite(delFile);
reset(delFile);
good_id:=1;
while not eof(mFile) do begin
    read(mFile,loader);
    write(delFile,loader);
    if (good_id = loader.id) then inc(good_id);
end;
new_loader.id:=good_id;
write('Zadaj meno noveho ziaka: ');
readLn(new_loader.name);
write('Zadaj priezvysko noveho ziaka: ');
readLn(new_loader.surname);
write('Zadaj adresu noveho ziaka: ');
readLn(new_loader.address);
write('Zadaj trvale bydlisko noveho ziaka: ');
readLn(new_loader.city);
write('Zadaj telefonne cislo noveho ziaka: ');
readLn(new_loader.tel);
write('Zadaj datum narodenia noveho ziaka: ');
readLn(new_loader.date);
rewrite(mFile);
reset(delFile);
while not eof(delFile) do begin
    read(delFile,loader);
    if (new_pos = filepos(delFile)) then write(mFile,new_loader);
    write(mFile,loader);
end;
TextColor(red);
write('Ziak bol uspesne pridany do DB.  Pokracujte stlacenim tlacidla ENTER.');
TextColor(white);
close(mFile);
readLn;
end;

{ Pomocna procedura pri vymazavani prvku }
procedure presun(pos:integer);
begin
reset(mFile);
rewrite(delFile);
reset(delFile);
while not eof(mFile) do begin
    read(mFile,loader);
    if (pos <> filepos(mFile)) then write(delFile,loader);
    end;
rewrite(mFile);
reset(delFile);
while not eof(delFile) do begin
    read(delFile,loader);
    write(mFile,loader);
    end;
close(mFile);
rewrite(delFile);
end;
 
{ Odstrani zadanu polozku podla priezvyska }
procedure odstran;
var s:string;
    found:boolean;
    pozicie:array[1..100] of integer;
begin
header;
reset(mFile);
found:=false;
write('Zadaj priezvysko ziaka, ktoreho chces zmazat: ');
readLn(s);
j:=1;
while not eof(mFile) do begin
    read(mFile,loader);
    if (s = loader.surname) then begin
        found:=true;
        pozicie[j]:=filepos(mFile);
        inc(j);
        end;
    end;
 for i:=1 to j-1 do begin
    presun(pozicie[i]);
    end;
 TextColor(red);
 if (found) then write('Ziak bol najdeny a uspesne zmazany. Pokracujte stlacenim tlacidla ENTER.')
    else write('Bohuzial, zadany ziak nebol najdeny. Pokracujte stlacenim tlacidla ENTER.');
 TextColor(white);
 readLn;
end;

{ Ukazka povodnych dat ziaka pred zmenou zmen>>zmen_show }
procedure zmen_show;
begin
for i:=1 to 7 do begin
    TextColor(6);
    case i of
        1:write('Id: ');
        2:write('Meno: ');
        3:write('Priezvysko: ');
        4:write('Adresa: ');
        5:write('Miesto trvaleho bydliska: ');
        6:write('Telefonne cislo: ');
        7:write('Datum narodenia: ');
        end;
    TextColor(yellow);
    case i of
        1:writeLn(loader.id);
        2:writeLn(loader.name);
        3:writeLn(loader.surname);
        4:writeLn(loader.address);
        5:writeLn(loader.city);
        6:writeLn(loader.tel);
        7:writeLn(loader.date);
        end;
    end;
TextColor(white);
end;

{ Procedura na nacitanie novych dat pre zmenu dat zmen>>zmen_request }
procedure zmen_request(pos:integer);
var edited:class;
begin
reset(mFile);
seek(mFile,pos-1);
read(mFile,loader);
zmen_show;
edited.id:=loader.id;
writeLn('Ak chces zanechat povodne udaje tak napis DEFAULT(s velkymi pismenami)');
write('Zadaj nove meno: ');
readLn(edited.name);
if (edited.name = 'DEFAULT') then edited.name:=loader.name;
write('Zadaj nove priezvysko: ');
readLn(edited.surname);
if (edited.surname = 'DEFAULT') then edited.surname:=loader.surname;
write('Zadaj novu adresu: ');
readLn(edited.address);
if (edited.address = 'DEFAULT') then edited.address:=loader.address;
write('Zadaj nove miesto trvaleho pobytu: ');
readLn(edited.city);
if (edited.city = 'DEFAULT') then edited.city:=loader.city;
write('Zadaj nove telefonne cislo: ');
readLn(edited.tel);
if (edited.tel = 'DEFAULT') then edited.tel:=loader.tel;
write('Zadaj novy datum narodenia: ');
readLn(edited.date);
if (edited.date = 'DEFAULT') then edited.date:=loader.date;
seek(mFile,pos-1);
write(mFile,edited);
end;

{ Zmeni hodnoty ziaka na zadane hodnoty, podla ID }
procedure zmen;
var changing_id,changing_pos:integer;
    found:boolean;
begin
header;
reset(mFile);
found:=false;
write('Zadaj ID ziaka, pre ktoreho chces zmenit udaje: ');
readLn(changing_id);
while not eof(mFile) do begin
    read(mFile,loader);
    if (loader.id = changing_id) then begin
        changing_pos:=filepos(mFile);
        found:=true;
        end;
    end;
zmen_request(changing_pos);
TextColor(red);
write('Udaje pre ziaka boli uspesne zmenene. Pokracujte stlacenim tlacidla ENTER.');
TextColor(white);
readLn;
end;

procedure hladaj(typ:integer);
const PocZnakov = 12;
var search:string;
    pos:array[1..100] of integer;
    p,XSur,YSur:integer;
begin
header;
reset(mFile);
p:=0;
case typ of
    1:begin
      write('Zadaj meno ktore chces vyhladat: ');
      readLn(search);
      while not eof(mFile) do begin
        read(mFile,loader);
        if (loader.name = search) then begin
            inc(p);
            pos[p]:=filepos(mFile);
            end;
        end;
      end;
    2:begin
      write('Zadaj miesto trvaleho bydliska ktore chces vyhladat: ');
      readLn(search);
      while not eof(mFile) do begin
        read(mFile,loader);
        if (loader.city = search) then begin
            inc(p);
            pos[p]:=filepos(mFile);
            end;
        end;
      end;
    3:begin
      write('Zadaj telefonne cislo ktore chces vyhladat: ');
      readLn(search);
      while not eof(mFile) do begin
        read(mFile,loader);
        if (loader.tel = search) then begin
            inc(p);
            pos[p]:=filepos(mFile);
            end;
        end;
       end;
    end;
{ Vypis toho co nasiel }
XSur:=0;
YSur:=4;
GoToXY(XSur,YSur-1);
for i:=1 to PocZnakov*6+5 do write('#');
writeLn;
for i:=1 to (PocZnakov div 2)+1 do begin
    GoToXY(XSur,YSur);
    write('#');
    TextColor(6);
      case i of
         1:write('Id');
         2:write('Meno');
         3:write('Priezvysko');
         4:write('Adresa');
         5:write('Mesto');
         6:write('Tel.c.');
         7:write('Datum nar.');
         end;
    TextColor(white);
    if (i<>1) then XSur:=XSur+PocZnakov else XSur:=XSur+5;
    if (i = 7) then begin
       GoToXY(XSur,YSur);
       write('#');
       end;
    end;
writeLn;
YSur:=6;
XSur:=0;
GoToXY(XSur,YSur-1);
for i:=1 to PocZnakov*6+5 do write('#');
writeLn;
j:=1;
reset(mFile);
for j:=1 to p do begin
    seek(mFile,pos[j]-1);
    read(mFile,loader);
    for i:=1 to 7 do begin
        GoToXY(XSur,YSur);
        write('#');
        TextColor(yellow);
        case i of
            1:write(loader.id);
            2:write(loader.name);
            3:write(loader.surname);
            4:write(loader.address);
            5:write(loader.city);
            6:write(loader.tel);
            7:write(loader.date);
            end;
            TextColor(white);
        if (i<>1) then XSur:=XSur+PocZnakov else XSur:=XSur+5;
        if (i = 7) then begin
            GoToXY(XSur,YSur);
            write('#');
            end;
        end;
    inc(YSur);
    XSur:=0;
    writeLn;
    GoToXY(XSur,YSur);
    end;
for i:=1 to PocZnakov*6+5 do write('#');
writeLn;
TextColor(red);
write('Pokracujte stlacenim tlacidla ENTER.');
TextColor(white);
readLn;
end;

procedure hladaj_menu;
const XSur = 5;
var YSur:integer;
begin
header;
writeLn('----- MENU VYHLADAVANIA -----');
writeLn('Stlac prislusne cislo pre vykonanie funkcie.');
TextColor(yellow);
for i:=1 to 3 do writeLn(i,' - ');
YSur:=4;
TextColor(6);
for i:=1 to 3 do begin
    GoToXY(XSur,YSur);
    case i of
        1:write('Vyhladavanie podla mena');
        2:write('Vyhladavanie podla miesto trvaleho bydliska');
        3:write('Vyhladavanie podla telefonneho cisla');
        end;
    inc(YSur);
    end;
case readkey of
    '1':hladaj(1);
    '2':hladaj(2);
    '3':hladaj(3);
    end;
end;

{ Menu programu, pristup ku kazdej procedure }
procedure menu;
const XSur = 5;
var YSur:integer;
begin
header;
TextColor(white);
writeLn('----- MENU -----');
writeLn('Stlac prislusne cislo pre vykonanie funkcie.');
TextColor(yellow);
for i:=1 to 6 do writeLn(i,' - ');
YSur:=4;
TextColor(6);
for i:=1 to 6 do begin
    GoToXY(XSur,YSur);
    case i of
        1:write('Naplnenie DB (zmaze predosle udaje, ak neexistuje, musi sa najprv naplnit)');
        2:write('Vypisanie DB');
        3:write('Pridanie noveho ziaka do DB');
        4:write('Zmazanie ziaka z DB');
        5:write('Zmena udajov existujuceho ziaka v DB');
        6:write('Vyhladavanie ziakov v DB');
        end;
    inc(YSur);
    end;
case readkey of
     '1':begin
         napln;
         menu;
         end;
     '2':begin
         vypis;
         menu;
         end;
     '3':begin
         pridaj;
         menu;
         end;
     '4':begin
         odstran;
         menu;
         end;
     '5':begin
         zmen;
         menu;
         end;
     '6':begin
         hladaj_menu;
         menu;
         end;
     end;
end;

{ Spustac }
begin
assign(mFile,'rocPraca.txt');
assign(delFile,'delFile.txt');
rewrite(delFile);
menu;
end.