'''Ukážka programov'''
hviezd.
'' procedure TForm1.Button1Click(Sender: TObject);
var i,pocet:integer;
veta:string;
begin
veta:=edit1.text;
pocet:=0;
for i:=1 to length(veta) do
if veta=' ' then
begin
veta:='*';
inc(pocet);
end;
label2.caption:=veta;
label3.caption:= 'Počet výmen je '+inttostr(pocet);
end; ''
___loto
procedure TForm1.Button1Click(Sender: TObject);
var i,j,tip:integer;
cislo: array[1..6] of integer ;
jetam:boolean;
f:textfile;
begin
randomize;
memo1.Clear;
assignFile(f,'C:\Users\Jozef\Desktop\Maturita INF\P2 Loto\loto.txt');
rewrite(f);
for i:=1 to 6 do
begin
repeat
tip:= random(49)+1;
jetam:=false;
for j:=1 to i-1 do
if tip= cislo[j] then jetam:=true;
until jetam=false;
cislo:=tip;
end;
for i:=1 to 6 do
begin
memo1.lines.add(inttostr( cislo));
writeln(f,cislo);
end;
closefile(f);
end;
____kvadr.
procedure TForm1.Button1Click(Sender: TObject);
var a,b,c,D,x1,x2:real;
begin
a:=strtofloat(edit1.text);
b:=strtofloat(edit2.text);
c:=strtofloat(edit3.text);
if a=0 then label4.caption:='a nesmie byť 0!'
else
begin
D:=b*b-(4*a*c);
if D<0 then label4.caption:='Rovnica nemá v R riešenie.' ;
if D=0 then label4.caption:='x='+floatTOstr(-b/(2*a)) ;
if D>0 then
begin
x1:= -b-sqrt(D)/(2*a);
x1:=round(x1*1000)/1000 ;
x2:= -b+sqrt(D)/(2*a);
x2:=round(x2*1000)/1000 ;
label4.caption:='x1='+floatTOstr(x1)+', x2='+floatTOstr(x2) ;
end;
end;
___konkurz
procedure TForm1.Button1Click(Sender: TObject);
type zaznam=record
meno:string;
vyska:integer;
end;
var
pocet,i,max:integer;
uchadzac: array[1..100] of zaznam;
begin
pocet:=strtoint(edit1.text);
for i:=1 to pocet do
begin
uchadzac.meno:=inputbox('Zadaj','meno:','');
uchadzac.vyska:=strtoint(inputbox('Zadaj','výška:',''));
end;
max:=1;
for i:=2 to pocet do
if uchadzac.vyska>uchadzac[max].vyska then max:=i;
label2.caption:= uchadzac[max].meno ;
end;
___cif.suc
procedure TForm1.Button1Click(Sender: TObject);
var n,c,sucet:integer;
begin
image1.canvas.FillRect(image1.clientrect);
n:=strtoint(edit1.text);
sucet:=0;
while n<>0 do
begin
c:=n mod 10;
n:= n div 10;
sucet:=sucet + c;
end;
image1.canvas.textout(20,20,'Ciferný súčet je '+inttostr(sucet)+'.')
end;
___ prevod z 10
procedure TForm1.Button1Click(Sender: TObject);
var c,p,i,sustava:integer;
vysledok:string;
a:array[1..100]of integer;
begin
c:=strTOint(edit1.text);
vysledok:='';
p:=0;
sustava:= strTOint(edit2.text);
while c<>0 do
begin
inc(p);
a[p]:=c mod sustava;
c:=c div sustava;
end;
for i:=p downto 1 do vysledok:=vysledok+intTOstr(a) ;
label2.Caption:=vysledok;
end;
____prevod do 10
procedure TForm1.Button1Click(Sender: TObject);
var i,pocet,sustava,vysledok:integer;
zvysok:string;
function vporiadku(var zvysok:string;sustava:integer):boolean ;
var i:integer;
begin
vporiadku:=true;
for i:=1 to length(zvysok) do if strtoint(zvysok)>sustava-1 then vporiadku:=false;
end;
begin
sustava:=strtoint(edit1.text);
zvysok:=edit2.text;
pocet:=length(zvysok);
vysledok:=0;
if vporiadku(zvysok,sustava)=true then
begin
for i:=1 to pocet do vysledok:=vysledok*sustava+strtoint(zvysok);
label3.Caption:=inttostr(vysledok);
end
else showmessage('Číslo '+zvysok+' v danej sústave neexistuje!')
end;
___cislo od zadu
procedure TForm1.Button1Click(Sender: TObject);
var cislo,nove,zvysok:integer;
begin
cislo:=strTOint(edit1.text);
nove:=0;
repeat
zvysok:=cislo mod 10;
nove:=nove*10+zvysok;
cislo:=cislo div 10;
until cislo=0;
label2.Caption:=intTOstr(nove);
end;"
____lin. rovnica
procedure TForm1.Button1Click(Sender: TObject);
var a,b:real;
begin
a:=strTOfloat(edit1.text);
b:=strTOfloat(edit2.text);
if (a=0) AND (b<>0) then showmessage('Rovnica nemá riešenie, lebo a=0.');
if (a=0) AND (b=0) then showmessage('Rovnica má nekonečne veľa riešení');
if (a<>0) AND (b<>0) then showmessage('Riešenie rovnice:'+floattostr(-b/a));
end;
___nakup
procedure TForm1.Button1Click(Sender: TObject);
var pocet:integer;
cena,spolu:real;
begin
cena:=strtofloat(edit1.text);
pocet:=strTOint(edit2.text);
if pocet<6 then spolu:=cena*pocet;
if ((pocet>5) AND (pocet<106)) then spolu:=5*cena+0.8*cena*(pocet-5);
if pocet >105 then spolu:=5*cena+0.8*cena*100+0.5*cena*(pocet-105);
label3.caption:= 'Treba zaplatiť '+floatTOstr(spolu);
end;
___palindrom
procedure TForm1.Button1Click(Sender: TObject);
var slovo:string;
odpoved:boolean;
d,i:integer;
begin
slovo:=edit1.text;
odpoved:=true;
d:= length(slovo);
for i:=1 to (d div 2) do
if AnsiUpperCase(slovo)<> AnsiUpperCase(slovo[d-i+1]) then odpoved:=false;
if odpoved=true
then label2.caption:='Slovo je palindrom'
else label2.caption:='Slovo nie je palindrom'
end;
____hadaj cislo
procedure TForm1.Button1Click(Sender: TObject);
begin
randomize;
cislo:=random(10)+1;
i:=0;
end;
procedure TForm1.Button2Click(Sender: TObject);
var typ:integer;
begin
inc(i);
typ:=strtoint(edit1.text);
if typ<cislo then showmessage('Hádaj väčšie!');
if typ>cislo then showmessage('Hádaj menšie!');
if typ=cislo then showmessage('Hádaj väčšie!');
end;
____pismena v mene
procedure TForm1.Button1Click(Sender: TObject);
function sanachadza(var slovo:string; i:integer):boolean ;
var j:integer;
begin
sanachadza:=false;
for j:=1 to i-1 do
if slovo[j]= slovo then sanachadza:=true;
end ;
var i,pocet:integer;
meno:string;
begin
meno:=edit1.text;
pocet:=0;
for i:=1 to length(meno) do
if sanachadza(meno,i)=false then inc(pocet);
label2.caption:=intTOstr(pocet);
end;
____nasobilka
procedure TForm1.Button1Click(Sender: TObject);
var n,i,c1,c2,tip,vysledok,pocet:integer;
begin
randomize;
n:=strTOint(edit1.text);
pocet:=0;
for i:=1 to n do
begin
c1:=random(10)+1;
c2:=random(10)+1;
vysledok:=c1*c2;
memo1.lines.add(intTOstr(c1)+'*'+intTOstr(c2)+'=');
tip:=strTOint(inputBox('','výsledok:',''));
memo1.Lines.delete(i);
if vysledok=tip
then
begin
memo1.lines.add(intTOstr(c1)+'*'+intTOstr(c2)+'='+intTOstr(tip)+' - správne');
inc(pocet);
end
else
memo1.lines.add(intTOstr(c1)+'*'+intTOstr(c2)+'='+intTOstr(tip)+' - chyba');
end;
label3.caption:='Počet správnych odpovedí je '+inttostr(pocet);
end;
___dokonale cislo
procedure TForm1.Button1Click(Sender: TObject);
var cislo,sucet,i:integer;
f:textfile;
begin
//cislo:=strTOint(edit1.text);
assignfile(f,'dokonale.txt');
rewrite(f);
for cislo:=1 to 100 do
begin
sucet:=0;
for i:=1 to cislo-1 do if cislo mod i=0 then sucet:=sucet+i;
if sucet=cislo then writeln(f,cislo);
end;
closefile(f);
end;
%%%%%%%%%%%faktorial rek.
procedure TForm1.Button1Click(Sender: TObject);
var n,i:integer;
slovo:string;
test:boolean;
function faktorial(c:integer):integer;
begin
if c=1 then faktorial:=1 else faktorial:=c*faktorial(c-1);
end;
begin
slovo:= edit1.text ;
test:=true;
for i:=1 to length(slovo) do if ((slovo<>'1') and
(slovo<>'2') and
(slovo<>'3') and
(slovo<>'4') and
(slovo<>'5') and
(slovo<>'6') and
(slovo<>'7') and
(slovo<>'8') and
(slovo<>'9') and
(slovo<>'0') )
then test:=false;
if test=false then showmessage('Zadaj prirodzené číslo')
else
begin
n:=strtoint(slovo);
if n=0 then showmessage('Zadaj prirodzené číslo')
else label2.Caption:=intTOstr(faktorial(n));
end;
end;
___odpor
procedure TForm1.Button1Click(Sender: TObject);
var r1,r2,R:real;
begin
r1:=strTOfloat(edit1.text);
r2:=strTOfloat(edit2.text);
IF ((radiobutton1.checked=false) and (radiobutton2.checked=false)) then
showmessage('Označ spôsob zapojenia')
else
begin
if radiobutton1.checked=true then R:=(r1*r2)/(r1+r2);
if radiobutton2.checked=true then R:=(r1+r2);
label4.caption:=floattostr(round(R*100)/100);
end;
end;
___korcule
procedure TForm1.Button1Click(Sender: TObject);
var i,n,min,max,sucet:integer;
z:array[1..50] of integer;
begin
n:=strtoint(edit1.text);
max:=0;
min:=10;
sucet:=0;
for i:= 1 to n do
begin
z:=strtoint(inputbox('Známka','Porotca č. '+inttostr(i),'')) ;
sucet:=sucet+ z;
if z>max then max:=z;
if z<min then min:=z;
end;
priemer:=(sucet-min-max)/(n-2);
button2.enabled:=true;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
label2.caption:=floattostr(priemer);
end;
____1000obd
procedure TForm1.Button1Click(Sender: TObject);
var i,x,y:integer;
begin
randomize ;
for i:=1 to 1000 do
begin
x:=random(image1.width-30);
y:=random(image1.height-30);
Image1.canvas.Brush.color:=Random(clwhite);
image1.Canvas.Rectangle(x,y,x+30,y+30);
end;
end;
___delitel moc
procedure TForm1.Button2Click(Sender: TObject);
var a,b,mocnina,i:integer;
begin
a:=strtoint(Edit1.text);
b:=strtoint(Edit2.text) ;
mocnina:=1;
for i:=1 to b do mocnina:=mocnina*a;
image1.canvas.textOut(50,20,inttostr(mocnina));
end;
procedure TForm1.Button1Click(Sender: TObject);
var a,b,d,n:integer;
begin
a:=strtoint(Edit1.text);
b:=strtoint(Edit2.text) ;
image1.canvas.fillrect(image1.clientrect);
while a<>b do
if a>b then a:=a-b else b:=b-a;
d:=a ;
image1.canvas.textOut(20,20,inttostr(d));
end;
____semafor
procedure TForm1.Timer1Timer(Sender: TObject);
begin
case stav of
0:begin
shape1.Brush.color:=clred;
shape2.Brush.color:=clsilver;
shape3.Brush.color:=clsilver;
end;
1:begin
shape1.Brush.color:=clred;
shape2.Brush.color:=clyellow;
shape3.Brush.color:=clsilver;
end;
2: begin
shape1.Brush.color:=clsilver;
shape2.Brush.color:=clsilver;
shape3.Brush.color:=clgreen;
end;
3:begin
shape1.Brush.color:=clsilver;
shape2.Brush.color:=clyellow;
shape3.Brush.color:=clsilver;
end;
end;
stav:=stav+1;
stav:=stav mod 4;
end;
initialization
stav:=0;
____lim joe
procedure TForm1.Button1Click(Sender: TObject);
var krcma,doma,cesta,i:integer;
begin
memo1.clear;
randomize;
krcma:=0;
doma:=0;
for i:=1 to 365 do
begin
cesta:=80;
repeat
if random(2)=1 then cesta:=cesta+10
else cesta:=cesta-10 ;
until (cesta=0) or (cesta=100);
if cesta=0 then inc(doma)
else inc(krcma);
end;
memo1.lines.add('Doma ostal '+intTOstr(doma)+'-krát.');
memo1.lines.add('Do krčmy išiel '+intTOstr(krcma)+'-krát.');
end;
____je prvoc.
procedure TForm1.Button1Click(Sender: TObject);
var cislo:integer;
function madelitela(var cisslo:integer):boolean;
var i:integer;
begin
madelitela:=false;
for i:=2 to (cisslo-1) do if cisslo mod i=0 then madelitela:=true;
end;
begin
cislo:=strTOint(edit1.text);
if madelitela(cislo)=true then showmessage('Číslo '+intTOstr(cislo)+' nie je prvočíslo')
else showmessage('Číslo '+intTOstr(cislo)+' je prvočíslo');
end;
___________sifra
procedure TForm1.Button1Click(Sender: TObject);
var slovo,nove:string;
i:integer;
begin
randomize;
slovo:=edit1.text;
nove:='';
for i:=1 to length(slovo) do
begin
nove:=nove+slovo;
nove:=nove+chr(random(26)+97);
end;
label1.caption:=nove;
end;
___________boom
procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
f:text;
function cs(cislo:integer):integer;
begin
cs:=0;
while cislo<>0 do
begin
cs:=cs + (cislo mod 10);
cislo:=cislo DIV 10;
end
end;
begin
assignFILE(f,'C:\odpoved.txt');
rewrite(f);
for i:=1 to 50 do
if (i mod 10=7) or (i mod 7=0) or (cs(i)=7) then writeln(f,'BOOM')
else writeln(f,i);
closeFILE(f);
end;
________percenta
procedure TForm1.Button1Click(Sender: TObject);
var
f:textfile;
i,cislo,k,j:integer;
a,pocet:array[1..100] of integer;
percenta :array[1..100] of real;
begin
image1.canvas.fillrect(image1.clientRect);
Randomize;
assignfile(f,'E:\sto.txt');
rewrite(f) ;
for i:=1 to 100 do
begin
cislo:=Random(12)+4;
a:=cislo;
writeln(f,cislo);
end;
for i:=4 to 15 do //ktoré čísla hľadá: 4, 5...15
begin
pocet:=0;
for j:=1 to 100 do //kde hľadá čísla
if a[j]=i then inc (pocet);
percenta:=(pocet/100)*100;
end;
k:=1;
for i:=4 to 15 do
begin
image1.canvas.textout(20,20*k,intTOstr(i)+' je '+floatTOstr(percenta)+'%') ;
inc(k);
end;
closefile(f);
end;
____najdlhsie slovo
procedure TForm1.Button1Click(Sender: TObject);
var
f:textfile;
riadok,maxS:string;
maxD,dlzka:integer;
begin
assignfile(f,'E:\slova.txt');
reset(f);
readln(f,riadok);
maxS:= riadok;
maxD:=length(riadok) ;
repeat
readln(f,riadok);
dlzka:=length(riadok);
if dlzka>maxD then
begin
maxS:=riadok;
maxD:=dlzka ;
end;
until eof(f);
label1.caption:='Najdlhšie slovo v súbore je '+maxS+' a má '+intTOstr(maxD)+' znakov.';
closefile(f);
end;
_____fibonaci
procedure TForm1.Button1Click(Sender: TObject);
var n,i,r,s:integer;
a:array[1..100] of integer;
begin
image1.canvas.FillRect(image1.clientRect);
n:=strtoint(edit1.text);
if (n<0) or (n>30) then image1.canvas.textout(20,20,'Zadal si zle číslo')
else
begin
a[1]:=1;
a[2]:=1;
r:=1;
s:=1;
for i:=3 to n do a:= a[i-2] + a[i-1];
for i:=1 to n do
begin
if (i mod 10 )=0 then
begin
inc(r);
s:=1;
end
else inc(s);
image1.canvas.textOut(40*s,20*r,inttostr(a));
end;
end;
end;
______cezar
procedure TForm1.Button1Click(Sender: TObject);
var slovo:string;
znak:string;
i,n,cislo:integer;
begin
slovo:=edit1.text;
slovo:=UpperCase(slovo);
n:=strtoint(edit2.text);
for i:=1 to length(slovo) do
begin
if slovo<>' ' then
begin
cislo:=ord(slovo)+n;
if cislo>90 then cislo:=cislo-26;
slovo:=chr(cislo);
end;
end;
label1.caption:=slovo
end;
_________triedenie
procedure TForm1.Button1Click(Sender: TObject);
var i,j,p,n:integer;
a:array[1..50] of integer;
f:textfile;
begin
n:=strtoint(edit1.text);
if n
randomize;
for i:=1 to n do a:=Random(100)+1;
for i:= 1 to n-1 do
for j:=i+1 to n do
if a[j]>a then
begin
p:=a[j];
a[j]:=a;
a:=p;
end;
assignfile(f,'odpoved.txt');
rewrite(f);
for i:=1 to n do writeln(f,a );
closefile(f);
Recent
