More Trees: Different Pythagoras Tree Styles

[Boleeman]

A very nicely coloured Pythagoras Fractal Tree to play around with.
Perhaps would be nice to see BGRABmp version with varying opacity.

Converted from Fwend js source at https://github.com/fwend/Pythagoras-tree

Enjoy.

[Boleeman]

Another type with 5 random colors.

Code: Pascal  [Select][+][-]

1.  unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     procedure FormCreate(Sender: TObject);
16.     procedure FormPaint(Sender: TObject);
17.   private
18.     procedure PythagorasTree(x1, y1, x2, y2: Double; depth: Integer);
19.   public
20.     { public declarations }
21.   end;
22.  
23. var
24.   Form1: TForm1;
25.  
26. implementation
27.  
28. {$R *.lfm}
29.  
30. { TForm1 }
31.  
32. procedure TForm1.PythagorasTree(x1, y1, x2, y2: Double; depth: Integer);
33. var
34.   dx, dy, x3, y3, x4, y4, x5, y5: Double;
35. begin
36.   if depth > 10 then
37.     Exit;
38.  
39.   dx := x2 - x1;
40.   dy := y1 - y2;
41.   x3 := x2 - dy;
42.   y3 := y2 - dx;
43.   x4 := x1 - dy;
44.   y4 := y1 - dx;
45.   x5 := x4 + (dx - dy) / 2;
46.   y5 := y4 - (dx + dy) / 2;
47.  
48.   case Random(5) + 1 of
49.     1: Canvas.Pen.Color := clMaroon;
50.     2: Canvas.Pen.Color := clRed;
51.     3: Canvas.Pen.Color := clTeal;
52.     4: Canvas.Pen.Color := TColor($00A5FF);         //Orange color
53.     5: Canvas.Pen.Color := clGreen;
54.   end;
55.   Canvas.Pen.Width:=2;
56.   Canvas.Line(Round(x1), Round(y1), Round(x2), Round(y2));
57.   Canvas.Line(Round(x2), Round(y2), Round(x3), Round(y3));
58.   Canvas.Line(Round(x3), Round(y3), Round(x4), Round(y4));
59.   Canvas.Line(Round(x4), Round(y4), Round(x1), Round(y1));
60.  
61.   PythagorasTree(x4, y4, x5, y5, depth + 1);
62.   PythagorasTree(x5, y5, x3, y3, depth + 1);
63. end;
64.  
65. procedure TForm1.FormCreate(Sender: TObject);
66. begin
67.   Randomize;
68. end;
69.  
70. procedure TForm1.FormPaint(Sender: TObject);
71. var
72.   w, h, w2, diff: Integer;
73. begin
74.   w := 800;
75.   h := w * 11 div 16;
76.   w2 := w div 2;
77.   diff := w div 12;
78.  
79.   PythagorasTree(w2 - diff, h - 10, w2 + diff, h - 10, 0);
80. end;
81.  
82. end.

[Boleeman]

And two other variations:

Code: Pascal  [Select][+][-]

