Obarvený kód souboru sklad3.pas

uses crt;
const fpomocny = 'sklad.bak';
      fdata    = 'sklad.dat';
      ftisk    = 'printer.txt';
type material = record
                 ev_cislo       : word;
                 nazev          : string;
                 stav           : word;
                 min            : word;
                end;
var mt        : material;
    ffrom,fto : file;
    ft        : file;
    poz,max   : word;
    key       : char;
    volba     : byte;
procedure writexy(x,y : byte; txt : string);
 begin
  gotoxy(x,y);
  write(txt);
 end;
function menu:byte;
 begin
  clrscr;
  writexy(3,1,'E V I D E N C E   S K L A D U');
  writexy(3,3,'1 - Zobrazit evidenci');
  writexy(3,4,'2 - Pridat polozku');
  writexy(3,5,'3 - Zrusit polozku');
  writexy(3,6,'4 - Dodavka');
  writexy(3,7,'5 - Expedice');
  writexy(3,8,'6 - Vypis nedostatecneho materialu');
  writexy(3,10,'0 - Konec');
  repeat
   key:=readkey;
  until key in ['0'..'6'];
  menu:=ord(key)-48;
 end;
function dopln(co:string; _do : byte):string;
var st : string;
 begin
  st:=co;
   while length(st)<_do do
    begin
     st:=st+' ';
    end;
  dopln:=st;
 end;
procedure nejsou;
 begin
  clrscr;
  writexy(3,3,'N E J S O U   Z A D N E   Z A Z N A M Y');
  readkey;
  key:='0';
 end;
procedure pomocny_data;
var x : word;
 begin
  assign(ffrom,fpomocny);
  assign(fto,fdata);
   reset(ffrom,1);
   rewrite(fto,1);
  for x:=1 to max do
   begin
    blockread(ffrom,mt,sizeof(material));
    blockwrite(fto,mt,sizeof(material));
   end;
  close(fto);
  close(ffrom);
 end;
procedure progres;
var x,y : word;
 begin
  clrscr;
  case volba of
   4 : begin
        write('Dodano : ');
        readln(y);
       end;
   5 : begin
        writeln('Maximalni mnozstvi : ',mt.stav);
        repeat
         readln(y);
        until y<=mt.stav;
       end;
  end;
  seek(ffrom,0);
  assign(fto,fpomocny);
   rewrite(fto,1);
  for x:=1 to max do
   if x=poz then
    begin
     blockread(ffrom,mt,sizeof(material));
     case volba of
      4 : mt.stav:=mt.stav+y;
      5 : mt.stav:=mt.stav-y;
     end;
     if (volba in [4,5]) then blockwrite(fto,mt,sizeof(material));
    end
   else
    begin
     blockread(ffrom,mt,sizeof(material));
     blockwrite(fto,mt,sizeof(material));
    end;
  if volba=3 then dec(max);
  if poz>max then poz:=max;
  if max=0 then nejsou;
  close(fto);
  close(ffrom);
  pomocny_data;
  assign(ffrom,fdata);
   reset(ffrom,1);
  clrscr;
 end;

procedure view;
var fp  : longint;
    a   : integer;
 begin
  poz:=1;
  assign(ffrom,fdata);
   reset(ffrom,1);
   max:=filesize(ffrom) div sizeof(material);
    if max>0 then
     begin
      repeat
       fp:=sizeof(material)*(poz-1);
       seek(ffrom,fp);
       blockread(ffrom,mt,sizeof(material));
       clrscr;
       writexy(3,1,'E V I D E N C E   M A T E R I A L U');
       writexy(3,3,dopln('Evidenci cislo',15)+':');
        write(mt.ev_cislo);
       writexy(3,4,dopln('Nazev',15)+':');
        write(mt.nazev);
       writexy(3,5,dopln('Aktualni stav',15)+':');
       a:=mt.stav-mt.min;
        write(a);
       writexy(3,6,dopln('Ks na sklade',15)+':');
        write(mt.stav);
       writexy(3,7,dopln('Min. stav',15)+':');
        write(mt.min);
       writexy(3,9,'1 - Predchozi');
       writexy(3,10,'2 - Dalsi');
       writexy(3,11,'0 - Zpet');
       case volba of
        3 : writexy(3,12,'Enter - Zrusit');
        4 : writexy(3,12,'Enter - Dodat');
        5 : writexy(3,12,'Enter - Expedovat');
       end;
       repeat
        key:=readkey;
       until key in ['0'..'2',#13];
       if (key=#13) and (volba in [3..5]) then progres;
       case key of
        '1' : if poz>1 then dec(poz) else poz:=max;
        '2' : if poz<max then inc(poz) else poz:=1;
       end;
      until key='0';
     end
    else
     nejsou;
  close(ffrom);
 end;
procedure add;
var x,y : integer;
 begin
  assign(fto,fpomocny);
  assign(ffrom,fdata);
   reset(ffrom,1);
   rewrite(fto,1);
  max:=filesize(ffrom) div sizeof(material);
    for x:=1 to max do
     begin
      blockread(ffrom,mt,sizeof(material));
      blockwrite(fto,mt,sizeof(material));
     end;
  clrscr;
  writexy(3,1,'P R I D A N I   P O L O Z K Y');
  writexy(3,3,dopln('Evidenci cislo',15)+':');
  writexy(3,4,dopln('Nazev',15)+':');
  writexy(3,5,dopln('Pocatecni stav',15)+':');
  writexy(3,6,dopln('Min. stav',15)+':');
   gotoxy(20,3);
    readln(mt.ev_cislo);
   gotoxy(20,4);
    readln(mt.nazev);
   gotoxy(20,5);
    readln(mt.stav);
   gotoxy(20,6);
    readln(mt.min);
   blockwrite(fto,mt,sizeof(material));
  close(ffrom);
  close(fto);
  inc(max);
  pomocny_data;
end;

procedure low;
var x,y : integer;
 begin
  assign(ffrom,fdata);
  assign(ft,ftisk);
   reset(ffrom,1);
   rewrite(ft);
   y:=filesize(ffrom) div sizeof(material);
   clrscr;
    for x:=1 to y do
     begin
      blockread(ffrom,mt,sizeof(material));
      if mt.min>mt.stav then
       begin
        writeln(ft,mt.ev_cislo:5,' - ',dopln(mt.nazev,40),' ; ',mt.stav:4,'/',mt.min);
        writeln(mt.ev_cislo:5,' - ',dopln(mt.nazev,40),' ; ',mt.stav:4,'/',mt.min);
       end;
     end;
  close(ffrom);
  close(ft);
   write('Seznam byl ulozen do souboru PRINTER.TXT');
  readkey;
 end;

begin
 repeat
  volba:=menu;
  case volba of
   1,3,4,5 : view;
   2       : add;
   6       : low;
  end;
 until volba=0;
end.

created by PaJa