Program umožňuje zadávať časy jednotlivým bežcom
Delphi & Pascal (česká wiki)
Kategorija: KMP (Programy mladňakoch
Program: Bezci1.pas
Subor exe: Bezci1.exe
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.