Cokgenlerden Gül

program cokgencizmece;
uses dos,crt,graph,printer;
var gs, gm, i, X, Y, k,j,r,m:integer;

cokgen: ARRAY[1..100] OF integer;
cokgenX: ARRAY [1..100] of integer;
cokgenY: ARRAY [1..100] of integer;
aci: real;

procedure cokgenciz (X,Y,L,n:word);

begin
aci:= pi * ((360/ n)/180);

for i:= 1 to n do

begin
cokgen[ 2 * i-1]:= x + round (L * cos (aci*i*2));
cokgen[2*i] := y + round (L* sin (aci*i*2));

end;

for i:= 1 to n do
begin
cokgenX[i] := cokgen [2 * i -1];
cokgenY[i] := cokgen [2 * i];
end;

SETFILLSTYLE (7,11);
SETCOLOR(12);
FILLPOLY(n,cokgen);

for i:= 1 to 250 do
begin
r:= random (n)+ 1;
k:= random (n)+ 1;

line (cokgenX[r],cokgenY[r], cokgenX[k],cokgenY[k]);

end;



end;
procedure baskacokgenciz (X,Y,L,n:word);

begin
aci:= pi * ((360/ n)/180);

for i:= 1 to n do

begin
cokgen[ 2 * i-1]:= x + round (L * sin (aci*i*2));
cokgen[2*i] := y + round (L* cos (aci*i*2));

end;

for i:= 1 to n do
begin
cokgenX[i] := cokgen [2 * i -1];
cokgenY[i] := cokgen [2 * i];
end;

SETFILLSTYLE (7,11);
SETCOLOR(12);
FILLPOLY(n,cokgen);

for i:= 1 to 250 do
begin
r:= random (n)+ 1;
k:= random (n)+ 1;

line (cokgenX[r],cokgenY[r], cokgenX[k],cokgenY[k]);

end;



end;
begin

gs:=detect;
initgraph(gs,gm, 'c:\tp\bgi');
if graphresult <>grok then halt(1);

cleardevice;


cokgenciz(300,200,200,20);


baskacokgenciz(300,200,100,7);
baskacokgenciz(300,200,200,7);
baskacokgenciz(300,200,50,7);

readln;
closegraph;
end.

Rastgele noktalar ile bölme

Ucgen ve ucgen kenarlarının eşit parçalara bölünmesi

program rastgele;
uses dos,crt,graph,printer;
var gs, gm, i, j , p,L,K:integer;
BIRX : ARRAY[1..20] of integer;
BIRY : ARRAY[1..20] of integer;
IKIX : ARRAY[1..20] of integer;
IKIY : ARRAY[1..20] of integer;
UCX : ARRAY[1..20] of integer;
UCY : ARRAY[1..20] of integer;


PROCEDURE ucgenciz (X1,Y1,X2,Y2,X3,Y3: INTEGER );
BEGIN

LINE(X1, Y1, X2,Y2);
LINE(X2,Y2,X3,Y3);
LINE(X3,Y3,X1,Y1);

for i:=1 to 5 do
begin
BIRX[i] := X1+ (X2-X1) div 5 * i;
BIRY[i] := Y1+ (Y2-Y1) div 5 * i;

IKIX[i] := X2+ (X3-X2) div 5 * i;
IKIY[i] := Y2+ (Y3-Y2) div 5 * i;

UCX[i] := X3+ (X1-X3) div 5 * i;
UCY[i] := Y3+ (Y1-Y3) div 5 * i;

end;

END;

begin


gs:=detect;
initgraph(gs,gm, 'c:\tp\bgi');
if graphresult <>grok then halt(1);

cleardevice;

ucgenciz (50,50,450,400,50,300);

for i:= 1 to 5 do
BEGIN
LINE(BIRX[i],BIRY[i], IKIX[i], IKIY[i]);
LINE(BIRX[i],BIRY[i], UCX[i], UCY[i]);
LINE(UCX[i],UCY[i], IKIX[i], IKIY[i]);
end;
{LINE(BIRX[random(5)+ 1],BIRY[random(5)], IKIX[2], IKIY[2]);}
readln;
closegraph;
end.

Üçgenler

Fibonacci'ye Değişik Bir Yorum

