一个漂亮的Delphi程序(Delphi在分形艺术中的应用)

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.