iforum

Prosim pomozte mi:
2. Do nádoby tvaru valca sú vložené rôznofarebné guličky. Používateľ zadá farbu guličky, o ktorú má záujem. Program vypočíta, koľko najmenej guličiek musí vybrať, aby medzi vybranými guličkami bola aspoň jedna zvolenej farby. V prípade, že sa gulička vo valci nenachádza, program vypíše oznam. Program skončí v okamihu, keď vie odpovedať.
· Vo valci sú znova rôznofarebné guličky. Na každej je napísané poradové číslo vo valci. Používateľ zadá farbu guličky, o ktorú má záujem. Z valca sa do iného valca preložia všetky guličky zvolenej farby. Program vypíše všetky poradové čísla guličiek zvolenej farby. V prípade, že sa gulička vo valci nenachádza, program vypíše oznam.

{ uloha dva sa sklada z dvoch samostatnych programov. okomentuj a uprav program }

uses crt;
const n=20;
var a:array[1..n] of integer;
i:byte;
procedure generuj;
begin
randomize;
for i:=1 to n do a[i]:=random(15)+1;
end;
procedure vzorkovnik;
begin
for i:=1 to 7 do
begin
textcolor(i);
write(i:5);
textcolor(8+i);
writeln(8+i:5);
end;
textcolor(8);
writeln(8:5);
writeln;
end;
procedure vypis;
begin
textcolor(15);
for i:=1 to n do write(i:2,'. ');
writeln;
for i:=1 to n do
begin
textcolor(a[i]);
write('':2,' ');
end;
writeln;
end;
procedure kde_je;
var nasiel:boolean;
x:byte;
begin
write('Zadaj cislo farby, kt. chces najst: ');
readln(x);
i:=1;nasiel:=false;
while (i<=n) and not nasiel do
begin
nasiel:=a[i]=x;
inc(i);
end;
if nasiel then writeln('Musis vybrat ',i-1,' guliciek.')
else writeln('Gulicka tvojej farby tam nie je.')
end;
begin
clrscr;
generuj;
vzorkovnik;
textcolor(15);
kde_je;
vypis;
readln
end.

{ druhy}

uses crt;
const n=20;
var a:array[1..n] of integer;
i:byte;
procedure generuj;
begin
randomize;
for i:=1 to n do a[i]:=random(15)+1;
end;
procedure vzorkovnik;
begin
for i:=1 to 7 do
begin
textcolor(i);
write(i:5);
textcolor(8+i);
writeln(8+i:5);
end;
textcolor(8);
writeln(8:5);
writeln;
end;
procedure vypis;
begin
textcolor(15);
for i:=1 to n do write(i:2,'. ');
writeln;
for i:=1 to n do
begin
textcolor(a[i]);
write('':2,' ');
end;
writeln;
end;
procedure vsetky_vyskyty;
var j,x:byte;
b:array[1..n] of byte;
begin
write('Zadaj cislo farby, kt. chces najst: ');
readln(x);
j:=0;
for i:=1 to n do b[i]:=0;
for i:=1 to n do
if a[i]=x then begin inc(j);b[j]:=i;end;
if j<>0 then writeln('Cisla na gulickach tvojej farby su: ')
else writeln('Gulicka tvojej farby tam nie je.');
for i:=1 to j do write(b[i]:3);
writeln;
end;
begin
clrscr;
generuj;
vzorkovnik;
textcolor(15);
vsetky_vyskyty;
writeln;
vypis;
readln
end.