Program umožňuje zadávať časy jednotlivým bežcom

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategorija: KMP (Programy mladňakoch

Program: Bezci1.pas
Subor exe: Bezci1.exe

Program umožňuje zadávať časy jednotlivým bežcom.
{ BEZCI1.PAS                                                        }
{ Program umoznuje zadavat casy jednotlivym bezcom.                 }
{                                                                   }
{ Datum:02.12.2008                             http://www.trsek.com }
 
program BEZCI1;
uses crt;
type
    zavodnik=record
     jmeno:string[15];
     prijmeni:string[15];
     cas:real;
    end;
 
var
   bezec:zavodnik;
   f,g:file of zavodnik;
   i,vel:integer;
   odpoved:char;
   zadani:string[15];
   soubor:string;
   trideno:boolean;
 
procedure inicializace;
 begin
  clrscr;
  write('Zadejte jmeno suboru: ');
  readln(soubor);
  assign(f,soubor);
  {$I-}
  reset(f);
  {$I+}
  if ioresult<>0 then rewrite(f);
  close(f);
end;
procedure trid;
  var a,b,p:zavodnik;
  prohoz:boolean;
begin
 reset(f);
 vel:=filesize(f);
 close(f);
 repeat
  prohoz:=false;
  for i:=0 to (vel-2)do begin
   reset(f);
   seek(f,i);
   read(f,a);
   read(f,b);
   close(f);
   if a.cas>b.cas then begin
     p:=b;
     b:=a;
     a:=p;
     prohoz:=true;
    end;
    reset(f);
    seek(f,i);
    write(f,a);
    write(f,b);
    close(f);
   end;
  until prohoz=false;
  trideno:=true;
 end;
procedure vypis;
  begin
   clrscr;
   if not trideno then trid;
   reset(f);
   for i:=1 to filesize(f) do begin
   read(f,bezec);
   with bezec do begin
    write(cas:8:2);
    write(jmeno:15);
    writeln(prijmeni:15);
   end;
  end;
  close(f);
  repeat until keypressed;
 end;
 
 procedure pridat;
   begin
    reset(f);
    seek(f,filesize(f));
 
    repeat
     clrscr;
     with bezec do begin
       write('Zadajte cas bezce: ');
       readln(cas);
       write('Zadajte jmeno bezce: ');
       readln(jmeno);
       write('Zadaj prijmeni bezce: ');
       readln(prijmeni);
     end;
     write(f,bezec);
     writeln;
     writeln('Dalsi zaznam? A/N');
    until upcase(readkey)<>'A';
 
    close(f);
    trideno:=false;
   end;
 
procedure vyhledat;
  begin
    clrscr;
    reset(f);
    write('Zadajte prijmeni hladaneho: ');
    readln(zadani);
    writeln;
    writeln('Vysledok hladani: ');
 
    for i:=1 to filesize(f) do begin
     read(f,bezec);
     if zadani=bezec.prijmeni then
       with bezec do begin
         write(prijmeni:15);
         write(jmeno:15);
         writeln(cas:8:2);
         end;
      end;
 
      close(f);
      repeat until keypressed;
    end;
 
procedure odstranit;
  begin
    clrscr;
    assign(g,'tmp.tmp');
    write('Zadejte prijmeni: ');
    readln(zadani);
    writeln;
    reset(f);
    rewrite(g);
    for i:=1 to filesize(f) do begin
     read(f,bezec);
     if bezec.prijmeni=zadani then
      writeln('Bezec ',bezec.prijmeni,' byl odstranen ze zeznamu')
     else write(g,bezec);
    end;
 
    close(f);
    close(g);
    rewrite(f);
    reset(g);
 
    for i:=1 to filesize(g) do begin
     read(g,bezec);
     write(f,bezec);
     end;
 
     close(f);
     close(g);
     erase(g);
     repeat until keypressed;
     end;
 
begin
   inicializace;
   trideno:=false;
   repeat
    clrscr;
    writeln('Soubor: ',soubor);
    writeln('----------------------');
    writeln('Vypisat vysledky ... V');
    writeln('Ini subor .......... I');
    writeln('----------------------');
    writeln('Pridat zaznam ...... P');
    writeln('Hladat zaznam ...... H');
    writeln('Odstratin zaznam ... O');
    writeln('----------------------');
    writeln('Koniec ........... Esc');
 
    odpoved:=upcase(readkey);
 
    case odpoved of
     'V':vypis;
     'I':inicializace;
     'P':pridat;
     'H':vyhledat;
     'O':odstranit;
     end;
    until odpoved=chr(27);
    end.