Splines component

Top  Previous  Next

           unit Splines;

{

------------------------------------------------------------------------------

}

{

 

}

{

This unit was generated on 22-05-97 11:50:12 by                            

}

{

   the RTE Software Component Generator.                                   

}

{

 

}

{

 

}

{

This code was written by : M. v. Engeland                                  

}

{

 

}

{

This code is copyright 1997 by                                             

}

{

      M. v. Engeland                                                       

}

{

 

}

{

 

}

{

  This is a freeware component for handling B-splines. You may use this    

}

{

  component in any way you want to, as long as you don't sell it or use    

}

{

  it for commercial applications. But I would appreciate it if you would   

}

{

  send me an e-mail (martijn@dutw38.wbmt.tudelft.nl) to tell me why you use

}

{

  it, what program you use it for or if you appreciate it. Also all comments

}

{

  and/or remarks are welcome. Currently I'm working on a component for     

}

{

  handling and displaying NURBS and NURB surfaces. Both components are     

}

{

  developed to be part of a 3D-CAD program for designing ship hulls at the 

}

{

  Delft Technical University in the Netherlands. See the demo program      

}

{

  for handling the component. Special attention is payed on the possibility

}

{

  of interpolating the vertices. As you may know B-Splines do not          

}

{

  interpolate the used vertices. Thanks to matrix calculation it is possible

}

{

  interpolate the by means of calculating a number of knew vertices in such

}

{

  a way that the spline interpolates the original ones.                    

}

{

------------------------------------------------------------------------------

}

 

interface

 

uses windows,

    sysutils,

    classes,

    dialogs;

 

const

    MaxNoVertices = 100; {

Maximum number of vertices in a spline. Could be more though..'

}

 

