unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls,globunit,Math;
type
Tsimulate = class(TForm)
Panel1: TPanel;
Button1: TButton;
pntbx: TPaintBox;
sjzd: TButton;
Label1: TLabel;
Button3: TButton;
initial: TButton;
procedure FormCreate(Sender: TObject);
procedure initialClick(Sender: TObject);
procedure sjzdClick(Sender: TObject);
private
procedure MyProc(MyPoint:TPoint;MyColor:Tcolor);
{ Private declarations }
public
{ Public declarations }
end;
var
simulate: Tsimulate;
implementation
{$R *.dfm}
function PointBorn(ThePoint:TPoint):TArrPoint;
var
TempPoint:TPoint;
TempArrPoint:TArrPoint;
begin
TempPoint.X:=ThePoint.X-1;
TempPoint.Y:=ThePoint.Y;
TempArrPoint[0]:=TempPoint;
TempPoint.X:=ThePoint.X;
TempPoint.Y:=ThePoint.Y-1;
TempArrPoint[1]:=TempPoint;
TempPoint.X:=ThePoint.X+1;
TempPoint.Y:=ThePoint.Y;
TempArrPoint[2]:=TempPoint;
TempPoint.X:=ThePoint.X;
TempPoint.Y:=ThePoint.Y+1;
TempArrPoint[3]:=TempPoint;
Result:=TempArrPoint;
end;
Procedure Tsimulate.MyProc(MyPoint:TPoint;MyColor:Tcolor);
begin
if simulate.pntbx.Canvas.Pixels[MyPoint.X,MyPoint.Y]=MyclColor then
simulate.pntbx.Canvas.Pixels[MyPoint.X,MyPoint.Y]:=MyColor;
end;
procedure Tsimulate.FormCreate(Sender: TObject);
begin
end;
{初始化ArrStorePoint，填入开始的坐标.[I,1],[I,2]}
procedure Tsimulate.initialClick(Sender: TObject);
var
X,Y,I,J,K,T,Q,E,F,PCount,PBle1,PBle2,PBle3:integer;
ArrPoint:TArrPoint;
TempPointStore:array of TPoint;
OutFlag:boolean;
begin
{填充色彩.}
for I:=0 to simulate.pntbx.Widthdo
begin
for J:=0 to simulate.pntbx.Heightdo
simulate.pntbx.Canvas.Pixels[I,J]:=MyclColor;
end;
setlength(ArrStorPoint,StartCore,5);
randomize;
for I:=0 to StartCore-1do
begin
X:=Random(simulate.pntbx.Width);
Y:=Random(simulate.pntbx.Height);
ArrStorPoint[I,0]:=point(X,Y);
simulate.pntbx.Canvas.Pixels[X,Y]:=ArrColorType;
ArrPoint:=PointBorn(ArrStorPoint[I,0]);
//第一次分裂.
for J:=1 to 4do
ArrStorPoint[I,J]:=ArrPoint[J-1];
end;
{初始化ArrStorePoint,把全部的点的坐标存储起来.}
for T:=1 to SpltCountdo
//第二次分裂开始.
begin
PCount:=4*T;
//需要分裂点的个数.
PBle1:=2*T*(T-1)+1;
//这次分裂开始点.
PBle2:=2*T*(T+1)+1;
//下一层的最左边的点.
PBle3:=2*(T+2)*(T+3)+1;
//需要存储的总共的点数.
setlength(ArrStorPoint,StartCore,PBle3);
for I:=0 to StartCore-1do
begin
Q:=0;
//表示为一层分裂后的总点数.8,12,16...
for J:=0 to PCount-1do
begin
application.ProcessMessages;
ArrPoint:=PointBorn(ArrStorPoint[I,PBle1+J]);
for K:=0 to 3do
begin
//过滤个别点.
OutFlag:=False;
//检查是否与上一层有相同的点.
for F:=0 to (PBle2-1)do
begin
if (ArrPoint[K].X=ArrStorPoint[I,F].X) and (ArrPoint[K].Y=ArrStorPoint[I,F].Y) then
OutFlag:=True;
end;
//检查是否与这一层的上一个点的扩展点有相同的点.
for F:=0 to Q-1do
begin
if (ArrPoint[K].X=TempPointStore[F].X) and (ArrPoint[K].Y=TempPointStore[F].Y) then
OutFlag:=True;
end;
//检查是否与这一层的这个点的其它点有相同的点.
for F:=0 to K-1do
begin
if (ArrPoint[K].X=ArrPoint[F].X) and (ArrPoint[K].Y=ArrPoint[F].Y) then
OutFlag:=True;
end;
if OutFlag=False then
begin
Q:=Q+1;
setlength(TempPointStore,Q);
TempPointStore[Q-1]:=ArrPoint[K];
end;
end;
end;
for E:=0 to Q-1do
ArrStorPoint[I,(PBle2+E)]:=TempPointStore[E];
end;
end;
application.MessageBox('完成初始化任务!','提醒窗口',0);
end;
procedure Tsimulate.sjzdClick(Sender: TObject);
var
I,J,K,M,PBle:integer;
begin
for I:=1 to SpltCountdo
begin
PBle:=2*I*(I-1)+1;
//最左边的点.
M:=4*I;
for K:=0 to StartCore-1do
begin
for J:=0 to M-1do
begin
application.ProcessMessages;
simulate.MyProc(ArrStorPoint[K,PBle+J],ArrColorType[K]);
end;
end;
end;
application.MessageBox('初始化完成！','提醒窗口',0);
end;
end.
] up
XYLink;//跟上面的PXYLink有关系吗?
!]