PROGRAM NESTED;
USES CRT, DOS, GRAPH, PRINTER;
VAR GRAFIKSURUCU, GRAFIKKONUMU,K,i,j,X1,X2,Y1,Y2, KONTROL:INTEGER;
FIBONACCI:ARRAY[1..100] OF INTEGER;

PROCEDURE FIBO(X,Y,L:INTEGER);
BEGIN
FIBONACCI[1]:=1;
FIBONACCI[2]:=1;

FOR i:=3 TO 100 DO
BEGIN
FIBONACCI[i]:=FIBONACCI [i-2]+ FIBONACCI [i-1];
END;

X1:=X;
Y1:=Y;
X2:= X1;

FOR i:=1 TO 100 DO
BEGIN

KONTROL:= i MOD 4;

CASE KONTROL OF

1:
BEGIN
Y2:= Y1-FIBONACCI[i]*L;
ELLIPSE ((X1+X2)DIV 2, (Y1+Y2) DIV 2,270,90,FIBONACCI[i] DIV 5*L, FIBONACCI[i] DIV 2*L);
Y1:= Y2;
END;

2:
BEGIN
X2:= X1-FIBONACCI [i]*L;
ELLIPSE ((X1+X2)DIV 2, (Y1+Y2) DIV 2,0,180,FIBONACCI[i] DIV 2*L, FIBONACCI[i] DIV 5*L);
X1:=X2;
END;

3:
BEGIN
Y2:= Y1+FIBONACCI [i]*L;
ELLIPSE ((X1+X2)DIV 2, (Y1+Y2) DIV 2,90,270,FIBONACCI[i] DIV 8*L, FIBONACCI[i] DIV 2*L);
Y1:=Y2;
END;

0:
BEGIN
X2:= X1+FIBONACCI [i]*L;
ELLIPSE ((X1+X2)DIV 2, (Y1+Y2) DIV 2,180,0,FIBONACCI[i] DIV 2*L, FIBONACCI[i] DIV 5*L);
X1:=X2;
END;
END;
END;
END;


BEGIN
GRAFIKSURUCU:=DETECT;
INITGRAPH (GRAFIKSURUCU, GRAFIKKONUMU,'C:\PROGRA~1\TP\BGI');
IF GRAPHRESULT<>GROK THEN HALT(1);
CLEARDEVICE;

FOR K:=1 TO 10 DO
BEGIN
FIBO(GETMAXX DIV 2, GETMAXY DIV 2, K) ;
END;

Cokgen Koselelerini Elipslemece

PROGRAM COKGENLER;
USES CRT, DOS, GRAPH, PRINTER;
CONST PI=22/7;
VAR GRAFIKSURUCU, GRAFIKKONUMU,I,J,N,K:INTEGER;
ACI:REAL;
COKGENXY: ARRAY[1..100] OF INTEGER;

PROCEDURE COKGEN (X,Y,L :INTEGER);
BEGIN
N:=34;
ACI:=PI*((360/N)/180);


FOR I:=1 TO N+1 DO
BEGIN
COKGENXY[2*I-1]:= X+ROUND(L*COS(ACI*I));
COKGENXY[2*I]:= Y+ROUND(L*SIN(ACI*I));
END;


SETFILLSTYLE (13,13);
{FILLPOLY (N,ALTIGENXY);}

FOR J:=1 TO N DO
BEGIN
{CIRCLE (COKGENXY[2*J-1],COKGENXY[2*J],40); }
{LINE (COKGENXY[2*J-1],COKGENXY[2*J],X,Y);}
ELLIPSE (COKGENXY[2*J-1],COKGENXY[2*J],0,360,X,Y);
END;

FOR K:=1 TO N DO
BEGIN
LINE (COKGENXY[2*K-1],COKGENXY[2*K],COKGENXY[2*(K+1)-1],COKGENXY[2*(K+1)]);
END;

END;

BEGIN
GRAFIKSURUCU:=DETECT;
INITGRAPH (GRAFIKSURUCU, GRAFIKKONUMU,'C:\PROGRA~1\TP\BGI');
IF GRAPHRESULT<>GROK THEN HALT(1);
CLEARDEVICE;


COKGEN(GETMAXX DIV 2, 250, 200);


