You can use the program to information about athletes Winter Olympic Game
Delphi & Pascal (česká wiki)
Category: KMP (Club of young programmers)
Author: Ľuboš Saloky
Program: Pretek6.pas
File exe: Pretek6.exe
Author: Ľuboš Saloky
Program: Pretek6.pas
File exe: Pretek6.exe
You can use the program to information about athletes Winter Olympic Game. The program can be viewed, edited, entered start times, and show order list.
{ pretek6.pas } { Pomocou programu je mozne viest zaznamy o ucastnikoch ZOH. } { Je mozne zoznam prezerat, editovat, zadavat startovacie casy } { vypisat poradie ucastnikov. } { } { Author: Ľuboš Saloky } { Datum: 01.01.1996 http://www.trsek.com } program preteky; uses Crt; type ucastnik=record {charakteristika ucastnika} meno,priezvisko,krajina:string; cislo:byte; shod,chod:0..23; smin,cmin:0..59; {s - cas startu} ssec,csec,sec:real; {c - cas ciela, bez pismena = celkovy cas} end; subor=file of ucastnik; {ucastnici v subore} var sutaz:ucastnik; nadisk:subor; {ucastnici budu v subore na disku} pocet,x,y,z,a,d,pom2,pom3,volba,volba2,cis,pom4:integer; pom1,sekundy:real; c:char; s:string; begin textbackground(0);clrscr; s:='c:data.dat'; textattr:=white+16*black+blink; writeln('Program pre zimne olympijske hry.'); textattr:=white+16*black; writeln('---------------------------------'); writeln(' Pomocou tohto programu mozes viest zaznamy o ucastnikoch ZOH, mozes'); writeln('si zoznam prezerat, editovat, zadavat startovacie casy a vypisat poradie'); writeln('ucastnikov.'); writeln(''); writeln(' Stlac akykolvek klaves'); repeat until keypressed; c:=readkey; window(15,14,43,18);textbackground(yellow);clrscr; writeln('Zapis ucastnikov:'); writeln(''); writeln(' 1 - do existujuceho zoznamu'); writeln(' 2 - novy zoznam'); c:=readkey; volba2:=ord(c)-48; case volba2 of 1:begin assign(nadisk,s); reset(nadisk); x:=filesize(nadisk); pocet:=x; seek(nadisk,x); end; {end of case 1.1} 2:begin assign(nadisk,s); rewrite(nadisk); pocet:=0; end; {end of case 1.2} end; window(15,14,43,18);textbackground(black);clrscr; repeat window(10,10,49,17);textbackground(red);clrscr; writeln('1 - okienko sponzora'); writeln('2 - zapis ucastnika'); writeln('3 - zrusenie ucastnika'); writeln('4 - vypis ucastnikov podla start. cisla'); writeln('5 - cas startu, cas ciela'); writeln('6 - vypis ucastnikov podla poradia'); writeln('7 - koniec prace'); c:=readkey; volba:=ord(c)-48; case volba of {hlavny cyklus} 2:begin window(13,13,40,19);textbackground(green);clrscr; textcolor(red); writeln(' Zadavanie ucastnika'); writeln(' -------------------'); textcolor(white); write('Meno:');readln(sutaz.meno); write('Priezvisko:');readln(sutaz.priezvisko); write('Krajina:');readln(sutaz.krajina); pocet:=pocet+1; sutaz.cislo:=pocet; sutaz.sec:=0; write(nadisk,sutaz); window(13,13,40,19);textbackground(black);clrscr; end; {end of case 2} 3:begin window(13,13,41,19);textbackground(green);clrscr; textcolor(red); writeln(' Zrusenie ucastnika'); writeln(' ------------------'); textcolor(white); writeln('Ktore startove cislo?'); readln(x); if x<=filesize(nadisk) then begin seek(nadisk,x-1); read(nadisk,sutaz); sutaz.meno:='delucast'; sutaz.sec:=0; seek(nadisk,x-1); write(nadisk,sutaz); end {end of then in if in case 3} else begin writeln('Taky sutaziaci neexistuje'); c:=readkey; end; {end of else in if in case 3} window(13,13,41,19);textbackground(black);clrscr; end; {end of case 3} 4:begin window(3,8,77,11);textbackground(green);clrscr; textcolor(red); writeln(' Prezeranie ucastnikov'); writeln('-----------------------------------------------------------'); textcolor(white); window(3,11,77,22);clrscr; writeln(''); d:=0; for x:=0 to pocet-1 do begin seek(nadisk,x); read(nadisk,sutaz); if sutaz.meno<>'delucast' then begin d:=d+1; gotoxy(1,d); writeln('Meno:',sutaz.meno); gotoxy(15,d); writeln('Priezvisko:',sutaz.priezvisko); gotoxy(36,d); writeln('Krajina:',sutaz.krajina); gotoxy(56,d); writeln('Startovacie cislo:',sutaz.cislo); end; {endif of case 4} end; {end of for in case 4} c:=readkey; window(3,8,77,22);textbackground(black);clrscr; end; {end of case 4} 5:begin window(15,11,69,23);textbackground(magenta);clrscr; writeln('Zadavanie casov startu a ciela'); writeln('------------------------------'); write('Startovne cislo sutaziaceho:'); readln(cis); if cis>filesize(nadisk) then begin writeln('Taky sutaziaci neexistuje'); c:=readkey; end {end of then in if in case 5} else begin writeln(''); seek(nadisk,cis-1); read(nadisk,sutaz); if (sutaz.sec=0) and (sutaz.meno<>'delucast') then begin writeln('Zadavanie casu pre sutaziaceho:',sutaz.meno,' ',sutaz.priezvisko); writeln(''); write('Cas startu - hodiny: ');readln(sutaz.shod); write(' minuty: ');readln(sutaz.smin); write(' sekundy:');readln(sutaz.ssec); writeln(''); write('Cas ciela - hodiny: ');readln(sutaz.chod); write(' minuty: ');readln(sutaz.cmin); write(' sekundy:');readln(sutaz.csec); sutaz.sec:=(sutaz.chod-sutaz.shod)*3600+(sutaz.cmin-sutaz.smin)*60+sutaz.csec-sutaz.ssec; seek(nadisk,cis-1); write(nadisk,sutaz); end {end of then in if in else in if in case 5} else begin write('Casy nemozu byt zadane,pretoze '); if sutaz.meno='delucast' then writeln('ucastnik bol zruseny'); if sutaz.sec<>0 then writeln('uz si ich zadal.'); c:=readkey; end; {end of else in if in else in if in case 5} end; {end of else in if in case 5} window(15,11,69,23);textbackground(black);clrscr; end; {end of case 5} 6:begin window(16,11,56,20);textbackground(Cyan);clrscr; writeln('Vypis ucastnikov podla dosiahnuteho casu'); writeln('----------------------------------------'); pom2:=filesize(nadisk)-1; pom1:=0; pom4:=0; for y:=0 to pom2 do begin for z:=0 to pom2 do begin seek(nadisk,z); read(nadisk,sutaz); if (sutaz.sec>pom1) and (sutaz.meno<>'delucast') and (sutaz.shod<>25) then begin pom3:=z; pom4:=1; end; {endif in case 6} end; {end of for in case 6} if pom4=1 then begin seek(nadisk,pom3); read(nadisk,sutaz); write(sutaz.meno,':'); cis:=trunc(sutaz.sec/60); sekundy:=sutaz.sec-cis*60; writeln(cis,' minut ',sekundy:2:2,' sekund'); pom1:=sutaz.sec; end; {endif in case 6} pom4:=0; end; {end of second for in case 6} repeat until keypressed; window(16,11,56,20);textbackground(Black);clrscr; end; {end of case 6} end; {end of case total} until volba=7; end.