teespline.pas

B样条曲线类,使曲线绘制更平滑

{*******************************************}
{  TSmoothingFunction                       }
{  Copyright (c) 2002-2004 by David Berneda }
{  With permission from M. v. Engeland      }
{*******************************************}
Unit TeeSpline;
{$I TeeDefs.inc}

{------------------------------------------------------------------------------}
{                                                                              }
{ This code was written by : M. v. Engeland                                    }
{                                                                              }
{ This code is copyright 2000 by                                               }
{       M. v. Engeland                                                         }
{                                                                              }
{                                                                              }
{   This is the followup of the B-splines component posted in 1997.            }
{   Some bugs were fixed, and some changes were made. The splines now use      }
{   dynamic allocation of memory when needed when adding points to the spline. }
{   If the number of points to be added is known in advance, the the precise   }
{   amount of memory can be allocated setting the capacity property.           }
{                                                                              }
{   The conditions for using this component however are not changed:           }
{   You may use this component in any way you want to, whether it is for       }
{   commercial purposes or not, as long as you don't hold me responsible for   }
{   any disasters it may cause. But I would appreciate it if you would send me }
{   an e-mail ([e-mail]) to tell me what you use it for  }
{   because over the last three years I've learned that it has been used for   }
{   a wide variaty of interesting applications which it was initially never    }
{   intended for. Besides, it's nice to know how your offspring's doing.       }
{   Also all comments and/or remarks are welcome.                              }
{                                                                              }
{   See the demo program for how to use the component.                         }
{   Special attention is payed on the possibility of interpolating the         }
{   vertices. As you may or may not know, B-Splines normally do not            }
{   interpolate the used controlpoints. Thanks to simple matrix calculation    }
{   however it is possible to interpolate the controlpoints by calculating     }
{   new vertices in such a way that the spline interpolates the original ones. }
{------------------------------------------------------------------------------}

interface

uses {$IFNDEF LINUX}
     Windows,
     {$ENDIF}
     Classes, TeEngine;

const MaxFragments            = 600; // The maximum of straight line segments allowed for drawing the spline
      MaxResults              = MaxFragments+10; // Max. number of calculated intersections

  // 6.01 Removed max limit. No longer necessary.
  // Warning: More than 500 points takes huge CPU time.
  // MaxInterpolatedVertices :Integer= 250; // The maximum number of vertices that can be interpolated, up to 16000 allowed

      MaxCalcSteps            = 150; // Number of steps for numerical intersection calculating
      MaxError                = 1e-5;// Max error for intersection calculating
      MaxIterations           = 80;
      VerticesIncrement       = 25;  // Number of vertices to allocate memory for when the count property exceeds the current capacity

type
   TDataType=Double;

   TVertex=packed record
     X,Y : TDataType;
   end;

   // The following dynamic array is used to store the desired user-specified controlpoints
   T2DPointList = array of TVertex;

   // The vertexlist is used internally to make the spline interpolate the controlpoints
   TVertexList  = array of TVertex;

   // The knuckle list stores a flag to see whether a point is a knuckle or not
   TKnuckleList = array of Boolean;

   // The following tpes are used for the interpolation routines
   TMatrixRow = array of TDataType;

   // 2D B-spline class
   TBSpline=class {$IFDEF CLR}sealed{$ENDIF}
   private
    Matrix         : Array of TMatrixRow;
    FNoPoints      : Integer;
    FCapacity      : Integer;
    FPointList     : T2DPointList;
    FVertexList    : TVertexList;
    FKnuckleList   : TKnuckleList;
    FBuild         : Boolean;
    FNoVertices    : Integer;
    FInterpolated  : boolean;
    FFragments     : Integer;

    procedure ClearVertexList;
    procedure FSetBuild(Val:Boolean);
    procedure SetCapacity(NewCapacity:Integer);
    procedure FSetInterpolated(const Value:Boolean);
    procedure FSetFragments(Const Value:Integer);
    function  FGetPoint(Index:Integer):TVertex;
    procedure FSetPoint(Index:Integer; const Value:TVertex);
    function  FGetKnuckle(Index:Integer):Boolean;
    procedure FSetKnuckle(Index:Integer; Value:Boolean);
    function  FGetNumberOfVertices:Integer;
    procedure FInterpolate;
    procedure FPhantomPoints;
   public
    Constructor Create;
    destructor Destroy; override;

    procedure AddPoint(const X,Y:TDataType);
    procedure Clear;
    property Count:Integer read FNoPoints;
    function Value(const Parameter:TDataType):TVertex;
    procedure Rebuild;
    property Build: Boolean read FBuild write FSetBuild;
    property Fragments: Integer read FFragments write FSetFragments;
    property Interpolated: Boolean read FInterpolated write FSetInterpolated;
    property NumberOfVertices: Integer read FGetNumberOfVertices;
    property Point[Index:Integer]: TVertex read FGetPoint write FSetPoint;
    property Knuckle[Index:integer]: Boolean read FGetKnuckle write FSetKnuckle;
  end;

  TSmoothingFunction=class(TTeeFunction)
  private
    FInterpolate: Boolean;
    FFactor: Integer;
    procedure SetFactor(const Value: Integer);
    procedure SetInterpolate(const Value: Boolean);
  protected
    class function GetEditorClass: String; override;
  public
    Constructor Create(AOwner: TComponent); override;
    procedure AddPoints(Source:TChartSeries); override;
  published
    property Interpolate: Boolean read FInterpolate write SetInterpolate default True;
    property Factor:Integer read FFactor write SetFactor default 4;
  end;

implementation

uses Math, SysUtils, Chart, TeeConst, TeeProCo;

{ TBSpline }
constructor TBSpline.Create;
begin
  inherited;
  Clear;
end;

destructor TBSpline.Destroy;
begin
  Clear;
  inherited;
end;

procedure TBSpline.FSetBuild(val:boolean);
begin
  if not val then
  begin
    // Release allocated memory for vertices
    if FBuild then ClearVertexList;
    FNoVertices:=0;
  end;
  FBuild:=Val;
end;

procedure TBSpline.SetCapacity(NewCapacity:Integer);
var t : Integer;
begin
  if NewCapacity<>FCapacity then
  begin
    if NewCapacity>0 then
    begin
      SetLength(FPointList,NewCapacity*SizeOf(TVertex));
      SetLength(FKnuckleList,NewCapacity);
      for t:=0 to NewCapacity-1 do FKnuckleList[t]:=False;
    end;

    FCapacity:=NewCapacity;
  end;
end;

procedure TBSpline.FSetFragments(Const Value:integer);
begin
  if FFragments<>value then
  begin
    FFragments:=Value;
    if FFragments>MaxFragments then FFragments:=MaxFragments;
 end;
end;

procedure TBSpline.FSetInterpolated(const Value:boolean);
begin
  if Value<>FInterpolated then
  begin
    FInterpolated:=value;
    Build:=false;
  end;
end;

function TBSpline.FGetPoint(Index:Integer):TVertex;
begin
  Result:=FPointList[Index];
end;

procedure TBSpline.FSetPoint(Index:Integer; const Value:TVertex);
begin
  FPointList[Index]:=Value;
  Build:=False;
end;

function TBSpline.FGetKnuckle(Index:integer):Boolean;
begin
  if (Index=1) or (Index=FNoPoints) then
     result:=False
  else
     result:=FKnuckleList[Index]
end;

procedure TBSpline.FSetKnuckle(Index:integer;Value:Boolean);
begin
  FKnuckleList[Index]:=Value;
  Build:=False;
end;

function TBSpline.FGetNumberOfVertices:integer;
begin
  if not FBuild then Rebuild;
  result:=FNoVertices;
end;

procedure TBSpline.Rebuild;

  procedure FillMatrix;
  Const MinLimit=1e-5;
  var I,J : integer;
  begin
    if (FNoVertices>2)
      // and (FNoVertices<=MaxInterpolatedVertices)
      then
    begin
      for i:=2 to FNoVertices-1 do
      begin
        Matrix[I][I-1]:=1/6;
        Matrix[I][I]:=2/3;
        Matrix[I][I+1]:=1/6;
      end;

      Matrix[1][1]:=1;
      Matrix[FNoVertices][FNoVertices]:=1;

      I:=3;
      while I<FNoVertices-1 do
      begin
        if (Abs(FVertexList[I].X-FVertexList[I-1].X)<MinLimit) and
           (Abs(FVertexList[I+1].X-FVertexList[I].X)<MinLimit) and
           (Abs(FVertexList[I].Y-FVertexList[I-1].Y)<MinLimit) and
           (Abs(FVertexList[I+1].Y-FVertexList[I].Y)<MinLimit) then
        begin
          for J:=I-1 to I+1 do
          begin
            Matrix[J][J-1]:=0;
            Matrix[J][J]:=1;
            Matrix[J][J+1]:=0;
          end;