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

转载 2004年09月16日 16:48:00

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.

Delphi XE5 FireMonkey移动开发示例:Koch分形

这个例子是参照Processing中的例子写的。代码简洁明了,直接上代码: unit Example.KochFractal; interface uses System.SysUtils, ...
  • caowm
  • caowm
  • 2013年11月26日 16:52
  • 2943

Delphi SetParent 嵌入其他应用程序

[代码]Delphi实现窗体内嵌其他应用程序窗体 实现原理是启动一个应用程序,通过ProcessID得到窗体句柄,然后对其设定父窗体句柄为本程序某控件句柄(本例是窗体内一个Panel的句柄)...
  • xtfnpgy
  • xtfnpgy
  • 2014年10月08日 21:45
  • 1578

Delphi7简单DirectUI界面源码

界面效果 源码下载: http://download.csdn.net/detail/cometnet/5687875 unit CometSkin; interface uses ...
  • CometNet
  • CometNet
  • 2013年07月02日 18:07
  • 35546

Delphi创建服务程序

Windows 2000/XP和2003等支持一种叫做”服务程序”的东西.程序作为服务启动有以下几个好处: 不用登陆进系统即可运行. 具有SYSTEM特权.所以你在进程管理器里面是无法结束它的. 如何...
  • wsgqp
  • wsgqp
  • 2016年07月13日 20:13
  • 2713

delphi启动外部程序执行结束

一、为什么要启动外部程序 也许,你想让你的程序完成全部的功能。不过,无论从物力还是人力上,你都应养成资源共享的习惯。更好的考虑是,充分利用已有的程序,而让你的程序专注于某一方面的功能。比如说,浏...
  • wlanye
  • wlanye
  • 2016年06月23日 16:14
  • 1766

delphi 只允许运行一个实例的三种方法转

让程序只运行一个实例 Windows 下一个典型的特征就是多任务,我们可以同时打开多个窗口进行操作,也可以同时运行程序的多个实例,比如可以打开许多个资源管理器进行文件的移动复制操作。但有时出于某...
  • u013408061
  • u013408061
  • 2017年06月05日 13:39
  • 359

delphi程序向另一个可执行程序发消息

function FindWindowThroughWindowText(WindowText: string): THandle; var   hCurrentWindow: THandle; ...
  • zang141588761
  • zang141588761
  • 2016年07月29日 09:55
  • 1616

Delphi 执行控制台(console)程序获取返回结果

[delphi] view plain copy  print? function GetRunConsoleResult(FileName:String;Visibili...
  • chinajobs
  • chinajobs
  • 2016年12月21日 10:53
  • 772

delphi服务程序(service)的调试方法

delphi服务程序(service)的调试
  • Trassion
  • Trassion
  • 2013年08月02日 09:09
  • 7840

一个美观的进度条的使用

之前做一个项目的时候需要用到进度条,当时就觉得MFC提供的实在是太难看, 后来在网上扒拉了一个比较好看的。该进度条是继承了CStatic控件,所以在使用时, 需要添加一个CStatic控件,才能使用。...
  • kaishang0713
  • kaishang0713
  • 2013年11月20日 14:03
  • 1572
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:一个漂亮的Delphi程序(Delphi在分形艺术中的应用)
举报原因:
原因补充:

(最多只允许输入30个字)