Kód: Vybrat vše
program Kucharka;
uses crt;
type recepty=record
nazev,vyber,postup:string;
pocetsurovin,doba,strana,pocet:integer;
surovina: array [1..50] of string end;
var SC,NC: file of recepty;
recept:recepty;
rozhod:char;
var m,n,t,v,i,j,min,min1,min2:integer;
procedure PRIDAT;
var P,m,n : integer;
begin
seek(SC,filesize(SC));
writeln(' Pis bez diakritiky!');
write(' Zapis nazev: ');readln(); readln(recept.nazev); writeln();
write(' Zapis dobu pripravy (v min): '); readln(recept.doba); writeln();
write(' Zapis pocet surovin: '); readln(recept.pocetsurovin); writeln();
m:=recept.pocetsurovin;
recept.strana:=filesize(SC)+1;
n:=0;
repeat
n:=n+1;
write(' Zapis ', n,'. surovinu: '); readln(recept.surovina[n]);writeln();
until n=m;
write(' Zapis postup pripravy: '); readln(recept.postup); writeln();
write(SC,recept);
close(SC); reset(SC);
end;
procedure VYPIS;
begin
m:=10;
gotoxy(5,10);
writeln('Nazev receptu');
gotoxy(40,10);
writeln ('Doba pripravy');
reset(SC);
while not eof(SC) do begin
m:=m+1;
read(SC,recept);
gotoxy(5,m);
write(recept.nazev);
gotoxy(40,m);
write(recept.doba,' min');
gotoxy(60,m);
write('..........', recept.strana);
end;
if eof(SC) then writeln();writeln();
if eof(SC) then writeln('Zmackni libovolnou klavesu pro pokracovani');
if eof(SC) then readkey();
end;
procedure VYBER1;
begin
write('Napiste pozadovanou dobu pripravy (v min): '); readln(t); writeln();
m:=10;
gotoxy(5,10);
writeln('Nazev receptu');
gotoxy(40,10);
writeln ('Doba pripravy');
reset(SC);
while not eof(SC) do begin
read(SC, recept);
if t>=(recept.doba) then begin
m:=m+1;
gotoxy(5,m);
write(recept.nazev);
gotoxy(40,m);
write(recept.doba, ' min' );
gotoxy(60,m);
write('..........', recept.strana); writeln();
end; end;
writeln();
write('Napis stranu vybraneho receptu: '); readln(v);
clrscr;
reset(SC);
while not eof(SC) do begin
read(SC, recept);
if v=(recept.strana) then begin
writeln(' Nazev: ', recept.nazev);
writeln(' Doba pripravy: ', recept.doba, ' min');
m:=(recept.pocetsurovin);
write(' Suroviny: ');
for n:=1 to m do begin
gotoxy(12,2+n); writeln(recept.surovina[n]);
end; writeln();
writeln(' Postup: ', recept.postup);
end; end;
if eof(SC) then writeln();writeln();
if eof(SC) then writeln('Zmackni libovolnou klavesu pro pokracovani');
if eof(SC) then readkey();
end;
[highlight=yellow]procedure SERAZENI1;
var serazeni,poradi: array [1..100] of integer;
poz1,poz2:boolean;
begin
n:=filesize(SC);
poz1:=true;poz2:=true;
i:=1;
reset(SC);
while not eof(SC) do begin
read(SC, recept);
serazeni[i]:=recept.pocetsurovin;
i:=i+1 end;
j:=0;
i:=j+1;
if serazeni[i]<serazeni[i+1] then begin min1:=serazeni[i]; t:=i; poradi[j+1]:=i end
else begin min1:=serazeni[i+1]; t:=i+1; poradi[j+1]:=i+1 end;
repeat
i:=i+1;
if serazeni[i]<min1 then begin min1:=serazeni[i]; t:=i; poradi[j+1]:=i end;
until i=n;
j:=1;
i:=0;
repeat
j:=j+1;
repeat
i:=i+1;
v:=0;
repeat
v:=v+1;
if i=poradi[v] then poz1:=false;
until (v=j-1)or(poz1=false);
if poz1=true then begin min2:=serazeni[i]; poradi[j]:=i end;
until poz1=true;
writeln(min2);poradi[j]:=i; readln();readln();
for i:=i+1 to n do begin
if (min1<serazeni[i])and(serazeni[i]<min2) then begin min2:=serazeni[i];poradi[j]:=i end;
if (serazeni[i]=min1) then begin
repeat
v:=v+1;
if i=poradi[v] then poz2:=false;
until (v=j)or(poz2=false);
if poz2=true then begin min2:=serazeni[i]; poradi[j]:=i end; end;end;
min1:=min2;
t:=poradi[j];
until j=n;
for j:=1 to n do begin
write(poradi[j], ', ') end; writeln();readln();readln();
m:=10;
for j:=1 to n do begin
reset(SC);
while not eof(SC) do begin
read(SC, recept);
if poradi[j]=(recept.strana) then begin
m:=m+1;
gotoxy(5,m);
write(j,'. ',recept.nazev);
gotoxy(40,m);
write(recept.doba, ' min' );
gotoxy(60,m);
write('..........', recept.strana); writeln();
end; end;end;
writeln();
write('Napis stranu vybraneho receptu: '); readln(v);
clrscr;
reset(SC);
while not eof(SC) do begin
read(SC, recept);
if v=(recept.strana) then begin
writeln(' Nazev: ', recept.nazev);
writeln(' Doba pripravy: ', recept.doba, ' min');
m:=(recept.pocetsurovin);
write(' Suroviny: ');
for n:=1 to m do begin
gotoxy(12,2+n); writeln(recept.surovina[n]);
end; writeln();
writeln(' Postup: ', recept.postup);
end; end;
if eof(SC) then writeln();writeln();
if eof(SC) then writeln('Zmackni libovolnou klavesu pro pokracovani');
if eof(SC) then readkey();
end;[/highlight]
procedure SMAZ;
begin
m:=10;
gotoxy(5,10);
writeln('Nazev receptu');
gotoxy(40,10);
writeln ('Doba pripravy');
reset(SC);
while not eof(SC) do begin
m:=m+1;
read(SC,recept);
gotoxy(5,m);
write(recept.nazev);
gotoxy(40,m);
write(recept.doba,' min');
gotoxy(60,m);
write('..........', recept.strana);
end;
writeln();writeln();
write('Napiste stranu receptu, ktery chcete smazat: '); readln(t);
reset(SC); writeln();
while not eof(SC) do begin
read(SC, recept);
if t=(recept.strana) then begin
writeln(' Nazev: ', recept.nazev);
writeln(' Doba pripravy: ', recept.doba, ' min');
m:=(recept.pocetsurovin);
write(' Suroviny: ');
for n:=1 to m do begin
gotoxy(12,15+filesize(SC)+n); writeln(recept.surovina[n]);
end; writeln();
writeln(' Postup: ', recept.postup);
end; end;
writeln('Opravdu chcete tento recept smazat? (A/N) ');
rozhod:=readkey;
if rozhod='a' then begin
clrscr;
assign(NC,'tmp.tmp'); {pomocny soubor}
reset(SC);
rewrite(NC);
for i:=1 to filesize(SC) do begin { do pomocneho souboru se prenesou }
read(SC,recept); { vsechny zaznamy, krome toho }
if recept.strana=t then continue { zadaneho }
else begin recept.strana:=filesize(NC)+1; write(NC,recept) end;end;
close(SC);
close(NC);
rewrite(SC);
reset(NC);
for i:=1 to filesize(NC) do begin
read(NC,recept); { zaznamy se prenesou zpet do hlavniho souboru }
write(SC,recept);
end;
close(SC);
close(NC);
erase(NC); { pomocny soubor se vymaze }
repeat until keypressed;
end; end;
begin //Hlavní program//
clrscr;
assign (SC, 'SEZNAM.DTA') ; {$I-}
reset (SC) ; {$I-}
if IOResult=0 then
begin write('Soubor SC jiz existuje. Zrusit? (A/N)');
rozhod:=readkey;
if rozhod='A' then begin rewrite(SC);
close (SC);
reset(SC);
end;
end
else begin rewrite(SC);
close(SC);
reset(SC);
end;
repeat
clrscr;
gotoxy(1,2);
writeln('Pridat recept...stiskni klavesu P');
writeln('Vypsat recepty...stiskni klavesu V');
writeln('Vybrat recepty podle doby pripravy...stiskni klavesu T');
writeln('Seradit recepty podle poctu surovin...stiskni klavesu S');
writeln('Seradit recepty podle doby pripravy...stiskni klavesu Z');
writeln('Smazat nektery z receptu v kucharce... stiskni klavesu D');
writeln('Konec programu....stiskni klavesu K');
read(rozhod);
if upcase(rozhod) in ['P','V','T','S','Z','D']
then case upcase(rozhod) of
'P':PRIDAT;
'V':VYPIS;
'T':VYBER1;
'S':SERAZENI1;
'Z':SERAZENI2;
'D':SMAZ;
end
until upcase(rozhod)='K';
end.(*Hlavni program*)
Dodatečně přidáno po 51 vteřinách:
vložil jsem celý program ať vidíte souvislosti, snad se nenaštvete