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);
end;
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 IsLeft then
begin
Result.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;
end;
var
GenPointTo: TPoint;
begin
if CanTerminate(GenPointFrom, GenLength) then
begin // 中斷繪製
System.Exit;
end
else
begin // 繪製左右樹幹
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 // 繪製左樹幹
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 // 繪製右樹幹
GenPointTo := ToPoint(GenPointFrom, GenLength, GenAngle, False);
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.Pen.Color:=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;
end;
procedure TFormMain.FormCreate(Sender: TObject);
begin
self.Color:=clWindow;
end;
end.