READLN;
CLOSEGRAPH;

END.

cokgen

program cokgencizmece;
uses dos,crt,graph,printer;
const pi = 22/7;
var gs, gm, i, X, Y, k,j:integer;
cokgen: ARRAY[1..100] OF integer;
aci: real;


procedure cokgenciz (X,Y,L,n:word);

begin
aci:= pi * ((360/ n)/180);

for i:= 1 to n do

begin
cokgen[ 2 * i-1]:= x + round (L * cos (aci*i));
cokgen[2*i] := y + round (L* sin (aci*i));

end;

SETFILLSTYLE (7,11);
SETCOLOR(12);
FILLPOLY(n,cokgen);

end;


begin
gs:=detect;
initgraph(gs,gm, 'c:\tp\bgi');
if graphresult <>grok then halt(1);
cleardevice;

cokgenciz(200,200,100,15);

readln;
closegraph;
end.

program altigencizmece;
uses dos,crt,graph,printer;
var gs, gm, i, X, Y, k,j:integer;

altigen: ARRAY[1..100] OF integer;
aci: real;





procedure altigenciz (X,Y,L:word);

begin
aci:= pi * (60/180);

for i:= 1 to 6 do

begin
altigen[ 2 * i-1]:= x + round (L * cos (aci*i));
altigen[2*i] := y + round (L* sin (aci*i));

end;



SETFILLSTYLE (7,11);
SETCOLOR(12);
FILLPOLY(6,altigen);

end;

begin

gs:=detect;
initgraph(gs,gm, 'c:\tp\bgi');
if graphresult <>grok then halt(1);

cleardevice;

altigenciz(200,200,100);



readln;
closegraph;
end.

ALTIGEN-Uzun yoldan

program dizmece;
uses dos,crt,graph,printer;
const pi = 22/7;
var gs, gm, i, X, Y, k,j:integer;
altigen: ARRAY[1..12] OF integer;
aci: real;

procedure altigenciz (X,Y,L:word);

begin
aci:= pi * (60/180);
altigen [1] := X + round (L* cos(aci)); {X1}
altigen [2] := Y + round(L* sin(aci));
altigen [3] := X + round (L* cos(aci*2));{X2}
altigen [4] := Y + round(L* sin(aci*2));
altigen [5] :=X + round (L* cos(aci*3)) ;{X3}
altigen [6]:=Y + round(L* sin(aci*3)) ;
altigen [7] :=X + round (L* cos(aci*4)) ;{X4}
altigen [8] :=Y + round(L* sin(aci*4)) ;
altigen [9] :=X + round (L* cos(aci*5)) ;{X5}
altigen [10] :=Y + round(L* sin(aci*5)) ;
altigen [11] :=X + round (L* cos(aci*6));{X6}
altigen [12] :=Y + round(L* sin(aci*6)) ;


SETFILLSTYLE (7,11);
SETCOLOR(12);
FILLPOLY(6,altigen);

end;

begin
{{bu kısım sadece deneme amaçlı}
aci:= pi * (60/180);
writeln ('sin60:', sin(aci):8:2);
writeln ('cos60:', cos(aci):8:2);
readln;}

gs:=detect;
initgraph(gs,gm, 'c:\tp\bgi');
if graphresult <>grok then halt(1);
cleardevice;

altigenciz(200,200,100);

readln;
closegraph;
end.

Artılar

Koch Snowflake

naturally fractal

UYGULAMA 31(Ağaç) - 9 Nisan 2010

program agac;
uses dos,crt,graph,printer;
var gs, gm, i, j , p,L,K:integer;
DIZI : ARRAY[1..8] of integer;

PROCEDURE kareciz (X,Y,a: INTEGER );
BEGIN
DIZI[1] := X; {X1}
DIZI[2] := Y;
DIZI[3] := X;
DIZI[4] :=Y-a;
DIZI[5] := X +a;
DIZI[6] := Y-a;
DIZI[7] := X+ a;
DIZI[8] := Y;
FILLPOLY(4,DIZI);
END;

procedure nestedkare (X,Y,aYeni:integer);
var Xsol, Ysol, aYenisol: integer;

