这个你看看吧,是一本书上的例程
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;
type
TBranchColor = record
r, g, b: Byte;
end;
TFormMain = class(TForm)
procedure FormResize(Sender: TObject);
procedure FormPaint(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);
procedure FractalTree(GenPointFrom: TPoint; GenLength, GenAngle: Real);
public
{ Public declarations }
procedure DrawTrunk();
procedure DrawBranch();
end;
var
FormMain: TFormMain;
implementation
{$R *.dfm}
uses Math;
const
PI = 3.1416;
PI2 = 2 * PI;
GEN_ANGLE_DEVIATION = PI2 / 16;
BRANCH_RATIO = 0.80;
PROBABILITY_THREASHOLD = 0.10;
procedure TFormMain.DrawFractalTree(GenPointFrom: TPoint; GenLength, GenAngle: Real; BranchWidth: Integer; BranchColor: TBranchColor);
function CanTerminate(GenPoint: TPoint; GenLength, GenAngle: 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, GenAngle) 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.DrawBranch;
begin
DrawFractalTree(FGenPointFrom, FGenLength*BRANCH_RATIO*BRANCH_RATIO, FGenAngle, FBranchWidth, FBranchColor);
// FractalTree(FGenPointFrom, FGenLength*BRANCH_RATIO, FGenAngle);
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.FractalTree(GenPointFrom: TPoint; GenLength, GenAngle: Real);
function CanTerminate(GenPoint: TPoint; GenLength, GenAngle: Real): Boolean;
begin
if (GenPoint.X < 0) or (GenPoint.X > Self.ClientWidth)
or (GenPoint.Y < 0) or (GenPoint.Y > Self.ClientHeight)
or (GenLength <= 1) or (GenAngle > PI2) or (GenAngle < 0) 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, GenAngle) then
begin // 中断绘制
System.Exit;
end
else
begin // 绘制左右树干
if System.Random > 0.0 then
begin // 绘制左树干
GenPointTo := ToPoint(GenPointFrom, GenLength, GenAngle, True);
Self.Canvas.MoveTo(GenPointFrom.X, GenPointFrom.Y);
Self.Canvas.LineTo(GenPointTo.X, GenPointTo.Y);
FractalTree(GenPointTo, GenLength*BRANCH_RATIO, GenAngle-GEN_ANGLE_DEVIATION);
end;
if System.Random > 0.0 then
begin // 绘制右树干
GenPointTo := ToPoint(GenPointFrom, GenLength, GenAngle, False);
Self.Canvas.MoveTo(GenPointFrom.X, GenPointFrom.Y);
Self.Canvas.LineTo(GenPointTo.X, GenPointTo.Y);
FractalTree(GenPointTo, GenLength*BRANCH_RATIO*BRANCH_RATIO, GenAngle+GEN_ANGLE_DEVIATION);
end;
end;
end;
procedure TFormMain.FormResize(Sender: TObject);
begin
// Self.SetParamters();
Self.Invalidate();
end;
procedure TFormMain.FormPaint(Sender: TObject);
begin
System.Randomize();
Self.SetParamters();
Self.DrawTrunk();
Self.DrawBranch();
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;
end.