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.
30 Nisan 2010 Cuma
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.
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.
16 Nisan 2010 Cuma
Fibonacci'ye Değişik Bir Yorum
.jpg)
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.
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.
Kaydol:
Kayıtlar (Atom)

