From: "Alexander Weidauer" Subject: Re: Bezier curves Date: Monday, January 22, 2001 8:37 AM Andrea schrieb: > I'm looking for a function to draw a bezier curve starting from a variable > number of points > Can anyone help me ? > > Many thanks in advance From alex.weidauer@ifgdv-mv.de Function Bezier(x:Double;j:byte):Double; Begin Bezier:=0; case j of 0 : begin x:=1-x; Bezier:=x*x*x/6 end; 1 : Bezier:=x*x*(x/2-1)+4/6; 2 : Bezier:=x*(1+x*(1-x))/2+1/6; 3 : Bezier:=x*x*x/6; 10 : Bezier:=-(1-x)*(1-x)*x/2; 11 : Bezier:=1+x*x*(-5+3*x)/2; 12 : Bezier:=x*(1+x*(4-3*x))/2; 13 : Bezier:=-(1-x)*x*x/2; End; end; // -------------------------------------------------------------------- // If Smooth "Secantmodus" else "Tangential Modus" // Vc ..Polygon will be overwritten wiht bezierpoints // PointStep Lenght of PointDistance // -------------------------------------------------------------------- Procedure BezierPolygon(AppWin:TApplicationWindow; Smooth,Closed:Boolean; Vc:TXYPointList;PointStep:Double); Var i,j,k:Integer; l,step,sc,x,y:Double; VcTemp:TXYPointList; Point:TXYPoint; Begin AppWin.Status('..smooth polygons num before '+IntToStr(VC.MaxPoint)); if VC.MaxPoint<2 then exit; VcTemp:=TXYPointList.Create; if smooth then k:=0 else k:=10; (* Type der Interpolation *) (*------- handle start between 1 & 2-------- *) if closed then with Vc do begin sc:=sqrt(sqr(Points[2].x-Points[1].x)+sqr(Points[2].y-Points[1].y)); if sc=0 then sc:=1; step:=PointStep/sc; l:=0; repeat Application.ProcessMessages; for j:=0 to 3 do begin x:=Bezier(l,k)*Points[MaxPoint-1].x +Bezier(l,k+1)*Points[1].x +Bezier(l,k+2)*Points[2].x +Bezier(l,k+3)*Points[3].x; y:=Bezier(l,k)*Points[MaxPoint-1].y +Bezier(l,k+1)*Points[1].y +Bezier(l,k+2)*Points[2].y +Bezier(l,k+3)*Points[3].y; end; // end For Point:=TXYPoint.Create; Point.X:=X;Point.Y:=Y; VCTemp.Add(Point); l:=l+step; until l>1; End; // end With (* ----------- handle inside index 2 .. Max-2 -------------- *) with Vc do For i:=2 to MaxPoint-2 do begin sc:=sqrt(sqr(Points[i+1].x-Points[i].x)+sqr(Points[i+1].y-Points[i].y)); if sc=0 then sc:=1; step:=PointStep/sc; l:=0; Application.ProcessMessages; repeat x:=Bezier(l,k) *Points[i-1].x +Bezier(l,k+1)*Points[i ].x +Bezier(l,k+2)*Points[i+1].x +Bezier(l,k+3)*Points[i+2].x; y:=Bezier(l,k) *Points[i-1].y +Bezier(l,k+1)*Points[i ].y +Bezier(l,k+2)*Points[i+1].y +Bezier(l,k+3)*Points[i+2].y; Point:=TXYPoint.Create; Point.X:=X;Point.Y:=Y; VCTemp.Add(Point); l:=l+step; until l>1; End; (* ---- handle end of vector max-1 & max ---- *) if Closed then with Vc do begin sc:=sqrt(sqr(Points[MaxPoint].x-Points[MaxPoint-1].x) +sqr(Points[MaxPoint].y-Points[MaxPoint-1].y)); if sc=0 then sc:=1; step:=PointStep/sc; l:=0; Repeat for j:=0 to 3 do begin x:=Bezier(l,k) *Points[MaxPoint-2].x +Bezier(l,k+1)*Points[MaxPoint-1].x +Bezier(l,k+2)*Points[MaxPoint ].x +Bezier(l,k+3)*Points[2 ].x; y:=Bezier(l,k) *Points[MaxPoint-2].y +Bezier(l,k+1)*Points[MaxPoint-1].y +Bezier(l,k+2)*Points[MaxPoint ].y +Bezier(l,k+3)*Points[ 2].y; end; Point:=TXYPoint.Create; Point.X:=X;Point.Y:=Y; VCTemp.Add(Point); l:=l+step; until l>1; End; Vc.Clear; Vc.Copy(VcTemp); AppWin.Status('..smooth polygons num after '+IntToStr(VC.MaxPoint)); VcTemp.Destroy; End; TXYPoint and TXYPointList have definitions like this TXYPoint = Class(TObject) private fX, fY: Double; Public Constructor Create; Destructor Destroy; Override; Function ToStr:String; Procedure Copy(X:TXYPoint); Procedure Write(Port:TWriter); Procedure Read (Port:TReader); Procedure List (Port:TStrings); Procedure Transform (TRFM:TXForm); Procedure TransformOld(TRFM:TXForm); Function ReadASC (Var Line:String;EofLine:Boolean):Boolean; Function ReadASCTol (Var Line:String;EofLine:Boolean):Boolean; Function WriteASC(Line:String;EofLine:Boolean):String; Property X :Double Read fX write fX; Property Y :Double Read fY write fY; End; TXYPointList = class(TObject) ID : String; IsOpen: Boolean; Data : TList; Constructor Create; Destructor Destroy; Override; Procedure Clear; Procedure Add (P:TXYPoint); Procedure Insert (Index:Integer; P:TXYPoint); Procedure Delete (Index:Integer); Procedure Put (Index:Integer; P:TXYPoint); Function Get (Index:Integer) :TXYPoint; Procedure closedPut (Index:Integer; P:TXYPoint); Function closedGet (Index:Integer) :TXYPoint; Function NumOf:Integer; Procedure Extent (Min,Max:TXYPoint); Procedure Transform (TRFM:TXForm;DMIN,DMAX:TXYPoint); Function PolyLength:Double; Function GaussArea:Double; Procedure Clip (Min,Max:TXYPoint); Procedure Write(Port:TWriter); Procedure Read (Port:TReader); Procedure List (Port:TStrings); Function HeavyPoint :TXYPoint; Procedure Copy(X:TXYPointList); Procedure Rough(D:Double); Procedure OpenPolygon; Procedure ClosePolygon; Procedure CleanPolygon; Procedure ShiftIndexBack; Procedure ClearDouble; Procedure Pack; Function IsCut(P1,P2,P3:TXYPoint):Boolean; Function Nearest(Point:TXYPoint;Exclude:TXYPoint):Integer; Property Points[index:Integer]: TXYPoint read Get Write Put; Property ClosedPoints[index:Integer]: TXYPoint Read closedGet Write closedPut; Property MaxPoint:Integer Read NumOf; End; AppWin:TApplicationWindow; Is for Output control using Echo(S:String); --> Writeln... Status(S:String); --> MoveCursor(1,CurrentLine);ClrEol;Write... Have fun Alex !