{ SOPKY.PAS Copyright (c) Miroslav Lízal, Tomáš Okurek } { Evidencia sopiek vo svete. } { } { Datum:25.04.2003 http://www.trsek.com } program hora_zaznamu; uses crt; type zaznam=record jm:string; vy:integer; st:string; ci:boolean; end; type pole=array[1..10] of zaznam; var p:pole; ps:integer; nabidka:integer; procedure nacti(var cislo:integer); var cinnost:char; begin cislo:=cislo+1; clrscr; writeln; write(' Jmeno: '); readln(p[cislo].jm); write(' Stat: '); readln(p[cislo].st); write(' Vyska: '); readln(p[cislo].vy); write(' Cinnost[a/n]: '); readln(cinnost); if cinnost='a' then p[cislo].ci:=true else p[cislo].ci:=false; end; procedure vypis(cislo:integer); var i:integer; co:integer; cinnost:string; begin clrscr; writeln; writeln(' Seznam sopek:'); for i:=1 to cislo do writeln(' ',i,' ',p[i].jm); writeln; write(' Zadejte cislo sopky kterou chcete vypsat: '); readln(co); writeln; writeln(' Jmeno: ',p[co].jm); writeln(' Stat: ',p[co].st); writeln(' Vyska: ',p[co].vy); if p[co].ci=true then cinnost:='je' else cinnost:='neni'; writeln(' Cinnost: sopka ',cinnost,' cinna'); readln; end; procedure vyvso(cislo:integer); var cinnost:string; co:integer; begin clrscr; for co:=1 to cislo do begin writeln; writeln(' Jmeno: ',p[co].jm); writeln(' Stat: ',p[co].st); writeln(' Vyska: ',p[co].vy); if p[co].ci=true then cinnost:='je' else cinnost:='neni'; writeln(' Cinnost: sopka ',cinnost,' cinna'); delay(500); end; readln; end; procedure oprav(cislo:integer); var cinnost:string; opravdu:char; i:integer; co:integer; begin clrscr; writeln; writeln(' Seznam sopek:'); for i:=1 to cislo do writeln(' ',i,' ',p[i].jm); writeln; write(' Zadejte cislo sopky kterou chcete upravit: '); readln(co); writeln; writeln; writeln(' Jmeno: ',p[co].jm); writeln(' Stat: ',p[co].st); writeln(' Vyska: ',p[co].vy); if p[co].ci=true then cinnost:='je' else cinnost:='neni'; writeln(' Cinnost: sopka ',cinnost,' cinna'); write('Opravdu chcete tento zaznam upravit[a/n]: '); readln(opravdu); if opravdu='a' then begin writeln; write(' Jmeno: '); readln(p[co].jm); write(' Stat: '); readln(p[co].st); write(' Vyska: '); readln(p[co].vy); write(' Cinnost[a/n]: '); readln(cinnost); if cinnost='a' then p[cislo].ci:=true else p[cislo].ci:=false; end; end; procedure vymaz(var cislo:integer); var i:integer; co:integer; opravdu:char; cinnost:string; begin clrscr; writeln; writeln(' Seznam sopek:'); for i:=1 to cislo do writeln(' ',i,' ',p[i].jm); writeln; write(' Zadejte cislo sopky kterou chcete smazat: '); readln(co); writeln; writeln; writeln(' Jmeno: ',p[co].jm); writeln(' Stat: ',p[co].st); writeln(' Vyska: ',p[co].vy); if p[co].ci=true then cinnost:='je' else cinnost:='neni'; writeln(' Cinnost: sopka ',cinnost,' cinna'); write('Opravdu chcete tento zaznam upravit[a/n]: '); readln(opravdu); if opravdu='a' then begin for i:=co to cislo-1 do begin p[i]:=p[i+1]; cislo:=cislo-1; end; end; end; begin ps:=0; textbackground(1); repeat clrscr; textcolor(3); writeln; writeln; writeln(' Co chcete delat?'); writeln; textcolor(15); writeln(' 1 Nova sopka'); writeln; writeln(' 2 Upravit sopku'); writeln; writeln(' 3 Smazat sopku'); writeln; writeln(' 4 Vypsat sopku'); writeln; writeln(' 5 Vypsat vsechny sopky'); writeln; textcolor(10); writeln(' 9 Konec'); textcolor(15); writeln; write(' Nabidka cislo: '); readln(nabidka); case nabidka of 1: nacti(ps); 2: oprav(ps); 3: vymaz(ps); 4: vypis(ps); 5: vyvso(ps); end; until nabidka=9; end.