type

    TVertex = record {

All vertices are 3D. Simply remove the Z-variable if you want to work 2D

}

         X, Y, Z: Single;

    end;

 

    PSplineRow = ^TSplineRow;

    TSplineRow = array[0..0] of TVertex; {

Dynamic array to keep memory use minimal and speed maximal !

}

 

    TBSpline = class {

B-Spline object

}

    private

         NoPoints: Integer;

         VertexList: PSplineRow;

         FInterpolated: boolean;

    public

         constructor Create;

 

         procedure Free;

         procedure Clear;

         procedure PhantomPoints; {

B-Splines use phantompoints to interpolate begin and end points

}

         procedure Interpolate; {

B-Splines can interpolate vertices if you want them to !

}

         function Value(Parameter: Single): TVertex; {

Value of a spline. Valid for parameter 0 (Start of spline

         through 1 (end of line)

}

         procedure AddVertex(Vertex: TVertex);

         procedure InsertVertex(Pos: Integer; Vertex: TVertex);

         procedure DeleteVertex(VertexNr: word);

         procedure ChangeVertex(VertexNr: word; X, Y: Single);

         function NumberOfVertices: word;

         function VertexIsKnuckle(var Nr: integer): boolean; {

A knuckle is obtained by inserting a vertex 3 times

}

         procedure KnuckleOn(Nr: integer);

         procedure KnuckleOff(Nr: integer);

         function VertexNr(Nr: integer): TVertex;

    published

         property Interpolated: boolean read FInterpolated;

    end;

 

    TSplines = class(TComponent) {

Component to store all B-Splines in

}

    private {

Private Declarations

}

         FSplineRow: TList;

         function GetNumberOfSplines: word;

    protected {

Protected Declarations

}

    public {

Public Declarations

}

         constructor Create(AOwner: TComponent); override;

         destructor Destroy; override;

         procedure AddSpline(BSpline: TBSpline);

         procedure Clear;

         procedure InsertSpline(Pos: Integer; BSpline: TBSpline);

         procedure DeleteSpline(BSpline: TBSpline);

         function GetSplineNr(Nr: Word): TBSpline;

    published

         property NumberOfSplines: word read GetNumberOfSplines;

    end;

 

procedure Register;

 

implementation

 

constructor TBSpline.Create;

begin

    inherited create;

    FInterpolated := false;

    NoPoints := 0;

    GetMem(VertexList, (MaxNoVertices + 2) * SizeOf(TVertex));

end; {

TBSpline.Create

}

 

procedure TBSpline.Free;

begin

    if VertexList <> nil then FreeMem(VertexList, (MaxNoVertices + 2) * SizeOf(TVertex));

    inherited free;

end; {

TBSpline.Free

}

 

procedure TBSpline.Clear;

begin

    FInterpolated := false;

    NoPoints := 0;

end; {

TBSpline.Clear

}

 

procedure TBSpline.PhantomPoints;

var

    index: integer;

begin

    if NoPoints > 1 then

    begin

         index := 0;

         VertexList^[index].x := 2 * VertexList^[index + 1].x - VertexList^[index + 2].x;

         VertexList^[index].y := 2 * VertexList^[index + 1].y - VertexList^[index + 2].y;

         VertexList^[index].Z := 2 * VertexList^[index + 1].z - VertexList^[index + 2].z;

         VertexList^[NoPoints + 1].x := 2 * VertexList^[NoPoints].x - VertexList^[NoPoints - 1].x;

         VertexList^[NoPoints + 1].y := 2 * VertexList^[NoPoints].y - VertexList^[NoPoints - 1].y;

         VertexList^[NoPoints + 1].z := 2 * VertexList^[NoPoints].z - VertexList^[NoPoints - 1].z;

    end;

end; {

TBSpline.PhantomPoints

}

 

procedure TBSpline.Interpolate;

const

    MaxError = 1E-6;

    MatrixSize = MaxNoVertices + 2;

type

    TMatrix = array[1..MatrixSize, 1..MatrixSize] of single;

    PMatrix = ^TMatrix;

var

    Matrix: PMatrix;

    Size: word;

    a, b, c: integer;

    Factor: single;

    Tmp: PSplineRow;

begin

    if NoPoints < 3 then exit;

    GetMem(Tmp, (NoPoints + 2) * SizeOf(TVertex));

    Size := SizeOf(TMatrix);

    GetMem(Matrix, Size);

    FillChar(matrix^, Size, 0);

    for a := 2 to NoPoints - 1 do

    begin

         matrix^[a, a - 1] := 1 / 6;

         matrix^[a, a] := 2 / 3;

         matrix^[a, a + 1] := 1 / 6;

    end;

    Matrix^[1, 1] := 1;

    Matrix^[NoPoints, NoPoints] := 1;

    for a := 2 to NoPoints - 1 do

         if (abs(VertexList^[a].x - VertexList^[a - 1].x) < 1E-5) and (abs(VertexList^[a].x - VertexList^[a + 1].x) < 1E-5)

              and (abs(VertexList^[a].y - VertexList^[a - 1].y) < 1E-5) and (abs(VertexList^[a].y - VertexList^[a + 1].y) < 1E-5) then

              for b := a - 1 to a + 1 do

              begin

                   matrix^[b, b - 1] := 0;

                   matrix^[b, b] := 1;

                   matrix^[b, b + 1] := 0;

              end;

    for a := 1 to NoPoints do

         if abs(Matrix^[a, a]) < MaxError then

         begin

              FreeMem(Matrix, Size);

              FreeMem(Tmp, (NoPoints + 2) * SizeOf(TVertex));

              exit;

         end;

    for a := 1 to NoPoints do

    begin

         for b := a + 1 to NoPoints do

         begin

              factor := Matrix^[b, a] / Matrix^[a, a];

              for c := 1 to NoPoints do

                   Matrix^[b, c] := matrix^[b, c] - factor * matrix^[a, c];

              VertexList^[b].x := VertexList^[b].x - factor * VertexList^[b - 1].x;

              VertexList^[b].y := VertexList^[b].y - factor * VertexList^[b - 1].y;

         end;

    end;

    Tmp^[NoPoints].x := VertexList^[NoPoints].x / Matrix^[NoPoints, NoPoints];

    Tmp^[NoPoints].y := VertexList^[NoPoints].y / Matrix^[NoPoints, NoPoints];

    for a := NoPoints - 1 downto 1 do

    begin

         Tmp^[a].x := (1 / Matrix^[a, a]) * (VertexList^[a].x - Matrix^[a, a + 1] * Tmp^[a + 1].x);

         Tmp^[a].y := (1 / Matrix^[a, a]) * (VertexList^[a].y - Matrix^[a, a + 1] * Tmp^[a + 1].y);

    end;

    FreeMem(VertexList, (NoPoints + 2) * SizeOf(TVertex));

    VertexList := Tmp;

    FreeMem(Matrix, Size);

    PhantomPoints;

    FInterpolated := true;

end; {

TBSpline.Interpolate

}

 

function TBSpline.Value(Parameter: Single): TVertex;

var

    b, c: integer;

    Dist: extended;

    Mix: extended;

begin

    Result.X := 0;

    Result.Y := 0;

    Result.Z := 0;

    b := trunc((NoPoints - 1) * Parameter);

    for c := b - 2 to b + 3 do

    begin

         dist := abs((NoPoints - 1) * parameter - (c - 1));

         if dist < 2 then

         begin

              if dist < 1 then

                   mix := 4 / 6 - dist * dist + 0.5 * dist * dist * dist

              else

                   mix := (2 - dist) * (2 - dist) * (2 - dist) / 6;

              result.x := result.x + VertexList^[c].x * mix;

              result.y := result.y + VertexList^[c].y * mix;

              result.z := result.z + VertexList^[c].z * mix;

         end;

    end;

end; {

TBSpline.Value

}

 

function TBSpline.VertexIsKnuckle(var Nr: integer): boolean;

var

    V1, V2, V3: TVertex;

begin

    Result := false;

    if (Nr > 1) and (Nr < NoPoints - 1) then

    begin

         V1 := VertexNr(Nr - 2);

         V2 := VertexNr(Nr - 1);

         V3 := VertexNr(Nr);

         if (abs(V1.X - V2.X) < 1E-5) and (abs(V2.X - V3.X) < 1E-5) and (abs(V1.Y - V2.Y) < 1E-5) and (abs(V2.Y - V3.Y) < 1E-5) then

         begin

              Result := true;

              Nr := Nr - 1;

              exit;

         end;

         V1 := VertexNr(Nr - 1);

         V2 := VertexNr(Nr);

         V3 := VertexNr(Nr + 1);

         if (abs(V1.X - V2.X) < 1E-5) and (abs(V2.X - V3.X) < 1E-5) and (abs(V1.Y - V2.Y) < 1E-5) and (abs(V2.Y - V3.Y) < 1E-5) then

         begin

              Result := true;

              exit;

         end;

         V1 := VertexNr(Nr);

         V2 := VertexNr(Nr + 1);

         V3 := VertexNr(Nr + 2);

         if (abs(V1.X - V2.X) < 1E-5) and (abs(V2.X - V3.X) < 1E-5) and (abs(V1.Y - V2.Y) < 1E-5) and (abs(V2.Y - V3.Y) < 1E-5) then

         begin

              Result := true;

              Nr := Nr + 1;

              exit;

         end;

    end;

end; {

TBSpline.VertexIsKnuckle

}

 

procedure TBSpline.KnuckleOn(Nr: integer);

var

    I: integer;

begin

    if NoPoints < MaxNoVertices - 2 then

    begin

         Inc(NoPoints, 2);

         for I := NoPoints downto Nr + 2 do

              VertexList^[I] := VertexList^[I - 2];

         VertexList^[Nr + 1] := VertexList^[Nr];

         VertexList^[Nr + 2] := VertexList^[Nr];

         PhantomPoints;

    end

    else

         MessageDlg('Maximum number of vertices reached.', mtError, [mbOk], 0);

end; {

TBSpline.KnuckleOn

}

 

procedure TBSpline.KnuckleOff(Nr: integer);

begin

    if NoPoints > 2 then

    begin

         if VertexIsKnuckle(Nr) then

         begin

              DeleteVertex(Nr + 1);

              DeleteVertex(Nr - 1);

         end;

    end;

end; {

TBSpline.KnuckleOff

}

 

procedure TBSpline.InsertVertex(Pos: Integer; Vertex: TVertex);

var

    I: integer;

begin

    if NoPoints < MaxNoVertices then

    begin

         inc(NoPoints);

         for I := NoPoints - 1 downto Pos do

              VertexList^[I + 1] := VertexList^[I];

         VertexList^[Pos] := Vertex;

         PhantomPoints;

    end

    else

         MessageDlg('Maximum number of vertices reached.', mtError, [mbOk], 0);

end; {

TBSpline.InsertVertex

}

 

procedure TBSpline.AddVertex(Vertex: TVertex);

begin

    if NoPoints < MaxNoVertices then

    begin

         inc(NoPoints);

         VertexList^[NoPoints] := Vertex;

         PhantomPoints;

    end

    else

         MessageDlg('Maximum number of vertices reached.', mtError, [mbOk], 0);

end; {

TBSpline.AddVertex

}

 

procedure TBSpline.ChangeVertex(VertexNr: word; X, Y: Single);

begin

    if (VertexNr > 0) and (VertexNr <= NoPoints) then

    begin

         VertexList^[VertexNr].X := X;

         VertexList^[VertexNr].Y := Y;

         PhantomPoints;

    end;

end; {

TBSpline.ChangeVertex

}

 

procedure TBSpline.DeleteVertex(VertexNr: word);

var

    I: integer;

begin

    if (VertexNr > 0) and (VertexNr <= NoPoints) then

    begin

         for I := VertexNr to NoPoints - 1 do

              VertexList^[i] := VertexList^[I + 1];

         PhantomPoints;

    end;

end; {

TBSpline.DeleteVertex

}

 

function TBSpline.VertexNr(Nr: integer): TVertex;

begin

    Result := VertexList^[Nr];

end; {

TBSpline.VertexNr

}

 

function TBSpline.NumberOfVertices: word;

begin

    Result := NoPoints;

end; {

TBSpline.NumberOfVertices

}

 

{

------------------------------------------------------------------------------

}

{

TSplines.Create                                                            

}

{

------------------------------------------------------------------------------

}

 

constructor TSplines.Create(AOwner: TComponent);

begin

    inherited Create(AOwner);

    FSplineRow := TList.Create;

    FSplineRow.Capacity := 6000;

end; {

TSplines.Create

}

 

{

------------------------------------------------------------------------------

}

{

TSplines.Destroy                                                           

}

{

------------------------------------------------------------------------------

}

 

destructor TSplines.Destroy;

begin

    FSplineRow.Free;

    inherited Destroy;

end; {

TSplines.Destroy

}

 

{

------------------------------------------------------------------------------

}

{

TSplines.AddSpline                                                         

}

{

------------------------------------------------------------------------------

}

 

procedure TSplines.AddSpline(BSpline: TBSpline);

begin

    if NumberOfSplines < FSplineRow.Capacity then

    begin

         FSplineRow.Add(BSpline);

    end

    else

         MessageDlg('Maximum number of splines reached. (' + IntToStr(FSplineRow.Count) + ')', mtError, [mbOk], 0);

end; {

TSplines.AddSpline

}

 

{

------------------------------------------------------------------------------

}

{

TSplines.Clear                                                             

}

{

------------------------------------------------------------------------------

}

 

procedure TSplines.Clear;

begin

    while FSplineRow.Count > 0 do

         FSplineRow.Delete(FSplineRow.Count - 1);

    FSplineRow.Pack;

end; {

TSplines.Clear

}

 

{

------------------------------------------------------------------------------

}

{

TSplines.InsertSpline                                                      

}

{

------------------------------------------------------------------------------

}

 

procedure TSplines.InsertSpline(Pos: Integer; BSpline: TBSpline);

begin

    if NumberOfSplines < FSplineRow.Capacity then

    begin

         FSplineRow.Insert(Pos, BSpline);

    end

    else

         MessageDlg('Maximum number of splines reached. (' + IntToStr(FSplineRow.Count) + ')', mtError, [mbOk], 0);

end; {

TSplines.InsertSpline

}

 

{

------------------------------------------------------------------------------

}

{

TSplines.DeleteSpline                                                      

}

{

------------------------------------------------------------------------------

}

 

procedure TSplines.DeleteSpline(BSpline: TBSpline);

var

    I: integer;

begin

    I := FSplineRow.IndexOf(BSpline);

    if I <> -1 then

    begin

         FSplineRow.Delete(I);

         FSplineRow.Pack;

    end;

end; {

TSplines.DeleteSpline

}

 

{

------------------------------------------------------------------------------

}

{

TSplines.GetSplineNr                                                       

}

{

------------------------------------------------------------------------------

}

 

function TSplines.GetSplineNr(Nr: Word): TBSpline;

begin

    if (Nr >= 1) and (Nr <= FSplineRow.Count) then

         Result := FSplineRow.Items[Nr - 1]

    else

         Result := nil;

end; {

TSplines.GetSplineNr

}

 

{

------------------------------------------------------------------------------

}

{

TSplines.GetNumberOfSplines                                                

}

{

------------------------------------------------------------------------------

}

 

function TSplines.GetNumberOfSplines: word;

begin

    Result := FSplineRow.Count;

end; {

TSplines.GetNumberOfSplines

}

 

{

------------------------------------------------------------------------------

}

{

Register                                                                   

}

{

------------------------------------------------------------------------------

}

 

procedure Register;

begin

    RegisterComponents('Martijn', [TSplines]);

end; {

Register

}

 

end.