Unit unit1;
Interface
Uses Windows, Messages, Sysutils, Variants, Classes, Graphics, Controls, Forms, Dialogs
Type Tbranchcolor = Record R, G, B: Byte; end;
TFormMain = class (TForm) procedure FormResize (Sender: TObject); procedure FormPaint (Sender: TObject); procedure FormCreate (Sender: TObject); private {Private declarations} FGenPointFrom: TPoint; FGenLength: Real; FGenAngle: Real; FBranchWidth: Integer ; FBranchColor: TBranchColor; Procedure SetParamters (); Procedure DrawFractalTree (GenPointFrom: TPoint; GenLength, GenAngle: Real; BranchWidth: Integer; BranchColor: TBranchColor); public {public declarations} Procedure DrawTrunk (); Procedure DrawBranch (); end;
Var formmain: tFormmain;
Const pi = 3.1416; pi2 = 2 * pi; gen_angle_deviation = pi2 / 16; branch_ratio = 0.80; probability_threashold = 0.10;
IMPLEMENTATION
{$ R * .dfm}
Procedure TFormMain.formResize (Sender: TOBJECT); Begin Self.INVALIDATE; END;
Procedure tFormmain.FormPaint (Sender: TOBJECT); begin system.randomize (); self.setparamters (); self.drawtrunk (); self.drawbranch (); end;
Procedure tFormmain.drawbranch; Begin DrawFractaltree (FgenpointFrom, FgenLength * Branch_ratio * branch_ratio, fgenangle, fbranchwidth, fbranchcolor);
procedure TFormMain.DrawFractalTree (GenPointFrom: TPoint; GenLength, GenAngle: Real; BranchWidth: Integer; BranchColor: TBranchColor); function CanTerminate (GenPoint: TPoint; GenLength: Real): Boolean; begin if (GenPoint.X <0) or (GenPoint .X> self.clientwidth or (genpoint.y <0) or (genpoint.y> self.clientHeight) or (GenLength <1) Then Result: = true else result: = false; end; function topoint (GenPointFrom: tpoint Genlength, Genangle: Real; isleft: boolean: tpoint; begin if Islean: tpoint; becom.x: = genpointfrom.x trunc (GenLength * COS (Genangle - Gen_angle_deviation); result.y: = genpointFrom.Y Trunc (GenLength * sin (GenAngle - GEN_ANGLE_DEVIATION)); end else begin Result.X: = GenPointFrom.X Trunc (GenLength * cos (GenAngle GEN_ANGLE_DEVIATION)); Result.Y: = GenPointFrom.Y Trunc (GenLength * sin ( Genangle gen_angle_deviation); end;
var GenPointTo: TPoint; begin if CanTerminate (GenPointFrom, GenLength) then begin // interrupt drawing System.Exit; end else begin // drawn around the trunk Application.ProcessMessages (); if BranchWidth> 2 then Dec (BranchWidth, 2) else BranchWidth : = 1; if BranchColor.g <222 then Inc (BranchColor.g, 8) else BranchColor.g: = 229; if System.Random> PROBABILITY_THREASHOLD then begin // draw left trunk GenPointTo: = ToPoint (GenPointFrom, GenLength, GenAngle , True; self.canvas.pen.width: = branchwidth; self.canvas.pen.color: = RGB (branchcolor.r, branchcolor.g, branchcolor.b); self.canvas.moveto (genpointfrom.x, genpointfrom .Y); Self.Canvas.LineTo (GenPointTo.X, GenPointTo.Y); DrawFractalTree (GenPointTo, GenLength * BRANCH_RATIO, GenAngle-GEN_ANGLE_DEVIATION, BranchWidth, BranchColor); end; if System.Random> PROBABILITY_THREASHOLD then begin // draw the right Trunk genpointto: = Topoint (genpointfrom, genlength; self.canvas.pen.width: = branchwidth; Self.canvas.pen.color: = RGB (branchcolor.r, branchcolor.g, branchcolor.b); self.canvas.moveto (genpointfrom.x, genpointfrom.y); self.canvas.lineto (genpointto.x, genpointto .Y); DrawFractalTree (GenPointTo, GenLength * BRANCH_RATIO, GenAngle GEN_ANGLE_DEVIATION, BranchWidth, BranchColor); end; end; end; procedure TFormMain.DrawTrunk; var GenPointTo: TPoint; begin GenPointTo.X: = FGenPointFrom.X; GenPointTo.Y : = Fgenpointfrom.Y-trunc (fgenLength); self.canvas.pen.width: = fbranchwidth; self.canvas.plor: = RGB (fbranchcolor.r, fbranchcolor.g, fbranchcolor.b); Self.canvas. MoveTo (fgenpointfrom.x, fgenpointfrom.y); self.canvas.lineto (genpointto.x, genpointto.y);
Self.FGenPointFrom: = GenPointTo; end; procedure TFormMain.SetParamters; begin Self.FGenPointFrom.X: = Self.ClientWidth div 2; Self.FGenPointFrom.Y: = Self.ClientHeight; Self.FGenLength: = Self.ClientHeight / 4; Self.fgenangle: = pi2 * 3/4; self.fbranchWidth: = 10; self.fbranchcolor.r: = 50; self.fbranchcolor.g: = 50; self.fbranchcolor.b: = 50;
Procedure tformmain.formcreate (sender: TOBJECT); Begin Self.color: = CLWINDOW; END;
End.