1.  unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls;
9.  
10. type
11.   { TForm1 }
12.  
13.   TForm1 = class(TForm)
14.     procedure FormPaint(Sender: TObject);
15.     procedure FormCreate(Sender: TObject);
16.   private
17.     procedure DrawPythagorasTree(x1, y1, x2, y2, currentDepth, maxDepth: Integer);
18.   public
19.     { Public declarations }
20.   end;
21.  
22. var
23.   Form1: TForm1;
24.  
25. implementation
26.  
27. {$R *.lfm}
28.  
29. procedure TForm1.FormCreate(Sender: TObject);
30. begin
31.   // Set the form size
32.   Width := 400;
33.   Height := 200;
34. end;
35.  
36. procedure TForm1.DrawPythagorasTree(x1, y1, x2, y2, currentDepth, maxDepth: Integer);
37. var
38.   dx, dy, x3, y3, x4, y4, x5, y5: Integer;
39.   colorIntensity: Double;
40.   newcolor: TColor;
41. begin
42.   Canvas.Pen.Color := clBlue;
43.   if currentDepth > 0 then
44.   begin
45.     // Calculate the differences in x and y coordinates between the two points
46.     dx := x2 - x1;
47.     dy := y2 - y1;
48.  
49.     // Calculate the coordinates for the three additional points to create the branches
50.     x3 := x2 - dy;
51.     y3 := y2 + dx;
52.     x4 := x1 - dy;
53.     y4 := y1 + dx;
54.     x5 := x4 + (dx - dy) div 2;
55.     y5 := y4 + (dx + dy) div 2;
56.  
57.     colorIntensity := 1.0 - (currentDepth / maxDepth);
58.     newcolor := RGBToColor(Round(255 * colorIntensity), Round(255 * colorIntensity), 255);
59.  
60.     Canvas.Polygon([Point(x1, ClientHeight - y1), Point(x4, ClientHeight - y4),
61.                     Point(x5, ClientHeight - y5), Point(x3, ClientHeight - y3),
62.                     Point(x2, ClientHeight - y2), Point(x1, ClientHeight - y1)]);
63.     Canvas.Brush.Color := newcolor;
64.  
65.     DrawPythagorasTree(x5, y5, x3, y3, currentDepth - 1, maxDepth);
66.     DrawPythagorasTree(x4, y4, x5, y5, currentDepth - 1, maxDepth);
67.   end;
68. end;
69.  
70. procedure TForm1.FormPaint(Sender: TObject);
71. var
72.   centerX: Integer;
73. begin
74.   // Calculate the center of the form
75.   centerX := ClientWidth div 2;
76.  
77.   // Adjust the starting points to the center
78.   DrawPythagorasTree(centerX - 100, 100, centerX + 100, 100, 8, 12);
79. end;
80.  
81. end.

and

Code: Pascal  [Select][+][-]

1.  unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls;
9.  
10. type
11.   { TForm1 }
12.  
13.   TForm1 = class(TForm)
14.     procedure FormPaint(Sender: TObject);
15.     procedure FormCreate(Sender: TObject);
16.   private
17.     procedure DrawPythagorasTree(x1, y1, x2, y2, currentDepth, maxDepth: Integer);
18.   public
19.     { Public declarations }
20.   end;
21.  
22. var
23.   Form1: TForm1;
24.  
25. implementation
26.  
27. {$R *.lfm}
28.  
29. procedure TForm1.FormCreate(Sender: TObject);
30. begin
31.   // Set the form size
32.   Width := 400;
33.   Height := 200;
34. end;
35.  
36. procedure TForm1.DrawPythagorasTree(x1, y1, x2, y2, currentDepth, maxDepth: Integer);
37. var
38.   dx, dy, x3, y3, x4, y4, x5, y5: Integer;
39.   colorIntensity: Double;
40.   newcolor: TColor;
41. begin
42.   Canvas.Pen.Color := clBlue;
43.   if currentDepth > 0 then
44.   begin
45.     // Calculate the differences in x and y coordinates between the two points
46.     dx := x2 - x1;
47.     dy := y2 - y1;
48.  
49.     // Calculate the coordinates for the three additional points to create the branches
50.     x3 := x2 - dy;
51.     y3 := y2 + dx;
52.     x4 := x1 - dy;
53.     y4 := y1 + dx;
54.     x5 := x4 + (dx - dy) div 2;
55.     y5 := y4 + (dx + dy) div 2;
56.  
57.     colorIntensity := 1.0 - (currentDepth / maxDepth);
58.     newcolor := RGBToColor(Round(255 * colorIntensity), Round(255 * colorIntensity), 255);
59.  
60.     Canvas.Polygon([Point(x1, ClientHeight - y1), Point(x4, ClientHeight - y4),
61.                     Point(x5, ClientHeight - y5), Point(x3, ClientHeight - y3),
62.                     Point(x2, ClientHeight - y2), Point(x1, ClientHeight - y1)]);
63.     Canvas.Brush.Color := newcolor;
64.  
65.     DrawPythagorasTree(x5, y5, x3, y3, currentDepth - 1, maxDepth);
66.     DrawPythagorasTree(x4, y4, x5, y5, currentDepth - 1, maxDepth);
67.   end;
68. end;
69.  
70. procedure TForm1.FormPaint(Sender: TObject);
71. var
72.   centerX: Integer;
73. begin
74.   // Calculate the center of the form
75.   centerX := ClientWidth div 2;
76.  
77.   // Adjust the starting points to the center
78.   DrawPythagorasTree(centerX - 100, 100, centerX + 100, 100, 8, 12);
79. end;
80.  
81. end.

[lainz]

 

Very good