アルゴリズム図形の描画
|
| 52 |
AlgorithmGraphic |
動作確認 |
Delphi2007 |
更新日 |
2008/01/30(水) |
アルゴリズムの書籍にのっていた奇妙な図形を
Delphiで再現してみました。
リサージュ図形
ヒルベルト曲線
シェルピンスキー曲線
C曲線
ドラゴン曲線
非再帰版ドラゴン曲線
樹木曲線
不思議な三角形
3次元曲線
マンデルブロ集合
これらの図形が描画されます。
ソース内の定数を変えるとサイズや描画のパターンがいろいろ変化します
Imageを Width=500 Height=400 程度にして
10個のButtonイベントを以下のように記述してみてください。
────────────────────
//-------------------------------
//半径Rの正円を描く関数
//Rは正負どちらでも同じ
procedure Circle(Canvas: TCanvas; X, Y, R: Integer);
begin
Canvas.Ellipse(X-R, X-R, X+R, X+R);
end;
//-------------------------------
//半径Rx,Ryで指定した楕円を描く関数
//Rx,Ryは正負どちらでも同じ
procedure EllipseRadius(Canvas: TCanvas; X, Y, RX, RY: Integer);
begin
Canvas.Ellipse(X-RX, Y-RY, X+RX, Y+RY);
end;
//-------------------------------
//線を引く関数
procedure DrawLine(Canvas: TCanvas; X1, Y1, X2, Y2: Integer);
begin
Canvas.MoveTo(X1, Y1);
Canvas.LineTo(X2, Y2);
end;
//-------------------------------
//相対座標指定で移動
procedure MoveToRelative(Canvas: TCanvas; X, Y: Integer);
begin
X := Canvas.PenPos.X + X;
Y := Canvas.PenPos.Y + Y;
Canvas.MoveTo(X, Y);
end;
//-------------------------------
//相対座標指定で直線を引く
procedure LineToRelative(Canvas: TCanvas; X, Y: Integer);
begin
X := Canvas.PenPos.X + X;
Y := Canvas.PenPos.Y + Y;
Canvas.LineTo(X, Y);
end;
//-------------------------------
//四捨五入
function Roundoff(X: Extended): Longint;
begin
if x >= 0 then Result := Trunc(x + 0.5)
else Result := Trunc(x - 0.5);
end;
//-------------------------------
//リサージュ図形
procedure TForm1.Button1Click(Sender: TObject);
const
Size = 100;
var
i: Integer;
A: real;
begin
Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
with Image1.Canvas do
begin
MoveTo(Size*2, Size);
for i := 1 to 360 do
begin
A := Pi*i /180;
LineTo(Roundoff(Size * (cos(3*A)+1)), Roundoff(Size * (sin(5*A)+1)));
end;
end;
end;
//-------------------------------
//ヒルベルト曲線
procedure TForm1.Button2Click(Sender: TObject);
const
Order = 5; Size = 300;
var
i, H: Integer;
procedure RUL; forward;
procedure DLU; forward;
procedure LDR; forward;
procedure URD; forward;
procedure RUL;
begin
if I > 0 then
begin
i := I - 1;
with Image1.Canvas do
begin
URD; LineToRelative(Image1.Canvas, H, 0);
RUL; LineToRelative(Image1.Canvas, 0, H);
RUL; LineToRelative(Image1.Canvas,-H, 0);
DLU;
i := i +1;
end;
end;
end;
procedure DLU;
begin
if I > 0 then
begin
i := I - 1;
with Image1.Canvas do
begin
LDR; LineToRelative(Image1.Canvas, 0,-H);
DLU; LineToRelative(Image1.Canvas,-H, 0);
DLU; LineToRelative(Image1.Canvas, 0, H);
RUL;
i := i +1;
end;
end;
end;
procedure LDR;
begin
if I > 0 then
begin
i := I - 1;
with Image1.Canvas do
begin
DLU; LineToRelative(Image1.Canvas,-H, 0);
LDR; LineToRelative(Image1.Canvas, 0,-H);
LDR; LineToRelative(Image1.Canvas, H, 0);
URD;
i := i +1;
end;
end;
end;
procedure URD;
begin
if I > 0 then
begin
i := I - 1;
with Image1.Canvas do
begin
RUL; LineToRelative(Image1.Canvas, 0, H);
URD; LineToRelative(Image1.Canvas, H, 0);
URD; LineToRelative(Image1.Canvas, 0,-H);
LDR;
i := i +1;
end;
end;
end;
begin
Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
H := 1; for i := 2 to Order do H := H*2 +1;
H := Size div H; I := Order;
Image1.Canvas.MoveTo(0, 0);
MoveToRelative(Image1.Canvas, 0,0); RUL;
end;
//-------------------------------
//シェルピンスキー曲線
procedure TForm1.Button3Click(Sender: TObject);
const
Order = 5; Size = 300;
var
i, H: Integer;
procedure URD; forward;
procedure LUR; forward;
procedure DLU; forward;
procedure RDL; forward;
procedure URD;
begin
if I > 0 then
begin
i := I - 1;
with Image1.Canvas do
begin
URD; LineToRelative(Image1.Canvas, H, H);
LUR; LineToRelative(Image1.Canvas,2*H, 0);
RDL; LineToRelative(Image1.Canvas, H, -H);
URD;
i := i +1;
end;
end;
end;
procedure LUR;
begin
if I > 0 then
begin
i := I - 1;
with Image1.Canvas do
begin
LUR; LineToRelative(Image1.Canvas, -H, H);
DLU; LineToRelative(Image1.Canvas, 0,2*H);
URD; LineToRelative(Image1.Canvas, H, H);
LUR;
i := i +1;
end;
end;
end;
procedure DLU;
begin
if I > 0 then
begin
i := I - 1;
with Image1.Canvas do
begin
DLU; LineToRelative(Image1.Canvas, -H, -H);
RDL; LineToRelative(Image1.Canvas,-2*H, 0);
LUR; LineToRelative(Image1.Canvas, -H, H);
DLU;
i := i +1;
end;
end;
end;
procedure RDL;
begin
if I > 0 then
begin
i := I - 1;
with Image1.Canvas do
begin
RDL; LineToRelative(Image1.Canvas, H, -H);
URD; LineToRelative(Image1.Canvas, 0,-2*H);
DLU; LineToRelative(Image1.Canvas, -H, -H);
RDL;
i := i +1;
end;
end;
end;
begin
Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
H := 6; for i := 2 to Order do H := H*2 + 2;
H := Size div H; I := Order;
Image1.Canvas.MoveTo(0, 0);
MoveToRelative(Image1.Canvas, H, 0);
URD; LineToRelative(Image1.Canvas, H, H);
LUR; LineToRelative(Image1.Canvas, -H, H);
DLU; LineToRelative(Image1.Canvas, -H,-H);
RDL; LineToRelative(Image1.Canvas, H,-H);
end;
//-------------------------------
//C曲線
procedure TForm1.Button4Click(Sender: TObject);
const
MaxLength = 3.20;
procedure C(X, Y: real);
begin
if sqr(X) + sqr(Y) <= sqr(MaxLength) then
begin
LineToRelative(Image1.Canvas, Roundoff(X), Roundoff(Y))
end else
begin
C((X+Y)/2, (Y-X)/2);
C((X-Y)/2, (Y+X)/2);
end;
end;
begin
Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
MoveToRelative(Image1.Canvas, 0,0);
Image1.Canvas.MoveTo(150, 200);
C(200, 0);
end;
//-------------------------------
//ドラゴンカーブ
procedure TForm1.Button5Click(Sender: TObject);
const
MaxLength = 10;
procedure Dragon(X, Y: real; Sign: Integer);
begin
if sqr(X) + sqr(Y) <= sqr(MaxLength) then
begin
LineToRelative(Image1.Canvas, Roundoff(X), Roundoff(Y))
end else
begin
Dragon((X-Sign*Y)/2, (Y+Sign*X)/2, 1);
Dragon((X+Sign*Y)/2, (Y-Sign*X)/2,-1);
end;
end;
begin
Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
Image1.Canvas.MoveTo(150, 200);
Dragon(200, 0, 1);
end;
//-------------------------------
//非再帰版ドラゴンカーブ
procedure TForm1.Button6Click(Sender: TObject);
const
Order = 8;
var
K, I, P, Q, X, Y, NewX, NewY: Integer;
Fold: array[0..1023] of (Right, Left);
begin
Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
Image1.Canvas.MoveTo(200, 200);
X := 0; Y := 2;
LineToRelative(Image1.Canvas, 4*X, 4*Y);
P := 0;
for K := 1 to Order do
begin
Fold[P] := Left;
Q := 2*P;
for i := P to Q do
begin
case Fold[Q-I] of
Right: begin
Fold[I] := Left;
NewX := -Y; NewY := X;
end;
Left: begin
Fold[I] := Right;
NewX := Y; NewY := -X;
end;
else
NewX := 0; NewY := 0;
Assert(False,'エラー');
end;
LineToRelative(Image1.Canvas, X + NewX, Y + NewY);
LineToRelative(Image1.Canvas, 4 * NewX, 4 * NewY);
X := NewX;
Y := NewY;
end;
P := Q + 1;
end;
end;
//-------------------------------
//樹木曲線
procedure TForm1.Button7Click(Sender: TObject);
const
Factor = 0.7; Turn = 0.6;
procedure Tree(N: Integer; Length, Angle: real);
var
DX, DY: real;
begin
DX := Length* sin(Angle);
DY := Length* cos(Angle);
LineToRelative(Image1.Canvas, Roundoff(DX), Roundoff(DY));
if N > 1 then
begin
Tree(N - 1, Length * Factor, Angle + Turn);
Tree(N - 1, Length * Factor, Angle - Turn);
end;
MoveToRelative(Image1.Canvas, Roundoff(-DX), Roundoff(-DY));
end;
begin
Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
Image1.Canvas.MoveTo(200, 0);
Tree(6, 100, 0);
end;
//-------------------------------
//不思議な三角形
procedure TForm1.Button8Click(Sender: TObject);
procedure DrawSquare(I, J: Integer);
const
Side = 5;
begin
Image1.Canvas.MoveTo(Side * i, Side * j);
LineToRelative(Image1.Canvas, Side, 0);
LineToRelative(Image1.Canvas, 0, Side);
LineToRelative(Image1.Canvas,-Side, 0);
LineToRelative(Image1.Canvas, 0,-Side);
end;
const
N = 50; TwoN = 100;
var
I, J: Integer;
A, B: array[0..TwoN] of Boolean;
begin
Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
for i := 0 to TwoN do A[I] := false;
A[N] := true;
for j := N-1 downto 1 do
begin
for i := 1 to TwoN - 1 do if A[i] then DrawSquare(I, J);
for i := 1 to TwoN - 1 do B[i] := (A[i-1] <> A[i+1]);
for i := 1 to TwoN - 1 do A[I] := B[i];
end;
end;
//-------------------------------
//3次元曲線
procedure TForm1.Button9Click(Sender: TObject);
function DrawFunc(X, Z: real): real;
begin
Result := cos(10 * sqrt(sqr(X) + sqr(Z)));
end;
const
Xmin = -1; Xmax = 1; Zmin = -1; Zmax = 1; YScale =10;
var
X, Z: real;
I, Ix, Iz, Px, Py: Integer;
Ok, LastOk: boolean;
LowerHorizon, UpperHorizon: array[0..240] of Integer;
begin
Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
for i := 0 to 240 do
begin
LowerHorizon[i] := MaxInt; UpperHorizon[i] := - MaxInt;
end;
for Iz := 0 to 20 do
begin
Z := Zmin + (Zmax - Zmin) * Iz / 20; LastOk := False;
for Ix := 0 to 200 do
begin
X := Xmin + (Xmax - Xmin) * Ix /200;
I := Ix + 2 * (20-Iz); Px := 1 * I;
Py := Roundoff(YScale * DrawFunc(X, Z)) + 2 * Iz + 100;
Ok := false;
if Py < LowerHorizon[I] then
begin
LowerHorizon[I] := Py; Ok := true;
end;
if Py > UpperHorizon[I] then
begin
UpperHorizon[I] := Py; Ok := true;
end;
if Ok and LastOk then Image1.Canvas.LineTo(Px, Py)
else Image1.Canvas.MoveTo(Px, Py);
LastOk := Ok;
end;
end;
end;
//-------------------------------
//マンデルブロ集合
procedure TForm1.Button10Click(Sender: TObject);
const
Max = 255; Min = 50; Imax = 100; Jmax = 100; Scale = 3;
Xmin = 0.2691; Ymin = 0.0043; Step = 0.000002;
var
I, J, Count: Integer;
X, Y, A, B, A2, B2: real;
begin
Image1.Canvas.FillRect(Image1.Canvas.ClipRect);
for i := 0 to Imax do
begin
X := Xmin + step * I;
for j := 0 to Jmax do
begin
Y := Ymin + Step * J;
A := X; B:= Y; A2 := sqr(A); B2 := sqr(B); Count := 0;
while (A2 + B2 <= 4) and (Count < Max) do
begin
B := 2 * A * B + Y; A := A2 - B2 + X;
A2 := sqr(A); B2 := sqr(B); Count := Count + 1;
end;
if COunt > Min then
begin
Image1.Canvas.MoveTo(I * Scale, J * Scale);
LineToRelative(Image1.Canvas, 0, roundoff(Scale * (Count -Min) / (Max - Min)) );
end;
end;
end;
end;
|