Kód: Vybrať všetko

Program Zbrane;

uses fdelay,crt;

type zbran=record
  nazov:string[15];
  evidencia:record
  Den:1..31;
  Mesiac:1..12;
  Rok:1800..2100;
  Kapacita:1..110;
  Dostrel:25..3000;
  Cena:30..15000;
  Vaha:1..15000;
  Hodnotenie:1..100;
  end;
end;

var kus: zbran;
    f: file of zbran;
    n: integer;
    bedna: array[1..1000] of zbran;
    i,j,poc_zaznamov, chyba, volba: integer;
    ch: char;
    max_menu: 1..5;


function sipky(a,b:byte):byte;
begin
  case ord(readkey) of
    72: dec(a);
    80: inc(a);
  end;
  if a<1 then a:=b;
  if a>b then a:=1;
  sipky:=a;
end;

procedure menu (x,y:byte);
begin 
  gotoxy (x,y+1);
  write ('1- PRIDANIE ZAZNAMU');

  gotoxy (x,y+2);
  write ('---***---***---');

  gotoxy (x,y+3);
  write ('2- VYPISANIE ZAZNAMU');

  gotoxy (x,y+4);
  write ('---***---***---');

  gotoxy (x,y+5);
  write ('3- MAZANIE ZAZNAMU');

  gotoxy (x,y+6);
  write ('---***---***---');

  gotoxy (x,y+7);
  write ('4- TRIEDENIE ZAZNAMU');

  gotoxy (x,y+8);
  write ('---***---***---');

  gotoxy (x,y+9);
  write ('5- KONIEC');

  gotoxy (x,y+10);
  write ('---***---***---');

  gotoxy (1,y+14);
end;

begin
  ch:=readkey;
  if ch=#0 then i:=sipky(i,max_menu);
  if ch=#13 then 
  begin
    ch:=chr(i+48);
    if ch=chr(max_menu+48) then ch:=#27;
  end;

procedure pridaj;
begin
  inc(poc_zaznamov);
  write('Zadaj nazov: ');
  readln(bedna[poc_zaznamov].nazov);
  write('Zadaj den evidencie: ');
  readln(bedna[poc_zaznamov].evidencia.den);
  write('Zadaj mesiac evidencie: ');
  readln(bedna[poc_zaznamov].evidencia.mesiac);
  write('Zadaj rok evidencie: ');
  readln(bedna[poc_zaznamov].evidencia.rok);
  write('Zadaj kapacitu zasobniku: ');
  readln(bedna[poc_zaznamov].evidencia.kapacita) ;
  write('Zadaj ucinny dostrel-min 25m: ');
  readln(bedna[poc_zaznamov].evidencia.dostrel);
  write ('Zadaj aktualnu cenu v eurach: ');
  readln(bedna[poc_zaznamov].evidencia.cena);
  write ('Zadaj vahu zbrane s plnym zasobnikom (v kg): ');
  readln(bedna[poc_zaznamov].evidencia.vaha);
  write ('Zadaj aktualne hodnotenie v percentach podla www.saw.com: ');
  readln(bedna[poc_zaznamov].evidencia.hodnotenie);
  write ('Pridanie zaznamu uspesne');
  readln;
end;

procedure vypis;
begin
  for i:=1 to poc_zaznamov do
  begin
    write('Nazov zbrane:');
    writeln(bedna[i].nazov);
    write('Datum evidencie :');
    writeln(bedna[i].evidencia.den,'.',bedna[i].evidencia.mesiac,'.',bedna[i].evidencia.rok);
    write('Kapacita zasobnika:');
    writeln(bedna[i].evidencia.kapacita);
    write('Ucinny dostrel v metroch:');
    writeln(bedna[i].evidencia.dostrel);
    write('Aktualna cena v eurach:');
    writeln(bedna[i].evidencia.cena);
    write('Vaha zbrane s plnym zasobnikom (v kg):');
    writeln(bedna[i].evidencia.vaha);
    write('Aktualne hodnotenie zbrane v percentach podla www.saw.com:');
    writeln(bedna[i].evidencia.hodnotenie);
  end;
  readln
end;

procedure mazanie;
var cislo_mazanie_zaznamu:integer;
begin
  write('Zadaj cislo zaznamu: ');
  readln(cislo_mazanie_zaznamu);
  seek (f, cislo_mazanie_zaznamu -1);
  write (f, bedna [poc_zaznamov]);
  seek (f, poc_zaznamov -1);
  truncate (f);
  bedna [cislo_mazanie_zaznamu]:= bedna [poc_zaznamov];
  poc_zaznamov:= poc_zaznamov-1;
  readln;
  writeln ('Mazanie uspesne');
  readln;
end;

procedure triedenie;
var pom: zbran;
    j: integer;
begin
  for j:=1 to poc_zaznamov-1 do 
  begin
  for i:=1 to poc_zaznamov-j do 
    if bedna[i].nazov>bedna[i+1].nazov then
    begin 
      pom:=bedna[i]; 
      bedna[i]:=bedna[i+1]; 
      bedna[i+1]:=pom;
    end;
  end;
end;

begin
  poc_zaznamov:= 0;
  assign (f,'databaza.dat ');
  {$I-}
  reset (f);
  chyba :=ioresult;
  {$I+}
  if chyba >0 then rewrite (f)
  else poc_zaznamov:= filesize (f);

  for i:= 1 to poc_zaznamov do read (f, bedna [i]);
  repeat
    clrscr;
    menu (10,1);
    readln (volba);
    clrscr;

    menu (10,1);
    case volba of
      1:pridaj;
      2:vypis;
      3:mazanie;
      4:triedenie;
    end;
  until volba=5;

  seek(f,0);
  for i:= 1 to poc_zaznamov do write (f, bedna [i]);
  close (f);
end.

Kód: Vybrať všetko

begin
  ch:=readkey;
  if ch=#0 then i:=sipky(i,max_menu);
  if ch=#13 then 
  begin
    ch:=chr(i+48);
    if ch=chr(max_menu+48) then ch:=#27;
end;

Kód: Vybrať všetko

procedure vypisMenu(polozkyMenu: array[0..4] of String; aktualnaPolozka: integer);
var i: integer;
begin
  clrscr;
  for i := 0 to 4 do
  begin
    { Kurzor nad aktualnym zaznamov v menu }
    if aktualnaPolozka = i then write('-> ')
    else write('   ');
    writeln(polozkyMenu[i]);
  end;
end;

procedure menuVstup(aktualnaPolozka: integer);
begin
  { Volane procedury/funkcie pre kazdu polozku v menu }
  case aktualnaPolozka of 
    0 : pridaj;
    1 : vypis;
    2 : mazanie;
    3 : triedenie;
    4 : exit; { Upratat a ukoncit beh }
  end;
end;

procedure menu(polozkyMenu: array[0..4] of String; startPolozka: integer);
var klaveska: char;
    aktualnaPolozka: integer;
begin
  aktualnaPolozka := startPolozka mod 5; 
  while true do 
  begin
    vypisMenu(polozkyMenu, startPolozka);
    { Cakanie na vstup od uzivatela a vykonanie prislusnych akcii }
    klavesa := readkey;
    case klavesa of
      'W' : aktualnaPolozka := (aktualnaPolozka - 1) mod 5;
      'S' : aktualnaPolozka := (aktualnaPolozka + 1) mod 5;
      #13 : menuVstup(aktualnaPolozka);
    end;
  end;
end;