### Bookstore

 Computer Math and Games in Pascal (preview) Lazarus Handbook

### Author Topic: More Trees: Different Pythagoras Tree Styles  (Read 796 times)

#### Boleeman

• Sr. Member
• Posts: 490
##### More Trees: Different Pythagoras Tree Styles
« on: January 26, 2024, 05:17:08 am »
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.

« Last Edit: January 31, 2024, 03:00:02 pm by Boleeman »

#### Boleeman

• Sr. Member
• Posts: 490
##### Re: Colourful Pythagoras Tree Fractal
« Reply #1 on: January 31, 2024, 11:16:23 am »
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

• Sr. Member
• Posts: 490
##### Re: Colourful Pythagoras Tree Fractal
« Reply #2 on: January 31, 2024, 02:59:16 pm »
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

• Hero Member
• Posts: 4522
• Web, Desktop & Android developer
##### Re: More Trees: Different Pythagoras Tree Styles
« Reply #3 on: January 31, 2024, 04:46:14 pm »

Very good