begin
aYenisol:= aYeni;
Xsol:= X;
Ysol:= Y;
repeat
kareciz (X,Y, aYeni);
kareciz (Xsol,Ysol, aYeni);
X:= X+ aYeni;
Y:= Y- aYeni;
aYenisol:= round (aYenisol* 2/3);
Xsol:= Xsol - aYenisol;
Ysol:= Ysol- aYeni;

aYeni := round (aYeni* 2/3);
until aYeni < 10;
end;

begin
gs:=detect;
initgraph(gs,gm, 'c:\tp\bgi');
if graphresult <>grok then halt(1);
cleardevice;

setfillstyle(4,5);
nestedkare (getmaxx div 2, getmaxy , 100);

readln;
closegraph;
end.

UYGULAMA 30 (artilar) - 9 Nisan 2010

PROGRAM NESTED;
USES CRT, DOS, GRAPH, PRINTER;
VAR GRAFIKSURUCU, GRAFIKKONUMU,i,j,L,K:INTEGER;
ARTI: ARRAY[1..24] OF INTEGER;

PROCEDURE ARTICIZ (X,Y,L,K: WORD);
BEGIN

ARTI[1]:=X;{X1}
ARTI[2]:=Y;{Y1}
ARTI[3]:=X+L; {X2}
ARTI[4]:=Y; {Y2}
ARTI[5]:=X+L; {X3}
ARTI[6]:=Y-L; {Y3}
ARTI[7]:= X+L+K; {X4}
ARTI[8]:= ARTI[6]; {Y4}
ARTI[9]:= ARTI[7]; {X5}
ARTI[10]:=Y;
ARTI[11]:=X+L+K+L;
ARTI[12]:=Y;
ARTI[13]:=X+L+K+L;
ARTI[14]:=Y+K;
ARTI[15]:=ARTI[9];
ARTI[16]:= Y+K;
ARTI[17]:= ARTI[9];
ARTI[18]:= Y+K+L;
ARTI[19]:= X+L;
ARTI[20]:= Y+L+K;
ARTI[21]:= X+L;
ARTI[22]:= Y+K;
ARTI[23]:= X;
ARTI[24]:= Y+K;

FILLPOLY(12,ARTI);
END;


BEGIN

GRAFIKSURUCU:=DETECT;
INITGRAPH (GRAFIKSURUCU, GRAFIKKONUMU,'C:\TP\BGI');
IF GRAPHRESULT<>GROK THEN HALT(1);
CLEARDEVICE;

SETFILLSTYLE (j-3,12-i);
L:=10;
K:=20 ;

FOR i := 1 TO 10 DO
FOR j := 1 TO 10 DO
BEGIN
ARTICIZ(100+(i-1)*(L+K+L),50+(J-1)*(L+K+L),L-i,K-j);
END;

READLN;
CLOSEGRAPH;
END.

UYGULAMA 29 (Artilar)- 9 Nisan 2010

