![]() |
Eugeniusz Jakubas |
Stąd można pobrać teksty źródłowe poniższych 57 programów w Pascalu pr-pascal.zip - 34 kB
1. Ciągi
Program Wykresy_ciagow;
uses Graph;
var karta,tryb,n,j:integer;
y:real;
function a(n:integer):real;
begin
a:=10/n;
end;
begin
karta:=detect; initGraph(karta,tryb,'');
j:=16;
setColor(darkGray);
for n:=10 to 640 div j do line(n*j+20,0,n*j+20,479);
for n:=-240 div j to 240 div j do line(160,240+n*j,639,240+n*j);
setcolor(white);
line(160,240,639,240); line(630,235,639,240); line(630,245,639,240);
outtextxy(630,250,'n');
line(180,0,180,479); line(175,9,180,0); line(180,0,185,9);
outtextxy(190,8,'an');
n:=0; setColor(lightBlue); setFillStyle(1,lightBlue);
repeat
n:=n+1;
y:=a(n);
writeLn(y:1:11);
if abs(y)<480 then fillEllipse(round(n*j+180),round(240-y*j),2,2);
until n>28;
readln; closeGraph;
end.
|
![]() |
2. Cykloida
Program Cykloida;
uses graph,crt;
var karta,tryb,n,i:integer;
begin
karta:=detect; initGraph(karta,tryb,'');
line(0,301,639,301);
for i:=0 to 160 do
begin
setColor(white);
fillEllipse(round(60*cos(1.9+i/19)+60+4*i),round(60*sin(1.9+i/19)+240),2,2);
line(60+4*i,240,round(60*cos(1.9+i/19)+60+4*i),round(60*sin(1.9+i/19)+240));
for n:=0 to 5 do
begin
setColor(n+1);
arc(60+4*i,240,n*60-3*i,(n+1)*60-3*i,60);
end;
delay(100);
setColor(black);
circle(60+4*i,240,60);
line(60+4*i,240,round(60*cos(1.9+i/19)+60+4*i),round(60*sin(1.9+i/19)+240));
end;
readln; closeGraph;
end.
|
![]() |
3. Deska Galtona
program Deska_Galtona;
uses graph,crt;
var karta,tryb,n,k,i,wi,ko,ilO : integer;
t:array[0..40] of integer;
begin
karta:=vga; tryb:=vgaHi; initGraph(karta,tryb,'');
randomize; bar(0,475,639,479);
for n:=0 to 40 do
for k:=1 to n+2 do fillEllipse(k*14+287-n*7,n*5+10,1,1);
for i:=1 to 400 do
begin
ko:=308; wi:=10; fillEllipse(ko,wi,2,2);
for n:=1 to 40 do
begin
setColor(black); setFillStyle(1,black); fillEllipse(ko,wi,2,2);
if random<0.5 then ko:=ko-7 else ko:=ko+7; wi:=wi+5;
setColor(lightRed); setFillStyle(1,lightRed); fillEllipse(ko,wi,2,2);
delay(50);
end;
setColor(black); setFillStyle(1,black); fillEllipse(ko,wi,2,2);
ilO:=(ko-28) div 14; t[ilO]:=t[ilO]+1;
setColor(lightRed); setFillStyle(1,lightRed); fillEllipse(ko,477-t[ilO]*4,2,2);
end;
readLn; closeGraph;
end.
|
![]() |
4. Dywan Ulama
program Dywan_Ulama;
uses graph;
var karta,tryb,pozX,pozY,D:integer;
liczba,i:longInt;
procedure sprawdzenie;
var k,spr:longInt;
begin
k:=1;
spr:=1;
repeat
k:=k+1;
if liczba mod k=0 then spr:=0;
until (liczba mod k=0) or (k>sqrt(liczba));
if spr=1 then putPixel(pozX,pozY,white);
end;
begin
karta:=detect; initGraph(karta,tryb,'');
liczba:=1; pozX:=320; pozY:=240; D:=0;
repeat
D:=D+2;
for i:=1 to D do
begin
liczba:=liczba+1; pozY:=pozY-1; sprawdzenie;
end;
for i:=1 to D do
begin
liczba:=liczba+1; pozX:=pozX-1; sprawdzenie;
end;
for i:=1 to D do
begin
liczba:=liczba+1; pozY:=pozY+1; sprawdzenie;
end;
for i:=1 to D do
begin
liczba:=liczba+1; pozX:=pozX+1; sprawdzenie;
end;
pozX:=pozX+1; pozY:=pozY+1;
until liczba>576000;
readLn; closeGraph;
end.
|
![]() |
5. Dywan Sierpińskiego
6. Ekstrema funkcji
Program Ekstrema_funkcji_Metoda_naturalna;
{$N+}
uses graph;
var karta,tryb,n:integer;
x,y,Dx,y1,y2:extended;
function f(x:extended):extended;
begin
f:=x+3/4-2*sin(x)-0.065
end;
begin
karta:=detect; initGraph(karta,tryb,'');
setColor(darkGray);
for n:=1 to 32 do line(n*20,0,n*20,479);
for n:=1 to 24 do line(0,n*20,639,n*20);
setColor(white); line(0,240,639,240); line(320,0,320,479);
x:=-16; Dx:=0.1;
repeat
x:=x+Dx;
y:=f(x); y1:=f(x+Dx); y2:=f(x+2*Dx);
if (y1<y) and (y1<y2) then Dx:=Dx/10;
if (y1>y) and (y1>y2) then Dx:=Dx/10;
if (Dx<1e-17) or ((y=y1)and(Dx<0.1)) then
begin
if abs(y)<12 then writeln('x=',x:22:18,', f(x)=',y:22:18);
Dx:=0.1;
end;
if abs(y)<12 then
putPixel(round(x*20+320),round(-y*20+240),yellow);
until x>16;
readLn; closeGraph;
end.
|
![]() |
7. Figury Sierpińskiego
program Figury_Sierpinskiego;
uses Graph,crt;
var karta,tryb,los,n_kat:integer;
x,y,r,skok:real;
begin
karta:=detect; initGraph(karta,tryb,'');
n_kat:=3; skok:=0.5; r:=120/skok; x:=0; y:=0;
repeat
putPixel(round(x+320),round(y+240),los);
los := random(n_kat) + 1;
x:=x+(r*cos(los*2*pi/n_kat)-x)*skok;
y:=y+(r*sin(los*2*pi/n_kat)-y)*skok;
until keyPressed;
closeGraph;
end.
|
![]() |
8. Funkcja pierwotna
Program Funkcja_pierwotna;
uses graph;
var karta,tryb,n,j,k:integer;
x,Dx,pierwotna:real;
function f(x:real):real;
begin
f:=cos(x);
end;
begin
karta:=detect; initgraph(karta,tryb,'');
j:=40;
setColor(darkGray);
for n:=-320 div j to 320 div j do line(320+n*j,0,320+n*j,479);
for n:=-240 div j to 240 div j do line(0,240+n*j,639,240+n*j);
setColor(white);
line(0,240,639,240); line(320,0,320,479);
x:=-320/j; pierwotna:=0; Dx:=0.001;
repeat
x:=x+Dx;
putPixel(round(x*j+320),round(-f(x)*j+240),lightBlue);
pierwotna:=pierwotna+f(x)*Dx;
for k:=-5 to 5 do
putPixel(round(x*j+320),round(-pierwotna*j+240+k*j),lightRed);
until x>320/j;
readln; closegraph;
end.
|
![]() |
9. Krzywe - epicykloidy
10. Krzywe - obwarzanek
Program Obwarzanek;
uses graph,crt;
var karta,tryb,n:integer;
x,y,r,alfa,beta:real;
const tk:array[1..4] of integer=
(lightCyan,lightRed,yellow,lightBlue);
begin
karta:=detect; initGraph(karta,tryb,'');
alfa:=0;
repeat
r:=160; beta:=alfa;
x:=r*cos(alfa)+320;
y:=r*sin(alfa)+240;
setColor(red);
fillEllipse(round(x),round(y),1,1);
r:=r/6; beta:=beta*12;
for n:=1 to 4 do
begin
x:=x+r*cos(beta+n*pi/2);
y:=y+r*sin(beta+n*pi/2);
setFillStyle(1,tk[n]); setColor(tk[n]);
fillEllipse(round(x),round(y),7,7);
end;
alfa:=alfa+0.005;
until (keyPressed) or (alfa>=2*pi);
readLn; closegraph;
end.
|
![]() |
11. Kwadrat sito
Program Sito;
uses Graph;
var karta,tryb,n,x,y,bok,gr:integer;
begin
karta:=detect;
initGraph(karta,tryb,'');
n:=1;
gr:=1;
bok:=256;
rectangle(0,0,bok,bok);
repeat
gr:=gr div 2;
bok:=bok div 2;
for x:=0 to n-1 do
for y:=0 to n-1 do
bar(bok+2*x*bok-gr,bok+2*y*bok-gr,
bok+2*x*bok+gr,bok+2*y*bok+gr);
n:=n*2;
readLn;
until bok=1;
CloseGraph;
end.
|
![]() |
12. Liczba e
Program e;
uses crt;
var n,k:integer;
a:real;
begin
clrScr;
for n:=1 to 100 do
begin
a:=1+1/n;
for k:=1 to n-1 do a:=a*(1+1/n);
writeLn(n,'. ',a:1:10);
end;
readLn;
end.
|
![]() |
13. Liczba p
program Liczba_pi_Algorytm_Gaussa_Legendrea;
{$N+}
uses crt;
var a, b, t, x, y:extended;
begin
clrScr;
a:=1; b:=1/sqrt(2); t:=1/4; x:=1;
writeLn(a:22:18,b:22:18,t:22:18);
writeLn('pi=',(a+b)*(a+b)/(4*t):22:18);
repeat
y:=a;
a:=(a+b)/2;
b:=sqrt(b*y);
t:=t-x*(y-a)*(y-a);
x:=2*x;
writeLn(a:22:18,b:22:18,t:22:18);
writeLn('pi=',(a+b)*(a+b)/(4*t):22:18);
until a-b<0.0000000000000000001;
writeln('pi=',pi:22:18);
readLn;
end.
|
![]() |
14. Liczby pierwsze
program Liczba_pierwsza;
uses crt;
var liczba,n:longint;
begin
clrScr;
liczba:=2147483647;
for n:=2 to round(sqrt(liczba)) do
if liczba mod n=0 then
begin
writeLn(liczba,'-liczba zlozona'); readLn; exit;
end;
textColor(lightRed);
writeLn(liczba,'-liczba pierwsza');
readLn;
end.
|
15. Miejsca zerowe funkcji
program Miejsca_zerowe_Metoda_stycznych;
{$N+}
uses crt;
var x : extended;
function f (x: extended): extended;
begin
f :=sin(x);
end;
begin
clrScr;
x := 2;
repeat
x:=x-f(x)/(f(x+0.000001)-f(x))*0.000001;
writeln('x = ',x:22:18,' f(x) = ',f(x):22:18);
until (abs(f(x)) < 1e-17);
readLn;
end.
|
![]() |
16. Monotoniczność funkcji
Program Ekstrema_funkcji_Metoda_naturalna;
{$N+}
uses graph;
var karta,tryb,n,j,kolor:integer;
x,y,Dx,y1,y2:extended;
function f(x:extended):extended;
begin
f:=x*x/(2*x*x-x-2)
end;
begin
karta:=detect; initGraph(karta,tryb,'');
j:=20;
setColor(darkGray);
for n:=-320 div j to 320 div j do line(n*j+320,0,n*j+320,479);
for n:=-240 div j to 240 div j do line(0,n*j+240,639,n*j+240);
setColor(white); line(0,240,639,240); line(320,0,320,479);
x:=-320/j; Dx:=0.00025;
repeat
x:=x+Dx;
y:=f(x); y1:=f(x+Dx); y2:=f(x+2*Dx);
if y1>y then kolor:=yellow else kolor:=lightRed;
if abs(y)<240/j then putPixel(round((x+Dx)*j+320),round(-y1*j+240),kolor);
if (y1<y) and (y1<y2) and (abs(y1)<240/j) then writeln('x=',x+Dx:18:14);
if (y1>y) and (y1>y2) and (abs(y1)<240/j) then writeln('x=',x+Dx:18:14);
if y*y1<0 then writeLn('x=',x+2*Dx:18:14);
until x>320/j;
readLn; closeGraph;
end.
|
![]() |
17. Nwd - algorytm Euklidesa
Program Najwiekszy_wspolny_dzielnik;
uses crt;
var a,b,nwd,r:integer;
begin
clrScr;
a:=1995;
b:=1957;
repeat
writeLn(a,' = ',a div b,'*',b,' + ',a mod b);
r:=a mod b;
a:=b;
b:=r;
until r=0;
writeLn('Nwd = ',a);
readLn;
end.
|
![]() |
18. Nww
program NWW;
uses crt;
var a,b,dz:longInt;
begin
clrScr;
a:=30;
b:=105;
dz:=1;
while dz*a mod b<>0 do dz:=dz+1;
writeLn('NWW(',a,',',b,') = ',dz*a);
readLn;
end.
|
19. Permutacje
program Permutacje;
uses crt;
var n,k,dl_slowa,il_permut,spr,poz,i,max:longInt;
slowo_wyj,slowo_0,slowo,slowo_st:string;
x:char;
t:array[1..255] of integer;
key:char;
const slowo_max:string='abcdefghijklmnoprstuvwxyz';
procedure sprawdz_i_wstaw(x:char;nr:integer);
begin
for k:=poz to dl_slowa do
if (slowo_st[k]=x) and (t[ord(x)]=0)
then begin
slowo[nr]:=x; spr:=1;
t[ord(x)]:=1;
end;
end;
begin
clrScr;
slowo_0:='AABEGLR';
dl_slowa:=length(slowo_0);
slowo:=copy(slowo_max,1,dl_slowa);
slowo_st:=slowo;
il_permut:=1;
writeLn(il_permut,'. ',slowo_0);
max:=1; for n:=1 to dl_slowa do max:=max*n;
repeat
for n:=1 to 255 do t[n]:=0;
n:=1;
while slowo[dl_slowa-n]>slowo[dl_slowa-n+1] do n:=n+1;
poz:=dl_slowa-n;
i:=0;
spr:=0;
repeat
x:=char(ord(slowo[poz])+1+i);
sprawdz_i_wstaw(x,poz);
i:=i+1;
until spr=1;
x:='!';
for n:=1 to dl_slowa-poz do
begin
i:=0;
spr:=0;
repeat
x:=char(ord(x)+1);
sprawdz_i_wstaw(x,poz+n);
i:=i+1;
until spr=1;
end;
il_permut:=il_permut+1;
slowo_wyj:='';
for i:=1 to dl_slowa do slowo_wyj:=slowo_wyj+slowo_0[ord(slowo[i])-96];
writeLn(il_permut,'. ',slowo_wyj);
slowo_st:=slowo;
{ key:=readKey;}
until (slowo_wyj='ALGEBRA') or (il_permut=max);
readLn;
end.
|
![]() |
20. Pochodna funkcji
21. Pola figur płaskich.
Program Pole_figury_plaskiej;
uses Graph;
var karta,tryb,x,y,k,n,bialy,czarny,siatka:integer;
psw,psz:longint;
const czworokat:array[1..5,1..2] of integer=
((50,120),(400,100),(500,285),(210,420),(50,120));
j:integer = 64;
begin
karta:=vga; tryb:=vgaHi; initGraph(karta,tryb,'');
fillPoly(4,czworokat);
setColor(cyan);
siatka:=16; psw:=0; psz:=0;
for n:=0 to 440 div siatka do
for k:=0 to 560 div siatka do
begin
bialy:=0;
czarny:=0;
for x:=k*siatka to (k+1)*siatka-1 do
for y:=n*siatka to (n+1)*siatka-1 do
if getPixel(x,y)=white then bialy:=1 else czarny:=1;
rectangle(k*siatka-1,n*siatka-1,(k+1)*siatka-1,(n+1)*siatka-1);
if (bialy=1) and (czarny=0) then
begin
inc(psw);
setFillStyle(1,lightRed);
bar(k*siatka,n*siatka,(k+1)*siatka-1,(n+1)*siatka-1);
end;
if (bialy=1) and (czarny=1) then
begin
inc(psz);
setFillStyle(1,lightBlue);
bar(k*siatka,n*siatka,(k+1)*siatka-1,(n+1)*siatka-1);
end;
end;
setColor(black);
drawPoly(5,czworokat);
writeLn('P.s.z.=',(psz+psw)/j/j*siatka*siatka:6:4,
' P.s.w.=',psw/j/j*siatka*siatka:6:4);
readLn; closeGraph;
end.
|
![]() |
22. Pole pod funkcją
Program Pole_pod_funkcja;
uses Graph;
var karta,tryb,n,k,iprz,j:integer;
x,y,x1,x2,Dx,pole:real;
function f(x:real):real;
begin
f:=(x*x*x-5*x)/5
end;
begin
karta:=detect; initGraph(karta,tryb,'');
j:=20;
setColor(darkGray);
for n:=-320 div j to 320 div j do line(320+n*j,0,320+n*j,479);
for n:=-240 div j to 240 div j do line(0,240+n*j,639,240+n*j);
setColor(white);
line(0,240,639,240); line(320,0,320,479);
setColor(lightBlue);
x1:=-3; x2:=4;
x:=-320/j; Dx:=0.00025;
repeat
x:=x+Dx;
y:=f(x);
if abs(y)<240/j then putPixel(round(x*j+320),round(-y*j+240),lightBlue);
if (x>x1) and (x<x2) then line(round(x*j+320),round(-y*j+240),
round(x*j+320),240);
until x>320/j;
setColor(lightRed);
iprz:=20; pole:=0; Dx:=(x2-x1)/iprz;
for n:=1 to iprz do
begin
x:=x1+n*Dx-Dx/2;
pole:=pole+f(x)*Dx;
rectangle(round(j*(x1+(n-1)*Dx)+320),round(-j*f(x)+240),
round(j*(x1+n*Dx)+320),240);
end;
setColor(white); line(0,240,639,240); line(320,0,320,479);
writeLn(' Pole = ',pole:1:4);
readln; closeGraph;
end.
|
![]() |
23. Potęga =1999
Program Potega_1999;
uses crt;
var n,i,poz,iloczyn,pamiec,podstawa,wypis:longInt;
t:array[1..64000] of byte;
begin
clrScr; t[1]:=1; podstawa:=2; poz:=1;
for i:=1 to 64000 do
begin
pamiec:=0;
for n:=1 to poz do
begin
iloczyn:=t[n]*podstawa;
t[n]:=(iloczyn+pamiec) mod 10;
pamiec:=(iloczyn+pamiec) div 10;
end;
t[n+1]:=pamiec; if pamiec>=1 then poz:=poz+1;
write(podstawa,'^',i,' = ');
wypis:=1; if poz>10 then wypis:=poz-10;
for n:=poz downTo wypis do write(t[n]);
if poz>11 then writeLn('...') else writeLn;
if poz>3 then if (t[poz]=1)and(t[poz-1]=9)and(t[poz-2]=9)and(t[poz-3]=9) then readLn;
end;
readLn;
end.
|
![]() |
24. Przekształcenia izometryczne
Program Translacja;
uses Graph;
var karta,tryb:integer;
x,y,xnowe,ynowe:longint;
begin
karta:=vga; tryb:=vgaHi; initGraph(karta,tryb,'c:\tp\bgi');
setTextStyle(triplexFont,horizDir,5);
outTextXY(30,430,'Matematyka');
rectangle(20,435,300,479);
fillEllipse(130,420,50,50);
for x:=0 to 300 do
for y:=0 to 110 do
if getpixel(x,479-y)=white then
begin
xnowe:=x+250;
ynowe:=y+200;
putPixel(xnowe,479-ynowe,lightRed);
end;
readLn;
closeGraph;
end.
|
![]() |
25. Przekształcenia afiniczne.
program Trzy_przeksztalcenia_afiniczne;
uses graph,crt; var karta,tryb,prz,skala:integer;
x,y,xNowe,yNowe:real;
const t:array[1..18] of real= (0.5,-0.8,0.5,0.0,0.5,-0.1,
0.5,0.0,0.0,0.0,0.5,0.4,0.5,0.6,-0.4,0.0,0.6,-0.4);
begin
karta:=detect; initGraph(karta,tryb,'c:\tp\bgi'); randomize;
x := 0; y := 0; skala:=180;
repeat
prz := random(3);
xNowe:=t[prz*6+1]*x+t[prz*6+2]*y+t[prz*6+3];
ynowe:=t[prz*6+4]*x+t[prz*6+5]*y+t[prz*6+6];
x := xNowe; y := yNowe;
putPixel(round(x*skala+320),round(-y*skala+240),prz+2);
until keyPressed;
readLn; closeGraph;
end.
|
![]() |
26. Reszta ab mod c.
program Reszta;
{$N+}
uses crt;
var a:extended;
function potegaModulo(a,b,c:extended):extended;
var reszta:extended;
begin
reszta:=1;
while b>0 do
begin
if int(b/2)<>b/2 then reszta:=reszta*a-int(reszta/c*a)*c;
a:=a*a-int(a/c*a)*c;
b:=int(b/2);
end;
potegaModulo:=reszta;
end;
begin
clrScr;
a:=4905289;
writeLn(a:1:0,' -> ',potegaModulo(a,4321,948581743):1:0);
readLn;
end.
|
27. Rozkład na czynniki pierwsze
Program Rozklad_na_czynniki_pierwsze;
uses crt;
var liczba,n:longInt;
begin
clrscr;
liczba:=1995;
n:=2;
repeat
if liczba mod n=0 then
begin
writeLn(liczba:15,' ł ',n);
liczba:=liczba div n;
end
else
n:=n+1;
until n>sqrt(liczba);
if liczba<>1
then writeLn(liczba:15,' ł ',liczba);
write(1:15,' ł');
readln;
end.
|
![]() |
28. Rzut kostką
Program Rzut_kostka;
uses graph;
var karta,tryb,n,los,il_rz:integer;
ilosc,czestosc:string;
t:array[1..6] of integer;
begin
karta:=detect; initGraph(karta,tryb,'');
for n:=1 to 6 do t[n]:=0;
il_rz:=1500; randomize;
for n:=1 to il_rz do
begin
los:=random(6)+1;
inc(t[los]);
line(los*85,455-t[los],los*85+37,455-t[los]);
line(los*85+40,455-t[los],los*85+55,455-15-t[los]);
end;
for n:=1 to 6 do
begin
str(t[n],ilosc);
outTextxy(n*85+20,441-t[n],ilosc);
str(t[n]/il_rz:1:4,czestosc);
outTextxy(n*85+10,411-t[n],czestosc);
end;
readln;
closeGraph;
end.
|
![]() |
29. Rzut monetą
Program Rzut_moneta;
uses graph;
var karta,tryb:integer;
n,il_rz,il_o,il_r:longInt;
x,y,los:real;
begin
karta:=detect; initGraph(karta,tryb,'');
randomize;
il_rz:=30000; il_o:=0; il_r:=0;
for n:=1 to il_rz do
begin
los:=random;
if los<=0.5 then
begin
il_o:=il_o+1;
x:=il_o/100*cos(il_o*pi/180);
y:=il_o/100*sin(il_o*pi/180);
fillEllipse(round(x+200),round(y+200),1,1);
end
else
begin
il_r:=il_r+1;
x:=il_r/100*cos(il_r*pi/180);
y:=il_r/100*sin(il_r*pi/180);
fillEllipse(round(x+400),round(y+200),1,1);
end;
end;
writeln(' Ilosc orlow = ',il_o:1,' Ilosc reszek = ',il_r:1);
writeLn('Czestosc orla = ',il_o/il_rz:1:4,' Czestosc reszki = ',il_r/il_rz:1:4);
readln;
closeGraph;
end.
|
![]() |
30. Schemat Bernoulliego
Program Schemat_Bernouliego_symulacje;
uses graph,crt;
const n=40; il_ucz=5000; g=1;
var karta,tryb:integer;
k,i,sukces:longInt;
Dcz:real;
czS,nS:string;
tab:array[1..n] of longInt;
begin
karta:=detect; initGraph(karta,tryb,'');
bar(0,0,639,479);
randomize; for k:=1 to n do tab[k]:=0;
setColor(darkGray);
for k:=0 to 12 do
begin
str(0.01*k:1:2,czS); outTextXY(280-g*n div 2,448-k*25,czS);
line(280-g*n div 2,460-k*25,340+g*n div 2,460-k*25);
end;
setColor(white);
setColor(black);
line(315-g*n div 2,479,315-g*n div 2,140);
line(280-g*n div 2,460,340+g*n div 2,460);
outTextXY(317-g*n div 2,465,'0');
str(n div 2,nS); outTextXY(312,465,nS);
str(n,nS); outTextXY(315+g*n div 2,465,nS);
for k:=1 to il_ucz do
begin
sukces:=0;
for i:=1 to n do if random<0.5 then sukces:=sukces+1;
tab[sukces]:=tab[sukces]+1;
Dcz:=2500/il_ucz;
line(g*sukces-g*n div 2+320,458-round(Dcz*tab[sukces]-Dcz),
g*sukces-g*n div 2+320,458-round(Dcz*tab[sukces]));
if keyPressed then exit;
end;
str(tab[n div 2]/il_ucz:1:4,czS); outTextXY(300,440-round(Dcz*tab[n div 2]),czS);
readLn; closeGraph;
end.
|
![]() |
31. Schemat Hornera
program Schemat_Hornera;
uses crt;
var n,x0,wartosc,w,blad:integer;
dane:string;
const tab:array[1..10] of integer=
(1,-2,3,4,-5,6,7,-8,-9,10);
begin
clrScr;
x0:=1;
wartosc:=0;
for n:=1 to 10 do
wartosc:=x0*wartosc+tab[n];
writeln(wartosc);
readLn;
end.
|
7 |
32. Sieczna
Program Sieczna;
uses Graph;
var karta,tryb,n,siatka,j,xA,yA,xB,yB:integer;
x,y,x1,x2,u:real;
function f(x:real):real;
begin
f:=1/4*x*x+x-6;
end;
begin
karta:=detect; initGraph(karta,tryb,'');
j:=20; siatka:=20;
setColor(darkGray); rectangle(0,0,639,479);
for n:=-320 div siatka to 320 div siatka do
begin
line(320+n*siatka,0,320+n*siatka,479);
line(0,240+n*siatka,639,240+n*siatka);
end;
setcolor(white);
line(0,240,639,240); line(630,235,639,240); line(630,245,639,240);
outtextxy(630,250,'X');
line(320,0,320,479); line(315,9,320,0); line(320,0,325,9);
outtextxy(330,8,'Y');
for n:=-320 div j to 320 div j do
begin
line(320+n*j,238,320+n*j,242);
line(318,240+n*j,322,240+n*j);
end;
x:=-320/j;
repeat
x:=x+1/j;
putPixel(round(x*j+320),round(240-f(x)*j),yellow);
until x>320/j;
x2:=6;
x1:=-1;
u:=(f(x2)-f(x1))/(x2-x1); write('u = ',u:5:4);
setColor(lightRed);
xA:=round(x1*j+320); yA:=round(240-f(x1)*j); fillEllipse(xA,yA,3,3);
xB:=round(x2*j+320); yB:=round(240-f(x2)*j); fillEllipse(xB,yB,3,3);
line(0,round(u*xA+yA),639,round(u*(xA-639)+yA));
line(xB,yB,xB,yA); line(xB,yA,xA,yA);
readln; closegraph;
end.
|
![]() |
33. Sito Eratostenesa
program Sito_Eratostenesa;
uses crt;
const max=500;
var liczba,n:longInt;
t:array[1..max] of byte;
begin
clrScr;
for n:=1 to max do t[n]:=0;
for liczba:=2 to round(sqrt(max)) do
if t[liczba]=0 then for n:=2 to max div liczba do t[liczba*n]:=1;
for n:=2 to max do if t[n]=0 then write(n:5);
readLn;
end.
|
![]() |
34. Sortowanie
program sortowanie_liczb;
uses crt;
var tab:array[1..25] of integer;
n,k,x:integer;
begin
clrscr; randomize;
for n:=1 to 25 do begin tab[n]:=round(random(100));write(tab[n],' ');end;
for n:=1 to 25 do
for k:=n+1 to 25 do begin if tab[n]>tab[k] then begin
x:=tab[n]; tab[n]:=tab[k]; tab[k]:=x; end; end;
writeln; for n:=1 to 25 do write(tab[n],' ');
readln;
end.
|
35. Styczna
Program Styczna;
uses graph;
var karta,tryb,n:integer;
skala,xp,yp,ip,ips:longInt;
x,y,x0,y0,krok,h:real;
xS,yS:string;
function f(x:real):real;
begin
f:=x*x-4*x-2;
end;
procedure osie;
begin
setColor(darkGray);setLineStyle(1,0,1);
for n:=0 to 30 do line(xp mod ip+n*ip,0,xp mod ip+n*ip,380);
for n:=0 to 22 do line(0,yp mod ip+n*ip,510,yp mod ip+n*ip);
setLineStyle(0,0,1);
for n:=0 to 2*(15 div skala) do
line(xp mod ips+n*ips,0,xp mod ips+n*ips,380);
for n:=0 to 2*(11 div skala) do
line(0,yp mod ips+n*ips,510,yp mod ips+n*ips);
rectangle(0,0,510,380);setColor(lightGray);setLineStyle(0,0,3);
line(0,yp,510,yp);line(500,yp-5,508,yp);line(500,yp+5,508,yp);
line(xp,0,xp,380); line(xp-5,10,xp,2); line(xp+5,10,xp,2);
str(-16/skala+x0:2:4,xS); outTextXY(3,198,xS);
str(16/skala+x0:2:4,xS);outTextXY(510-8*length(xS),198,xS);
str(-12/skala+y0:2:4,yS); outTextXY(260,370,yS);
str(12/skala+y0:2:4,yS); outTextXY(264,5,yS);
end;
procedure wykres;
begin
x:=-16/skala+x0; krok:=0.005/skala;
repeat
x:=x+krok;
y:=-f(x)*ips+yp;
if (y>0) and (y<380) then
putPixel(round(x*ips+xp),round(y),lightcyan);
if x<x0 then h:=-0.0001/skala else h:=0.0001/skala;
putPixel(round(x*ips+xp),
round(-((f(x0+h)-f(x0))/h*(x-x0)+f(x0))*ips+yp),lightRed);
until x>16/skala+x0;
setColor(yellow);circle(255,190,2);
str(x0:2:4,xS);str(y0:2:4,yS);
outTextXY(260,200,'A ('+xS+', '+yS+')');
end;
begin
karta:=vga; tryb:=vgaHi; initgraph(karta,tryb,'c:\tp\bgi');
skala:=1; ip:=16; ips:=ip*skala;
x0:=3; xp:=round(255-x0*ips);
y0:=f(x0); yp:=round(190+y0*ips);
osie; wykres;
readln; closegraph;
end.
|
![]() |
36. Suma sześcianów cyfr
program Suma_szescianow_cyfr;
uses crt;
var liczba,cyfra,suma,i:longInt;
key:char;
begin
clrScr;
liczba:=123;
write(liczba,' -> ');
repeat
suma:=0;
repeat
cyfra:=liczba mod 10;
suma:=suma+cyfra*cyfra*cyfra;
liczba:=liczba div 10;
until liczba=0;
write(suma,' -> ');
liczba:=suma;
key:=readKey;
until (key=#27);
end.
|
37. Symbol Newtona n_po_k
program Obliczanie_n_po_k;
{$N+}
uses crt;
function silnia (s:integer):extended;
var i:integer;
x:extended;
begin
x:=1;
for i:=1 to s do x:=x*i;
silnia:=x;
end;
function n_po_k(n,k:integer):extended;
begin
n_po_k:=silnia(n)/silnia(k)/silnia(n-k);
end;
begin
clrScr;
writeLn(n_po_k(10,5):1:0);
readLn;
end.
|
38. Szeregi
program Szeregi;
{$N+}
uses crt;
var n:longint;
suma:extended;
function a(n:real):real;
begin
a:=1/n;
end;
begin
clrscr;
suma:=0;
for n:=1 to 20 do
begin
suma:=suma+a(n);
writeln('a(',n,') = ',a(n):17:17,' S(',n,') = ',suma:17:17);
end;
readln;
end.
|
![]() |
39. Szyfrowanie RSA
program Szyfrowanie;
uses crt;
var
blok, e, k: longInt;
function reszta (a, b, c: longInt): longInt;
var
n, p: longInt;
begin
p := 1;
for n := 1 to b do
p := p * a;
reszta := p mod c
end;
{**********************************}
begin
clrScr;
blok := 352;
e := 3;
k := 901;
writeLn('Szyfrowanie: ', blok : 10, ' -> ', reszta(blok, e, k) : 10);
readLn;
end.
|
40. Trójkąt Pascala
program trojkat_Pascala;
uses graph;
var karta,tryb,n,k:integer;
x,y:longInt;
ilS:string;
t:array[1..33] of longInt;
begin
karta:=detect; initGraph(karta, tryb, '');
setTextStyle(smallFont,0,1);
for n:=1 to 33 do t[n]:=0;
y:=1;
for n:=1 to 33 do
for k:=1 to n-1 do
begin
x:=y;
y:=t[k];
t[k]:=x+y;
setColor(t[k] mod 2+3);
str(t[k],ilS);
setUserCharSize(1,length(ilS) div 2,5,4);
outTextXY(320-10*n+k*20,12*n,ilS);
end;
readLn; closeGraph;
end.
|
![]() |
41. Trójkąt Sierpińskiego
program trojkat_Sierpinskiego_max;
uses graph;
var karta, tryb, n, k, i, bok: integer;
tr:array[1..3,1..2] of integer;
procedure trojkat (x, y, bok, znak: integer);
begin
tr[1,1]:=x; tr[1,2]:=y;
tr[2,1]:=x-bok div 2; tr[2,2]:=y-znak*bok div 2;
tr[3,1]:=x+bok div 2; tr[3,2]:=y-znak*bok div 2;
fillPoly(3,tr);
end;
begin
karta:=detect; initGraph(karta,tryb,'');
bok:=256; trojkat(bok,0,bok*2,-1);
setFillStyle(1,black);
i:=0;
repeat
readLn;
for n:=0 to i do
for k:=0 to i do
if n and k = 0 then
trojkat((n-k)*(bok div (i+1))+bok,
(n+k-i)*(bok div (i+1))+bok,bok div (i+1),1);
i:=2*i+1;
until i>64;
readLn; closeGraph;
end.
|
![]() |
42. Twierdzenie o liczbach pierwszych i jego zastosowanie do szyfrowania RSA
program Twierdzenie_o_liczbach_pierwszych_i_jego_zastosowanie_do_szyfrowania_RSA;
{$N+}
uses crt;
var i,p,q,k,N,M,a,a1,e,d:integer;
potega,potega1,potega2:extended;
reszta,reszta1,reszta2:integer;
function pierwsza(a:integer):boolean;
var n:integer;
begin
pierwsza:=false;
for n:=2 to round(sqrt(a)) do if a mod n=0 then exit;
pierwsza:=true;
end;
function NdoM(a,b:integer):extended;
var n:integer;
x:extended;
begin
x:=1;
for n:=1 to b do x:=x*a;
NdoM:=x;
end;
function nwd(a,b:integer):integer;
var r:integer;
begin
repeat
r:=a mod b; a:=b; b:=r;
until r=0;
nwd:=a;
end;
procedure liczba_d;
var m:integer;
begin
a:=0;
repeat
a:=a+1; m:=a*(p-1)*(q-1)+1;
until m mod e=0;
d:= m div e;
end;
{******* program gl˘wny *********}
begin
clrScr; randomize;
repeat
repeat
repeat
repeat
p:=random(12)+2;
until pierwsza(p)=true;
repeat
q:=random(12)+2;
until (pierwsza(q)=true) and (p<>q);
k := p * q;
M := (p-1)*(q-1)+1;
N := random(12)+2;
potega:=NdoM(N,M);
until (N<k) and (potega<1e14);
reszta:=round(potega-int(potega/k)*k);
repeat
e:=random(5)+2;
until (nwd(e,p-1)=1) and (nwd(e,q-1)=1);
liczba_d;
potega1:=NdoM(N,e);
until potega1<1e14;
reszta1:=round(potega1-int(potega1/k)*k);
potega2:=NdoM(reszta1,d);
until (potega2<1e14) and (reszta1<>N);
reszta2:=round(potega2-int(potega2/k)*k);
textColor(green); { Twierdzenie }
writeLn('TW.2.');
write(' Jezeli p,q-r˘zne liczby pierwsze i ');
textColor(lightBlue); write('N');
textColor(green); write('<p*q, to ');
textColor(lightBlue); write('N');
textColor(green); write('^(p-1)*(q-1)+1 mod p*q = ');
textColor(lightBlue); writeLn('N');
textColor(white); for i:=1 to 76 do write('_');
textColor(green); writeLn; writeLn; { przyklad }
write('Przyklad:');
textColor(white);
write(' p=',p:1,', q=',q:1,', p*q=',p*q:1,', N=');
textColor(lightBlue);
write(N:1);
textColor(white);
writeLn(', (p-1)*(q-1)+1=',M:1);
textColor(lightBlue);
write(' ',N:1);
textColor(white);
write('^',M:1,' mod ',k:1,' = ',potega:1:0,' mod ',k:1,' = ');
textColor(lightBlue);
write(reszta:1);
textColor(green); writeLn; writeLn; { uog˘lnienie }
writeLn('Uog˘lnienie:');
write(' Jezeli p,q-r˘zne liczby pierwsze i ');
textColor(lightBlue); write('N');
textColor(green); write('<p*q, to ');
textColor(lightBlue); write('N');
textColor(green); write('^a*(p-1)*(q-1)+1 mod p*q = ');
textColor(lightBlue); writeLn('N');
textColor(green);
writeLn(' gdzie a = 1, 2, 3, ...');
for a1:=1 to 3 do
begin
textColor(white);
write(' np. a=',a1:1,' p=',p:1,', q=',q:1,', p*q=',p*q:1,' N=');
textColor(lightBlue);
write(N:1);
M:=a1*(p-1)*(q-1)+1;
potega:=NdoM(N,M);
reszta:=round(potega-int(potega/k)*k);
textColor(white);
writeLn(', a*(p-1)*(q-1)+1=',M:1);
textColor(lightBlue);
write(' ',N:1);
textColor(white);
write('^',M:1,' mod ',k:1,' = ',potega:1:0,' mod ',k:1,' = ');
textColor(lightBlue); write(reszta:1);
writeLn;
end;
writeLn;
a1:=a;
M:=a1*(p-1)*(q-1)+1;
potega:=NdoM(N,M);
reszta:=round(potega-int(potega/k)*k);
textColor(green);
writeLn('Zastosowanie:'); { Zastosowanie-szyfrowanie RSA }
textColor(lightBlue);
write(' N');
textColor(green);
write('^M mod k = (');
textColor(lightBlue);
write('N');
textColor(green);
write('^e)^d mod k = (');
textColor(lightBlue);
write('N');
textColor(green);
write('^e mod k)^d mod k = ');
textColor(lightRed);
write('X');
textColor(green);
write('^d mod k = ');
textColor(lightBlue);
writeLn('N');
textColor(green);
writeLn(' gdzie M = a*(p-1)*(q-1)+1 = e*d i e,d wzglednie pierwsze z p-1 i q-1,');
textColor(white);
writeLn(' np. a=',a:1,', p=',p:1,', q=',q:1,', e=',e:1,', d=',d:1,', M=',M:1,', k=',k:1);
writeLn;
textColor(lightBlue);
write(N:1);
textColor(white);
write('^',M:1,' mod ',k:1,' = (');
textColor(lightBlue);
write(N:1);
textColor(white);
write('^',e:1,' mod ',k:1,')');
write('^',d:1,' mod ',k:1,' = ');
textColor(lightRed);
write(reszta1:1);
textColor(white);
write('^',d:1,' mod ',k:1,' = ');
write(potega2:1:0,' mod ',k:1,' = ');
textColor(lightBlue); write(reszta2:1);
textColor(white);writeLn;
readLn;
end.
|
![]() |
43. Twierdzenie o resztach
program Tw_1a_o_resztach;
uses crt;
var a,b,c,x,y:longInt;
begin
clrScr;
writeLn('Tw.1a. (a+b) mod c = ((a mod c)+(b mod c)) mod c');
writeLn('-----------------------------------------------------');
randomize;
a:=random(40);
b:=random(30);
c:=random(20)+1;
x:=a mod c;
y:=b mod c;
textColor(lightGray);
writeLn('Przyklad: a = ',a,', b = ',b,', c = ',c,',');
writeLn;
writeLn(' L = (',a,'+',b,') mod ',c,' = ');
writeLn(' = ',a+b,' mod ',c,' = ');
textColor(lightRed);
writeLn(' = ',(a+b) mod c);
textColor(lightGray);
writeLn(' P = ((',a,' mod ',c,')+(',b,' mod ',c,')) mod ',c,' = ');
writeLn(' = (',x,'+',y,') mod ',c,' = ');
writeLn(' = ',x+y,' mod ',c,' = ');
textColor(lightRed);
writeLn(' = ',(x+y) mod c);
textColor(lightGray);
writeLn(' L = P');
readLn;
end.
|
![]() |
44. Układ współrzędnych w przestrzeni
Program XYZ; uses Graph; var karta,tryb,x,y,z,n,xN,xP,yP,xA,yC,yA:integer; begin karta:=vga; tryb:=vgaHi; initGraph(karta,tryb,'c:\tp\bgi'); line(0,240,639,240); for n:=0 to 32 do putPixel(n*20,238,white); line(320,0,320,479); for n:=0 to 24 do putPixel(318,n*20,white); line(0,479,639,0); for n:=0 to 64 do putPixel(n*10-3,479-round(240/320*n*10),white); x:=5; y:=6; z:=7; xN:=320+x*20; xP:=320-y*10; xA:=XP+x*20; yP:=240+round(240/320*y*10); yA:=YP-z*20; yC:=240-z*20; setColor(yellow); line(xP,yP,xA,yP);line(xA,yP,xN,240);line(xN,240,xN,yC);line(xA,yA,xN,yC); line(xA,yA,xP,yA);line(xP,yA,320,yC);line(320,yC,xN,yC);line(xP,yP,xP,yA); line(xA,yA,xA,yP);line(xP,yP,320,240);line(320,240,xN,240);line(320,240,320,yC); fillEllipse(xA,yA,3,3); readLn; closeGraph; end. |
![]() |
45. Wklęsłość - wypukłość funkcji
Program wkleslosc_wypuklosc;
{$N+}
uses Graph;
var karta,tryb,n,siatka,j,kolor:integer;
x,y,dx,y1,y2,y3,xpp:extended;
function f(x:extended):extended;
begin
f:=x*x/(2*x*x-x-2);
end;
begin
karta:=detect; initGraph(karta,tryb,'c:\tp\bgi');
j:=20;
setColor(darkGray);
for n:=-320 div j to 320 div j do line(n*j+320,0,n*j+320,479);
for n:=-240 div j to 240 div j do line(0,n*j+240,639,n*j+240);
setColor(white); line(0,240,639,240); line(320,0,320,479);
x:=-320/j; Dx:=0.00025;
repeat
x:=x+Dx;
y:=f(x);
y1:=f(x+Dx);
y2:=f(x+2*Dx);
y3:=f(x+3*Dx);
if y1-y>y2-y1 then kolor:=yellow else kolor:=lightRed;
xpp:=(2*x+3*Dx)/2;
if abs(y)<240/j then putPixel(round(xpp*j+320),round(-f(xpp)*j+240),kolor);
if (((y2-y1<y1-y) and (y2-y1<y3-y2)) or ((y2-y1>y1-y) and (y2-y1>y3-y2))) and
(abs(y)<240/j) and (abs(y1)<240/j) and (abs(y2)<240/j) and (abs(y3)<240/j) then
writeLn('xpp=',xpp:18:14,', ypp=',f(xpp):18:14);
until x>320/j;
readln; closeGraph;
end.
|
![]() |
46. Wielościany foremne
Program Sprawdzenie_ilosci_wieloscianow_foremnych;
uses crt;
var x,y,k,s,w:integer;
begin
clrScr;
for x:=3 to 50 do
for y:=3 to 50 do
for k:=6 to 50 do
if abs(2/x+2/y-2/k-1)<0.0000001 then
writeLn('x=',x,' y=',y,' k=',k,' w=',2*k/y:2:0,' s=',2*k/x:2:0);
writeLn('Koniec obliczeä');
readLn;
end.
|
![]() |
47. Wykresy funkcji
Program Wykresy_funkcji;
uses Graph;
var karta,tryb,n,siatka,j:integer;
x,y:real;
function f(x:real):real;
begin
f:=3/(x-2);
end;
begin
karta:=detect; initGraph(karta,tryb,'');
j:=36; siatka:=36;
setColor(darkGray); rectangle(0,0,639,479);
for n:=-320 div siatka to 320 div siatka do line(320+n*siatka,0,320+n*siatka,479);
for n:=-240 div siatka to 240 div siatka do line(0,240+n*siatka,639,240+n*siatka);
setcolor(white);
line(0,240,639,240); line(630,235,639,240); line(630,245,639,240); outtextxy(630,250,'X');
line(320,0,320,479); line(315,9,320,0); line(320,0,325,9); outtextxy(330,8,'Y');
for n:=-320 div j to 320 div j do line(320+n*j,238,320+n*j,242);
for n:=-240 div j to 240 div j do line(318,240+n*j,322,240+n*j);
x:=-320/j; setColor(lightBlue); setFillStyle(1,lightBlue);
repeat
x:=x+1/j/2;
y:=240-f(x)*j;
if abs(y)<480 then fillEllipse(round(x*j+320),round(y),1,1);
until x>320/j;
readln; closeGraph;
end.
|
![]() |
48. Wykresy skalowane
49. Wykresy nierówności.
50. Zamiana liczby binarnej na dziesiętną
program Binarne_na_rzeczywiste;
uses crt;
var n: longInt;
RZ, p: real;
Bin: string;
begin
clrScr;
Bin:='1010101,1100110011';
p:=1;
n:=2;
while (Bin[n]<>',') and (n<=length(Bin)) do
begin
p:=p*2;
n:=n+1;
end;
write(Bin,' -> ');
Rz:=0;
for n:=1 to length(Bin) do
begin
if Bin[n]='1' then Rz:=Rz+p;
if Bin[n]<>',' then p:=p/2;
end;
write(Rz:1:11);
readLn;
end.
|
51. Zamiana liczby dziesiętnej na binarną
Program Dziesietne_na_binarne;
uses crt;
var liczbaDz:integer;
liczBin:string;
begin
clrScr;
liczbaDz:=85;
write(liczbaDz,' - ');
liczBin:='';
repeat
liczBin:=chr(liczbaDz mod 2+48) +liczBin;
liczbaDz:=liczbaDz div 2;
until liczbaDz=0;
writeLn(liczBin);
readLn;
end.
|
52. Zamiana liter na kody ASCII
program Zamiana_tekstu_na_liczbe;
{$N+} uses crt;
var n:integer;
liczba,potega255:extended;
tekst:string;
procedure zamienTekstNaLiczbe(tekst:string);
begin
liczba:=0;
potega255:=1;
for n:=length(tekst) downto 1 do
begin
liczba:=liczba+ord(tekst[n])*potega255;
potega255:=potega255*255;
end;
end;
begin
clrScr;
tekst:='Kom';
zamienTekstNaLiczbe(tekst);
writeLn(tekst,'=',liczba:1:0);
readLn;
end.
|
53. Zamiana ułamków zwykłych na dziesiętne do 1000 cyfr po przecinku
Program Ulamki_zwykle_na_dziesietne;
uses crt;
var licznik,mianownik,iloscMiejsc:longInt;
begin
clrScr;
licznik:=133;
mianownik:=74;
iloscMiejsc:=0;
write(licznik,'/',mianownik,' = ',licznik div mianownik,',');
repeat;
licznik:=(licznik mod mianownik)*10;
write(licznik div mianownik);
inc(iloscMiejsc);
until iloscMiejsc>1000;
write('...');
readLn;
end.
|
![]() |
54. Zbiory punktów
55. Zbiory Julii
Program Zbior_Julii;
uses crt,graph;
var karta,tryb,n,k,i,obr,siatka:integer;
x,y,xst,yst,Re_c,Im_c,xpocz,xkon,ypocz,ykon,krok_x,krok_y:real;
begin
karta:=detect; initgraph(karta,tryb,'');
xpocz:=-1.8; xkon:=1.8; ypocz:=-1.3; ykon:=1.3;
krok_x:=(xkon-xpocz)/630; krok_y:=(ykon-ypocz)/420;
for n:=1 to 630 do
for k:=1 to 420 do
begin
Re_c:=xpocz+n*krok_x; Im_c:=ypocz+k*krok_y;
xst:=Re_c; yst:=Im_c; i:=0;
repeat
x:=xst*xst-yst*yst;
y:=2*xst*yst-1;
xst:=x;
yst:=y;
i:=i+1;
until (x*x+y*y>8) or (i>12);
if keyPressed then exit;
if i>12 then putPixel(n,420-k+30,white);
putPixel(n,420-k+30,i);
end;
readln; closeGraph;
end.
|
![]() |
56. Zbiór Mandelbrota
57. Wieże Hanoi (rekurencja)
program Wieze_Hanoi;
uses graph;
var karta,tryb,n,ilK,ypocz,gr,j:integer;
t :array[1..3,1..12] of integer;
tw:array[1..3] of integer;
procedure przeloz_krazek(skad, dokad : integer);
begin
tw[dokad]:=tw[dokad]+1; t[dokad,tw[dokad]]:=t[skad,tw[skad]];
setFillStyle(1,black); setColor(black);
fillEllipse(skad*210-100,ypocz-tw[skad]*gr,t[skad,tw[skad]]*j,gr div 2-1);
t[skad,tw[skad]]:=0; tw[skad]:=tw[skad]-1;
setFillStyle(1,t[dokad,tw[dokad]]);
fillEllipse(dokad*210-100,ypocz-tw[dokad]*gr,t[dokad,tw[dokad]]*j,gr div 2-1);
readLn;
end;
procedure przeloz(ile, skad, dokad, roboczy : integer);
begin
if ile=1 then przeloz_krazek(skad, dokad)
else begin
przeloz(ile-1, skad, roboczy, dokad);
przeloz_krazek(skad, dokad);
przeloz(ile-1, roboczy, dokad, skad)
end;
end;
begin
karta:=vga; tryb:=vgaHi; initGraph(karta, tryb,'');
writeLn('Nacisnij dowolny klawisz');
ilK:=3; j:=19-ilK; gr:=30; j:=19-ilK; ypocz:=420;
for n:=1 to ilK do t[1,n]:=ilK-n+1;
tw[1]:=ilK;
for n:=1 to tw[1] do
begin
setFillStyle(1,t[1,n]);
fillEllipse(1*210-100,ypocz-n*gr,t[1,n]*j,gr div 2-1);
end;
readLn;
przeloz(ilK,1,3,2);
closeGraph;
end.
|
![]() |