30 Nisan 2010 Cuma

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

16 Nisan 2010 Cuma

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.