{Serdar'dan}
program pattern;
uses dos, crt, graph, printer;
var gs, gm : integer;
var xstart, ystart, rep, x, y, d, i, j :integer;
arti : array [1..24] of integer;

procedure articiz (x,y,d: word);
begin

arti[1]:=x; {x1}
arti[2]:=y; {y1}

arti[3]:=x+d; {2}
arti[4]:=y;

arti[5]:=x+d; {3}
arti[6]:=y-d;

arti[7]:=x+2*d; {4}
arti[8]:=y-d;

arti[9]:=x+2*d; {5}
arti[10]:=y;

arti[11]:=x+3*d; {6}
arti[12]:=y;

arti[13]:=x+3*d; {7}
arti[14]:=y+d;

arti[15]:=x+2*d; {8}
arti[16]:=y+d;

arti[17]:=x+2*d; {9}
arti[18]:=y+2*d;

arti[19]:=x+d; {10}
arti[20]:=y+2*d;

arti[21]:=x+d; {11}
arti[22]:=y+d;

arti[23]:=x; {12}
arti[24]:=y+d;

fillpoly (12, arti); {12 koseli ve arti dizinini kullanir}
end;

begin
gs:=detect;
initgraph (gs,gm,'c:\tp\bgi');
if graphresult <> grok then halt (1);
cleardevice;

setfillstyle (1,4);

xstart := 10; {baslangic x degeri}
ystart := -180; {baslangic y degeri}
rep := 40; {tekrar sayisi}

x := xstart;
y := ystart;
d := 15;

for i:=1 to rep do
begin
for j:=0 to rep do
begin
x := x+d*i*3;
y := y+d*i;

articiz (x,y,d);

x := xstart-d*j;
y := ystart+3*d*j;
end;
end;
readln;
closegraph;

end.

UYGULAMA 28 (Cokgenler) - 2 Nisan 2010

PROGRAM COKGENLER;
USES CRT, DOS, GRAPH, PRINTER;
VAR GRAFIKSURUCU, GRAFIKKONUMU,i,j:INTEGER;
ALTIGEN: ARRAY[1..12] OF INTEGER;

PROCEDURE ALTIGENCIZ (X,Y,L :WORD);
VAR X1,Y1,X2,Y2,X3,Y3,X4,Y4,X5,Y5,X6,Y6 :INTEGER;

BEGIN

ALTIGEN [1]:= X;
ALTIGEN [2] := Y;
ALTIGEN [3]:= X+L;
ALTIGEN [4]:= Y;
ALTIGEN [5] := ALTIGEN[3]+ L DIV 2;
ALTIGEN [6]:= Y- ROUND(SQRT (3) *L /2);
ALTIGEN [7]:= ALTIGEN [3];
ALTIGEN [8]:= Y- ROUND(SQRT (3) *L);
ALTIGEN [9]:= X;
ALTIGEN [10]:= Y- ROUND(SQRT (3) *L);
ALTIGEN [11]:= X- L DIV 2;
ALTIGEN [12]:= Y- ROUND(SQRT (3) *L /2);

SETCOLOR(6);
SETFILLSTYLE(3,9);
FILLPOLY (6,ALTIGEN);

END;

BEGIN
GRAFIKSURUCU:=DETECT;
INITGRAPH (GRAFIKSURUCU, GRAFIKKONUMU,'C: \TP\BGI');
IF GRAPHRESULT<>GROK THEN HALT(1);
CLEARDEVICE;

FOR i :=1 TO 15 DO
BEGIN
FOR j := 1 TO 20 DO
BEGIN
ALTIGENCIZ (i*40 ,j* 40,30-i-j);
END;
END;

READLN;
CLOSEGRAPH;
END.

UYGULAMA 27 - 2 Nisan 2010

PROGRAM NESTED;
USES CRT, DOS, GRAPH, PRINTER;
VAR GRAFIKSURUCU, GRAFIKKONUMU,i,j:INTEGER;
UCGEN: ARRAY[1..6] OF INTEGER;

PROCEDURE UCGENCIZ (X,Y,L :WORD);
VAR X1,Y1,X2,Y2,X3,Y3 :INTEGER;

BEGIN
X1:= X;
Y1:= Y;
X2:= X+L DIV 2 ;
Y2:= Y-ROUND( SQRT (3)* L/2);
X3:= X+L;
Y3:= Y;

UCGEN [1]:= X1; UCGEN [2] := Y1; UCGEN [3]:= X2;
UCGEN [4]:= Y2; UCGEN [5] := X3; UCGEN [6]:= Y3;

SETCOLOR(6);
SETFILLSTYLE(3,9);
FILLPOLY (3,UCGEN);

END;

BEGIN
GRAFIKSURUCU:=DETECT;
INITGRAPH (GRAFIKSURUCU, GRAFIKKONUMU,'C:\ TP\BGI');
IF GRAPHRESULT<>GROK THEN HALT(1);
CLEARDEVICE;

UCGENCIZ (300,400,200);

READLN;
CLOSEGRAPH;
END.

UYGULAMA 26 (Y = X *X )- 2 Nisan 2010

PROGRAM NESTED;
USES CRT, DOS, GRAPH, PRINTER;
VAR GRAFIKSURUCU, GRAFIKKONUMU,i,j:INTEGER;
XLER: ARRAY [1..20] OF INTEGER;
YLER: ARRAY [1..20] OF INTEGER;

BEGIN
GRAFIKSURUCU:=DETECT;
INITGRAPH (GRAFIKSURUCU, GRAFIKKONUMU,'C:\TP\BGI');
IF GRAPHRESULT<>GROK THEN HALT(1);
CLEARDEVICE;
SETBKCOLOR(15);
{ELLI[1]:=2;ELLI[2]:=4;ELLI[3]:=6;...}

FOR i:=1 TO 19 DO
BEGIN
LINE(XLER[i]*80, GETMAXY-YLER[i]*10, XLER[i+1]*80, GETMAXY -YLER[i+1]*10);
END;

FOR i:=1 TO 20 DO {xler 1den 20ye tamsayi, yler xlerin karesi}
BEGIN
XLER[i]:= i;
YLER[i]:= i*i;
END;

SETCOLOR(1);
SETLINESTYLE(SolidLn, 2, ThickWidth);
FOR i:=1 TO 19 DO
BEGIN
LINE(XLER[i]*30, GETMAXY-YLER[i], XLER[i+1]*30, GETMAXY -YLER[i+1]);
END;

{FOR i:=1 TO 19 DO
BEGIN
SETCOLOR(3);
LINE(0, GETMAXY-YLER[i], XLER[i]*30, GETMAXY -YLER[i]);
SETCOLOR(5);
LINE(XLER[i]*30, GETMAXY, XLER[i]*30, GETMAXY -YLER[i]);
END;}

READLN;
CLOSEGRAPH;
END.

UYGULAMA 25b - 2 Nisan 2010

PROGRAM NESTED;
USES CRT, DOS, GRAPH, PRINTER;
VAR GRAFIKSURUCU, GRAFIKKONUMU,i,j:INTEGER;

PROCEDURE CEMBER (XBOL, YBOL: INTEGER );
BEGIN
FOR i:= 1 TO XBOL+1 DO
BEGIN
FOR j:=1 TO YBOL+1 DO
BEGIN

IF(( i MOD 2 = 0 ) AND (j MOD 2 = 0)) THEN
SETFILLSTYLE(1,0)
ELSE IF ((i MOD 2 =1) AND( j MOD 2 =1)) THEN
SETFILLSTYLE (1, 0)

ELSE
SETFILLSTYLE (1,15);
FILLELLIPSE ( 0+GETMAXX DIV XBOL* (i-1),
0+GETMAXY DIV YBOL*(j-1),
GETMAXX DIV (XBOL*2),
GETMAXY DIV (YBOL*2));

END;
END;

FOR i:= 1 TO XBOL DO
BEGIN
FOR j:=1 TO YBOL DO
BEGIN
SETCOLOR (0);
SETFILLSTYLE (1,15);

FILLELLIPSE ( GETMAXX DIV (XBOL * 2) + GETMAXX DIV XBOL* (i-1),
GETMAXY DIV (YBOL * 2)+GETMAXY DIV YBOL*(j-1),
GETMAXX DIV (XBOL*2),
GETMAXY DIV (YBOL*2));

END;
END;

FOR i:= 1 TO XBOL+1 DO
BEGIN
FOR j:=1 TO YBOL+1 DO
BEGIN

ELLIPSE ( 0+GETMAXX DIV XBOL* (i-1),
0+GETMAXY DIV YBOL*(j-1),0,360,
GETMAXX DIV (XBOL*2),
GETMAXY DIV (YBOL*2));
END;
END;
END;

BEGIN
GRAFIKSURUCU:=DETECT;
INITGRAPH (GRAFIKSURUCU, GRAFIKKONUMU,'C:\PROGRA~1\TP\BGI');
IF GRAPHRESULT<>GROK THEN HALT(1);
CLEARDEVICE;

CEMBER (10,10);

READLN;
CLOSEGRAPH;
END.

UYGULAMA 25 - 2 Nisan 2010

PROGRAM NESTED;
USES CRT, DOS, GRAPH, PRINTER;
VAR GRAFIKSURUCU, GRAFIKKONUMU,i,j:INTEGER;

PROCEDURE CEMBER (XBOL, YBOL: INTEGER );
BEGIN
FOR i:= 1 TO XBOL+1 DO
BEGIN
FOR j:=1 TO YBOL+1 DO
BEGIN

IF(( i MOD 2 = 0 ) AND (j MOD 2 = 0)) THEN
SETFILLSTYLE(1,0)
ELSE IF ((i MOD 2 =1) AND( j MOD 2 =1)) THEN
SETFILLSTYLE (1, 0)

ELSE
SETFILLSTYLE (1,15);

FILLELLIPSE ( 0+GETMAXX DIV XBOL* (i-1),
0+GETMAXY DIV YBOL*(j-1),
GETMAXX DIV (XBOL*2),
GETMAXY DIV (YBOL*2));

END;
END;

FOR i:= 1 TO XBOL DO
BEGIN
FOR j:=1 TO YBOL DO
BEGIN
SETCOLOR (0);
SETFILLSTYLE (1,15);

FILLELLIPSE ( GETMAXX DIV (XBOL * 2) + GETMAXX DIV XBOL* (i-1),
GETMAXY DIV (YBOL * 2)+GETMAXY DIV YBOL*(j-1),
GETMAXX DIV (XBOL*2),
GETMAXY DIV (YBOL*2));

END;
END;
END;


BEGIN
GRAFIKSURUCU:=DETECT;
INITGRAPH (GRAFIKSURUCU, GRAFIKKONUMU,'C:\PROGRA~1\TP\BGI');
IF GRAPHRESULT<>GROK THEN HALT(1);
CLEARDEVICE;

CEMBER (15,15);

READLN;
CLOSEGRAPH;
END.

UYGULAMA 24 - 2 Nisan 2010

PROGRAM NESTED;
USES CRT, DOS, GRAPH, PRINTER;
VAR GRAFIKSURUCU, GRAFIKKONUMU,i,j:INTEGER;

PROCEDURE CEMBER (XBOL, YBOL: INTEGER );
BEGIN
FOR i:= 1 TO XBOL DO
BEGIN
FOR j:=1 TO YBOL DO
BEGIN

ELLIPSE (GETMAXX DIV (XBOL*2) + GETMAXX DIV XBOL * (i-1),
GETMAXY DIV (YBOL*2)+ GETMAXY DIV YBOL * (j-1),0,360, GETMAXX DIV (XBOL*2), GETMAXY DIV (YBOL*2));

{FILLELLIPSE kullanilirsa ici dolu cizer, komuttan once SETFILLSTYLE() kullanilmali}

END;
END;
END;

BEGIN
GRAFIKSURUCU:=DETECT;
INITGRAPH (GRAFIKSURUCU, GRAFIKKONUMU,'C:\PROGRA~1\TP\BGI');
IF GRAPHRESULT<>GROK THEN HALT(1);
CLEARDEVICE;

SETCOLOR (13);
CEMBER (5,3);

READLN;
CLOSEGRAPH;
END.

Fractals

TilingSample

Gradient

Geometric Pattern

kuculen kareler

program kare;
uses dos,crt,graph,printer;
var gs, gm, i, j , p,L,K:integer;
DIZI : ARRAY[1..8] of integer;

PROCEDURE kareciz (X,Y,a: INTEGER );
BEGIN
DIZI[1] := X; {X1}
DIZI[2] := Y;
DIZI[3] := X;
DIZI[4] :=Y-a;
DIZI[5] := X +a;
DIZI[6] := Y-a;
DIZI[7] := X+ a;
DIZI[8] := Y;
FILLPOLY(4,DIZI);
END;

procedure nestedkare (X,Y,aYeni:integer);
var Xsol, Ysol, aYenisol: integer;

begin
aYenisol:= aYeni;
Xsol:= X;
Ysol:= Y;
repeat
kareciz (X,Y, aYeni);
kareciz (Xsol,Ysol, aYeni);
X:= X+ aYeni;
Y:= Y- aYeni;
aYenisol:= round (aYenisol* 2/3);
Xsol:= Xsol - aYenisol;
Ysol:= Ysol- aYeni;

aYeni := round (aYeni* 2/3);
until aYeni < 10;
end;

begin
gs:=detect;
initgraph(gs,gm, 'c:\tp\bgi');
if graphresult <>grok then halt(1);
cleardevice;

setfillstyle(4,5);
nestedkare (getmaxx div 2, getmaxy , 100);

readln;
closegraph;
end.

fractal_tree

patterns

Georg Nees