jbas
asked on
how to produce this tree?
how to produce this tree?
[ x,y ]
/ | | \
[x,y-1] [x,y+1] [x-1,y] [x+1,y]
/ | | \ .......................... .
[x,y-1-1] [x,y-1+1] [x-1,y-1] [x+1,y-1]
my program is error.
type
MyPointArr=array[1..4] of TPoint;
function Tsimulate.MyProc(MyPoint:T Point):MyP ointArr;
var
TempPoint:TPoint;
TempArrStore:MyPointArr;
begin
TempPoint.X:=MyPoint.X;
TempPoint.Y:=MyPoint.Y-1;
TempArrStore[1]:=TempPoint ;
TempPoint.X:=MyPoint.X;
TempPoint.Y:=MyPoint.Y+1;
TempArrStore[2]:=TempPoint ;
TempPoint.X:=MyPoint.X-1;
TempPoint.Y:=MyPoint.Y;
TempArrStore[3]:=TempPoint ;
TempPoint.X:=MyPoint.X+1;
TempPoint.Y:=MyPoint.Y;
TempArrStore[4]:=TempPoint ;
result:=TempArrStore;
end;
thanks!
[ x,y ]
/ | | \
[x,y-1] [x,y+1] [x-1,y] [x+1,y]
/ | | \ ..........................
[x,y-1-1] [x,y-1+1] [x-1,y-1] [x+1,y-1]
my program is error.
type
MyPointArr=array[1..4] of TPoint;
function Tsimulate.MyProc(MyPoint:T
var
TempPoint:TPoint;
TempArrStore:MyPointArr;
begin
TempPoint.X:=MyPoint.X;
TempPoint.Y:=MyPoint.Y-1;
TempArrStore[1]:=TempPoint
TempPoint.X:=MyPoint.X;
TempPoint.Y:=MyPoint.Y+1;
TempArrStore[2]:=TempPoint
TempPoint.X:=MyPoint.X-1;
TempPoint.Y:=MyPoint.Y;
TempArrStore[3]:=TempPoint
TempPoint.X:=MyPoint.X+1;
TempPoint.Y:=MyPoint.Y;
TempArrStore[4]:=TempPoint
result:=TempArrStore;
end;
thanks!
ASKER
thanks!
i want to produce a "Vornoi diagrami"
how to do?(through any ways)
i want to produce a "Vornoi diagrami"
how to do?(through any ways)
Here is a unit I produced. It is translated from a java implementation. It is not ment for very large vornoi diagrams. I translated the HashTable they used to a stringlist. This is not very nice. The "GetSource" could be eliminated. This should get you started anyway.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Contnrs, StdCtrls;
type
TVoronoiPoint = class
public
X: Integer;
Y: Integer;
Z: Integer;
constructor Create(aX, aY: Integer);
end;
TVoronoiTriangle = class
p1, p2, p3, PC: TVoronoiPoint;
constructor Create(aP1, aP2, aP3: TVoronoiPoint);
procedure Draw(aCanvas: TCanvas);
end;
TVoronoiEdge = class
p1, p2: TVoronoiPoint;
constructor Create(aP1, aP2: TVoronoiPoint);
procedure Draw(aCanvas: TCanvas; aSource: string);
end;
TForm1 = class(TForm)
pbxVoronoi: TPaintBox;
Label1: TLabel;
procedure pbxVoronoiPaint(Sender: TObject);
procedure pbxVoronoiMouseDown(Sender : TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
fPoints: TObjectList;
fTriangles: TObjectList;
fEdges: TStringList;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TVoronoiPoint }
constructor TVoronoiPoint.Create(aX, aY: Integer);
begin
X := aX;
Y := aY;
Z := Sqr(X) + Sqr(Y);
end;
{ TVoronoiTriangle }
constructor TVoronoiTriangle.Create(aP 1, aP2, aP3: TVoronoiPoint);
var
dx2, dy2, dr2, dx3, dy3, dr3, A: Integer;
dx, dy: Extended;
begin
p1 := aP1;
p2 := aP2;
p3 := aP3;
dx2 := p2.x - p1.x;
dy2 := p2.y - p1.y;
dr2 := dx2 * dx2 + dy2 * dy2;
dx3 := p3.x - p1.x;
dy3 := p3.y - p1.y;
dr3 := dx3 * dx3 + dy3 * dy3;
A := 2 * (dx2 * dy3 - dx3 * dy2);
dx := (dr2 * dy3 - dr3 * dy2) / A;
dy := (dx2 * dr3 - dx3 * dr2) / A;
PC := TVoronoiPoint.Create(Round (p1.x + dx), Round(p1.y + dy));
end;
{ TVoronoiEdge }
constructor TVoronoiEdge.Create(aP1, aP2: TVoronoiPoint);
begin
P1 := aP1;
P2 := aP2;
end;
procedure TVoronoiEdge.Draw(aCanvas: TCanvas; aSource: string);
var
dx, dy: Extended;
v: Extended;
sp1, sp2: TVoronoiPoint;
procedure GetSource;
var
liPos: Integer;
begin
liPos := Pos('*', aSource);
sp1 := TVoronoiPoint(Pointer(StrT oInt(Copy( aSource, 1, liPos-1))));
sp2 := TVoronoiPoint(Pointer(StrT oInt(Copy( aSource, liPos+1, 100))));
end;
begin
aCanvas.MoveTo(p1.X, p1.Y);
if (p2<>nil) then
begin
aCanvas.LineTo(p2.X, p2.Y);
end else begin
GetSource;
dx := -(sp2.y - sp1.y);
dy := (sp2.x - sp1.x);
v := 1000 / Sqrt(Sqr(dx) + Sqr(dy));
dx := dx * v;
dy := dy * v;
aCanvas.LineTo(Round(p1.X + dx), Round(p1.Y + dy));
end;
end;
procedure TForm1.pbxVoronoiPaint(Sen der: TObject);
var
pi, pj, pk, pm, tmp: TVoronoiPoint;
xn, yn, zn: Extended;
i, j, k, m, p, idx: Integer;
lTriangle: TVoronoiTriangle;
lEdge: TVoronoiEdge;
begin
if fTriangles.Count = 0 then
begin
// paint the voronoi
for i := 0 to fPoints.Count-1 do
begin
pi := TVoronoiPoint(fPoints[i]);
for j := i + 1 to fPoints.Count-1 do
begin
pj := TVoronoiPoint(fPoints[j]);
for k := i + 1 to fPoints.Count-1 do
begin
pk := TVoronoiPoint(fPoints[k]);
zn := (pj.x - pi.x) * (pk.y - pi.y) - (pk.x - pi.x) * (pj.y - pi.y);
if (j = k) or (zn > 0) then
Continue;
xn := (pj.y - pi.y) * (pk.z - pi.z) - (pk.y - pi.y) * (pj.z - pi.z);
yn := (pk.x - pi.x) * (pj.z - pi.z) - (pj.x - pi.x) * (pk.z - pi.z);
idx := -1;
for m := 0 to fPoints.Count-1 do
begin
pm := TVoronoiPoint(fPoints[m]);
if (m<>i) and (m<>j) and (m<>k) and
(((pm.x - pi.x) * xn + (pm.y - pi.y) * yn + (pm.z - pi.z) * zn) > 0) then
begin
idx := m;
Break;
end;
end;
if idx = -1 then
begin
lTriangle := TVoronoiTriangle.Create(pi , pj, pk);
fTriangles.Add(lTriangle);
for p := 0 to 2 do
begin
idx := fEdges.IndexOf(IntToStr(In teger(pi)) +'*'+IntTo Str(Intege r(pj)));
if idx = -1 then
idx := fEdges.IndexOf(IntToStr(In teger(pj)) +'*'+IntTo Str(Intege r(pi)));
if idx = -1 then
begin
fEdges.AddObject(
IntToStr(Integer(pi))+'*'+ IntToStr(I nteger(pj) ),
TVoronoiEdge.Create(lTrian gle.PC, nil)
);
end else begin
TVoronoiEdge(fEdges.Object s[idx]).p2 := lTriangle.PC;
end;
tmp := pi;
pi := pj;
pj := pk;
pk := tmp;
end;
end;
end;
end;
end;
end;
pbxVoronoi.Canvas.Brush.Co lor := clWhite;
pbxVoronoi.Canvas.Pen.Colo r := clBlue;
pbxVoronoi.Canvas.FillRect (pbxVorono i.ClientRe ct);
for i := 0 to fTriangles.Count-1 do
begin
TVoronoiTriangle(fTriangle s[i]).Draw (pbxVorono i.Canvas);
end;
pbxVoronoi.Canvas.Pen.Colo r := clGreen;
for i := 0 to fEdges.Count-1 do
begin
lEdge := TVoronoiEdge(fEdges.Object s[i]);
lEdge.Draw(pbxVoronoi.Canv as, fEdges[i]);
end;
end;
procedure TForm1.pbxVoronoiMouseDown (Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
liEdge: Integer;
begin
// add point
fTriangles.Clear;
for liEdge := 0 to fEdges.Count-1 do
fEdges.Objects[liEdge].Fre e;
fEdges.Clear;
fPoints.Add(TVoronoiPoint. Create(X,Y ));
pbxVoronoi.Invalidate;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
fPoints := TObjectList.Create;
fTriangles := TObjectList.Create;
fEdges := TStringList.Create;
(*
fPoints.Add(TVoronoiPoint. Create(0,0 ));
fPoints.Add(TVoronoiPoint. Create(pbx Voronoi.Wi dth-1,0));
fPoints.Add(TVoronoiPoint. Create(0,p bxVoronoi. Height-1)) ;
fPoints.Add(TVoronoiPoint. Create(pbx Voronoi.Wi dth-1,pbxV oronoi.Hei ght-1));
*)
end;
procedure TForm1.FormDestroy(Sender: TObject);
var
liEdge: Integer;
begin
fPoints.Free;
fTriangles.Free;
for liEdge := 0 to fEdges.Count-1 do
fEdges.Objects[liEdge].Fre e;
fEdges.Free;
end;
procedure TVoronoiTriangle.Draw(aCan vas: TCanvas);
begin
aCanvas.MoveTo(p1.X, p1.Y);
aCanvas.LineTo(p2.X, p2.Y);
aCanvas.LineTo(p3.X, p3.Y);
aCanvas.LineTo(p1.X, p1.Y);
end;
end.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Contnrs, StdCtrls;
type
TVoronoiPoint = class
public
X: Integer;
Y: Integer;
Z: Integer;
constructor Create(aX, aY: Integer);
end;
TVoronoiTriangle = class
p1, p2, p3, PC: TVoronoiPoint;
constructor Create(aP1, aP2, aP3: TVoronoiPoint);
procedure Draw(aCanvas: TCanvas);
end;
TVoronoiEdge = class
p1, p2: TVoronoiPoint;
constructor Create(aP1, aP2: TVoronoiPoint);
procedure Draw(aCanvas: TCanvas; aSource: string);
end;
TForm1 = class(TForm)
pbxVoronoi: TPaintBox;
Label1: TLabel;
procedure pbxVoronoiPaint(Sender: TObject);
procedure pbxVoronoiMouseDown(Sender
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
fPoints: TObjectList;
fTriangles: TObjectList;
fEdges: TStringList;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TVoronoiPoint }
constructor TVoronoiPoint.Create(aX, aY: Integer);
begin
X := aX;
Y := aY;
Z := Sqr(X) + Sqr(Y);
end;
{ TVoronoiTriangle }
constructor TVoronoiTriangle.Create(aP
var
dx2, dy2, dr2, dx3, dy3, dr3, A: Integer;
dx, dy: Extended;
begin
p1 := aP1;
p2 := aP2;
p3 := aP3;
dx2 := p2.x - p1.x;
dy2 := p2.y - p1.y;
dr2 := dx2 * dx2 + dy2 * dy2;
dx3 := p3.x - p1.x;
dy3 := p3.y - p1.y;
dr3 := dx3 * dx3 + dy3 * dy3;
A := 2 * (dx2 * dy3 - dx3 * dy2);
dx := (dr2 * dy3 - dr3 * dy2) / A;
dy := (dx2 * dr3 - dx3 * dr2) / A;
PC := TVoronoiPoint.Create(Round
end;
{ TVoronoiEdge }
constructor TVoronoiEdge.Create(aP1, aP2: TVoronoiPoint);
begin
P1 := aP1;
P2 := aP2;
end;
procedure TVoronoiEdge.Draw(aCanvas:
var
dx, dy: Extended;
v: Extended;
sp1, sp2: TVoronoiPoint;
procedure GetSource;
var
liPos: Integer;
begin
liPos := Pos('*', aSource);
sp1 := TVoronoiPoint(Pointer(StrT
sp2 := TVoronoiPoint(Pointer(StrT
end;
begin
aCanvas.MoveTo(p1.X, p1.Y);
if (p2<>nil) then
begin
aCanvas.LineTo(p2.X, p2.Y);
end else begin
GetSource;
dx := -(sp2.y - sp1.y);
dy := (sp2.x - sp1.x);
v := 1000 / Sqrt(Sqr(dx) + Sqr(dy));
dx := dx * v;
dy := dy * v;
aCanvas.LineTo(Round(p1.X + dx), Round(p1.Y + dy));
end;
end;
procedure TForm1.pbxVoronoiPaint(Sen
var
pi, pj, pk, pm, tmp: TVoronoiPoint;
xn, yn, zn: Extended;
i, j, k, m, p, idx: Integer;
lTriangle: TVoronoiTriangle;
lEdge: TVoronoiEdge;
begin
if fTriangles.Count = 0 then
begin
// paint the voronoi
for i := 0 to fPoints.Count-1 do
begin
pi := TVoronoiPoint(fPoints[i]);
for j := i + 1 to fPoints.Count-1 do
begin
pj := TVoronoiPoint(fPoints[j]);
for k := i + 1 to fPoints.Count-1 do
begin
pk := TVoronoiPoint(fPoints[k]);
zn := (pj.x - pi.x) * (pk.y - pi.y) - (pk.x - pi.x) * (pj.y - pi.y);
if (j = k) or (zn > 0) then
Continue;
xn := (pj.y - pi.y) * (pk.z - pi.z) - (pk.y - pi.y) * (pj.z - pi.z);
yn := (pk.x - pi.x) * (pj.z - pi.z) - (pj.x - pi.x) * (pk.z - pi.z);
idx := -1;
for m := 0 to fPoints.Count-1 do
begin
pm := TVoronoiPoint(fPoints[m]);
if (m<>i) and (m<>j) and (m<>k) and
(((pm.x - pi.x) * xn + (pm.y - pi.y) * yn + (pm.z - pi.z) * zn) > 0) then
begin
idx := m;
Break;
end;
end;
if idx = -1 then
begin
lTriangle := TVoronoiTriangle.Create(pi
fTriangles.Add(lTriangle);
for p := 0 to 2 do
begin
idx := fEdges.IndexOf(IntToStr(In
if idx = -1 then
idx := fEdges.IndexOf(IntToStr(In
if idx = -1 then
begin
fEdges.AddObject(
IntToStr(Integer(pi))+'*'+
TVoronoiEdge.Create(lTrian
);
end else begin
TVoronoiEdge(fEdges.Object
end;
tmp := pi;
pi := pj;
pj := pk;
pk := tmp;
end;
end;
end;
end;
end;
end;
pbxVoronoi.Canvas.Brush.Co
pbxVoronoi.Canvas.Pen.Colo
pbxVoronoi.Canvas.FillRect
for i := 0 to fTriangles.Count-1 do
begin
TVoronoiTriangle(fTriangle
end;
pbxVoronoi.Canvas.Pen.Colo
for i := 0 to fEdges.Count-1 do
begin
lEdge := TVoronoiEdge(fEdges.Object
lEdge.Draw(pbxVoronoi.Canv
end;
end;
procedure TForm1.pbxVoronoiMouseDown
var
liEdge: Integer;
begin
// add point
fTriangles.Clear;
for liEdge := 0 to fEdges.Count-1 do
fEdges.Objects[liEdge].Fre
fEdges.Clear;
fPoints.Add(TVoronoiPoint.
pbxVoronoi.Invalidate;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
fPoints := TObjectList.Create;
fTriangles := TObjectList.Create;
fEdges := TStringList.Create;
(*
fPoints.Add(TVoronoiPoint.
fPoints.Add(TVoronoiPoint.
fPoints.Add(TVoronoiPoint.
fPoints.Add(TVoronoiPoint.
*)
end;
procedure TForm1.FormDestroy(Sender:
var
liEdge: Integer;
begin
fPoints.Free;
fTriangles.Free;
for liEdge := 0 to fEdges.Count-1 do
fEdges.Objects[liEdge].Fre
fEdges.Free;
end;
procedure TVoronoiTriangle.Draw(aCan
begin
aCanvas.MoveTo(p1.X, p1.Y);
aCanvas.LineTo(p2.X, p2.Y);
aCanvas.LineTo(p3.X, p3.Y);
aCanvas.LineTo(p1.X, p1.Y);
end;
end.
ASKER
to Jacco:
thanks for you help!
i produced it ,but it not good.
please see here.
http://www26.brinkster.com/jbaswjy/default.htm
i will continue it...
thanks for you help!
i produced it ,but it not good.
please see here.
http://www26.brinkster.com/jbaswjy/default.htm
i will continue it...
I have looked at your sources. You are trying to make the diagram using a kind of "flood fill" deterministic approach to building the diagram. I could change my implementation to do something like yours.
My appraoch uses a "brute force" mathematical approach. The sample I submitted as comment calculates all lines of the voronoi diagram. It is quit easy to change the program so that is fills the found diagram with colors.
Tell me what you want.
Regards Jacco
My appraoch uses a "brute force" mathematical approach. The sample I submitted as comment calculates all lines of the voronoi diagram. It is quit easy to change the program so that is fills the found diagram with colors.
Tell me what you want.
Regards Jacco
By the way you approuch will not give a real voronoi in the end because you "flood fill" only points that are white but they are not all at the same distence from the point in question.
if a point is (0,1) away it is length 1 away from the point
if a point is (1,1) away it is length sqrt(1^2 + 1^2) away which is roughly 0.707
If you want the floodfill approach you need to use points of concentric circles around the point.
Regards Jacco
if a point is (0,1) away it is length 1 away from the point
if a point is (1,1) away it is length sqrt(1^2 + 1^2) away which is roughly 0.707
If you want the floodfill approach you need to use points of concentric circles around the point.
Regards Jacco
ASKER
thanks!
i want to simulation the grain growth.
so i need a Vornoi diagrami to do it.
i worked it again,and please see this source code.
i ameliorate the source code and the speed is faster.
you can change the parameter:StartCore,Split in globunit.pas,it will change the graph.
i will continue to change the code.example:let the graph grow hexagon,octagon.....
what are you think?
http://www26.brinkster.com/jbaswjy/source2.rar
ps:my english is poor,sorry!
i want to simulation the grain growth.
so i need a Vornoi diagrami to do it.
i worked it again,and please see this source code.
i ameliorate the source code and the speed is faster.
you can change the parameter:StartCore,Split in globunit.pas,it will change the graph.
i will continue to change the code.example:let the graph grow hexagon,octagon.....
what are you think?
http://www26.brinkster.com/jbaswjy/source2.rar
ps:my english is poor,sorry!
ASKER
to Jacco:
this code is my friend produced.please consult.
{
nameFTXYLink
authorFcreation_zy
}
type
PXYLink=^XYLink;
XYLink=record
X,Y,Tag:Integer;
Next:PXYLink;
end;
TXYLink=class
private
FPXYLink:PXYLink;
FMemImg:array of array of Integer;
FWidth,FHeight:Integer;
FDefaultTag:Integer;
procedure FreeList(var PList:PXYLink);
procedure AddPointToList(X,Y,Tag:Int eger;var PList:PXYLink);
public
procedure AddSeekPoint(X,Y,Tag:Integ er);
procedure SetPoint(X,Y:Integer;Value :Integer=0 );
function GetPoint(X,Y:Integer):Inte ger;
procedure ExpandPointList;
constructor Create(Width,Height,Defaul tTag:Integ er);
destructor Destroy; override;
end;
{ TXYLink }
procedure TXYLink.AddPointToList(X, Y, Tag: Integer; var PList: PXYLink);
var
m:PXYLink;
begin
New(m);
m.X:=X;
m.Y:=Y;
m.Tag:=Tag;
m.Next:=PList;
PList:=m;
end;
procedure TXYLink.AddSeekPoint(X, Y, Tag: Integer);
begin
AddPointToList(X,Y,Tag,FPX YLink);
end;
constructor TXYLink.Create(Width, Height, DefaultTag: Integer);
var
i:Integer;
begin
FPXYLink:=nil;
FWidth:=Width;
FHeight:=Height;
FDefaultTag:=DefaultTag;
SetLength(FMemImg,FWidth);
for i:=0 to FWidth-1 do
begin
SetLength(FMemImg[i],FHeig ht);
FillChar(FMemImg[i][0],FHe ight*SizeO f(Boolean) ,0);
end;
end;
destructor TXYLink.Destroy;
var
i:Integer;
begin
FreeList(FPXYLink);
for i:=0 to FWidth-1 do
SetLength(FMemImg[i],0);
SetLength(FMemImg,0);
inherited;
end;
procedure TXYLink.ExpandPointList;
var
Head,pm:PXYLink;
procedure TestAndAdd(x0,y0,tag:Integ er);
begin
if (x0>=0) and (x0<FWidth) and (y0>=0) and (y0<FHeight) then
if FMemImg[x0][y0]=FDefaultTa g then //
begin
AddPointToList(x0,y0,tag,H ead);
FMemImg[x0][y0]:=tag;
end;
end;
begin
Head:=nil;
pm:=FPXYLink;
while pm<>nil do
begin
with pm^ do
begin
TestAndAdd(X-1,Y,Tag);
TestAndAdd(X+1,Y,Tag);
TestAndAdd(X,Y-1,Tag);
TestAndAdd(X,Y+1,Tag);
end;
pm:=pm.Next;
end;
FreeList(FPXYLink);
FPXYLink:=Head;
end;
procedure TXYLink.FreeList(var PList: PXYLink);
var
m:PXYLink;
begin
m:=PList;
while m<>nil do
begin
m:=PList.Next;
Dispose(PList);
PList:=m;
end;
PList:=nil;
end;
function TXYLink.GetPoint(X, Y: Integer): Integer;
begin
Result:=FMemImg[X][Y];
end;
procedure TXYLink.SetPoint(X, Y: Integer; Value: Integer);
begin
FMemImg[X][Y]:=Value;
end;
procedure TForm1.Button1Click(Sender : TObject);
var
PointList:TXYLink;
i,x,y:Integer;
begin
PointList:=TXYLink.Create( 200,200,In teger(clBl ack)); //Integer(clBlack))=0
PointList.AddSeekPoint(20, 60,Integer (clWhite)) ;
PointList.AddSeekPoint(150 ,100,Integ er(clRed)) ;
PointList.AddSeekPoint(80, 130,Intege r(clBlue)) ;
PointList.AddSeekPoint(99, 133,Intege r(clGreen) );
PointList.AddSeekPoint(166 ,39,Intege r(rgb(50,1 50,255)));
PointList.AddSeekPoint(77, 150,Intege r(rgb(100, 230,200))) ;
with Image1.Canvas do
for i:=1 to 100 do //ExpandPoint 100 numbers.
begin
PointList.ExpandPointList;
for x:=0 to 199 do
for y:=0 to 199 do
Pixels[x,y]:=TColor(PointL ist.GetPoi nt(x,y));
Application.ProcessMessage s;
end;
PointList.Free;
end;
this code is my friend produced.please consult.
{
nameFTXYLink
authorFcreation_zy
}
type
PXYLink=^XYLink;
XYLink=record
X,Y,Tag:Integer;
Next:PXYLink;
end;
TXYLink=class
private
FPXYLink:PXYLink;
FMemImg:array of array of Integer;
FWidth,FHeight:Integer;
FDefaultTag:Integer;
procedure FreeList(var PList:PXYLink);
procedure AddPointToList(X,Y,Tag:Int
public
procedure AddSeekPoint(X,Y,Tag:Integ
procedure SetPoint(X,Y:Integer;Value
function GetPoint(X,Y:Integer):Inte
procedure ExpandPointList;
constructor Create(Width,Height,Defaul
destructor Destroy; override;
end;
{ TXYLink }
procedure TXYLink.AddPointToList(X, Y, Tag: Integer; var PList: PXYLink);
var
m:PXYLink;
begin
New(m);
m.X:=X;
m.Y:=Y;
m.Tag:=Tag;
m.Next:=PList;
PList:=m;
end;
procedure TXYLink.AddSeekPoint(X, Y, Tag: Integer);
begin
AddPointToList(X,Y,Tag,FPX
end;
constructor TXYLink.Create(Width, Height, DefaultTag: Integer);
var
i:Integer;
begin
FPXYLink:=nil;
FWidth:=Width;
FHeight:=Height;
FDefaultTag:=DefaultTag;
SetLength(FMemImg,FWidth);
for i:=0 to FWidth-1 do
begin
SetLength(FMemImg[i],FHeig
FillChar(FMemImg[i][0],FHe
end;
end;
destructor TXYLink.Destroy;
var
i:Integer;
begin
FreeList(FPXYLink);
for i:=0 to FWidth-1 do
SetLength(FMemImg[i],0);
SetLength(FMemImg,0);
inherited;
end;
procedure TXYLink.ExpandPointList;
var
Head,pm:PXYLink;
procedure TestAndAdd(x0,y0,tag:Integ
begin
if (x0>=0) and (x0<FWidth) and (y0>=0) and (y0<FHeight) then
if FMemImg[x0][y0]=FDefaultTa
begin
AddPointToList(x0,y0,tag,H
FMemImg[x0][y0]:=tag;
end;
end;
begin
Head:=nil;
pm:=FPXYLink;
while pm<>nil do
begin
with pm^ do
begin
TestAndAdd(X-1,Y,Tag);
TestAndAdd(X+1,Y,Tag);
TestAndAdd(X,Y-1,Tag);
TestAndAdd(X,Y+1,Tag);
end;
pm:=pm.Next;
end;
FreeList(FPXYLink);
FPXYLink:=Head;
end;
procedure TXYLink.FreeList(var PList: PXYLink);
var
m:PXYLink;
begin
m:=PList;
while m<>nil do
begin
m:=PList.Next;
Dispose(PList);
PList:=m;
end;
PList:=nil;
end;
function TXYLink.GetPoint(X, Y: Integer): Integer;
begin
Result:=FMemImg[X][Y];
end;
procedure TXYLink.SetPoint(X, Y: Integer; Value: Integer);
begin
FMemImg[X][Y]:=Value;
end;
procedure TForm1.Button1Click(Sender
var
PointList:TXYLink;
i,x,y:Integer;
begin
PointList:=TXYLink.Create(
PointList.AddSeekPoint(20,
PointList.AddSeekPoint(150
PointList.AddSeekPoint(80,
PointList.AddSeekPoint(99,
PointList.AddSeekPoint(166
PointList.AddSeekPoint(77,
with Image1.Canvas do
for i:=1 to 100 do //ExpandPoint 100 numbers.
begin
PointList.ExpandPointList;
for x:=0 to 199 do
for y:=0 to 199 do
Pixels[x,y]:=TColor(PointL
Application.ProcessMessage
end;
PointList.Free;
end;
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
thanks.
ASKER
thanks to Jacco!
if you have finished,please tell me!
BTW:you is my first foreign friend,i fells good!
if you have finished,please tell me!
BTW:you is my first foreign friend,i fells good!
It all depends on how many levels deep you want to go. Do you want to use a tree structure? How do you want to navigate your tree? Do you want recursion? The way you describe it you will have lots of duplicate points in your tree.
X, Y = X + 1 - 1, Y etc
Regards Jacco