teespline.pas

来自「Delphi TeeChartPro.6.01的源代码」· PAS 代码 · 共 522 行 · 第 1/2 页

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

{$R-}

{------------------------------------------------------------------------------}
{                                                                              }
{ 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 Classes, TeEngine;

const MaxFragments            = 600; // The maximum of straight line segments allowed for drawing the spline
      MaxResults              = MaxFragments+10; // Max. number of calculated intersections
      MaxInterpolatedVertices = 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[1..1] of TVertex;
   P2DPointList = ^T2DPointList;

   // The vertexlist is used internally to make the spline interpolate the controlpoints
   TVertexList  = array[0..0] of TVertex;
   P2DVertexList= ^TVertexList;

   // The knuckle list stores a flag to see whether a point is a knuckle or not
   TKnuckleList = array[1..1] of Boolean;
   PKnuckleList = ^TKnuckleList;

   // The following tpes are used for the interpolation routines
   TMatrixRow = Array[1..1] of TDataType;
   PMatrixRow = ^TMatrixRow;
   TMatrix    = array[1..MaxInterpolatedVertices] of PMatrixRow;

   // 2D B-spline class:
   TBSpline=class         // 2D B-Spline object
   private
    Matrix         : TMatrix;
    FNoPoints      : Integer;
    FCapacity      : Integer;
    FPointList     : P2DPointList;
    FVertexList    : P2DVertexList;
    FKnuckleList   : PKnuckleList;
    FBuild         : Boolean;
    FNoVertices    : Integer;
    FInterpolated  : boolean;
    FFragments     : Integer;

    procedure ClearVertexList;
    procedure FSetBuild(Val:Boolean);
    procedure FSetCapacity(Val: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 Chart, Math, 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.FSetCapacity(Val:Integer);
var CurrentSize : Word;
    NewSize     : Word;
    OldPoints   : P2DPointList;
    OldKnuckle  : PKnuckleList;
begin
  if Val<>FCapacity then
  begin
    CurrentSize:=FCapacity*SizeOf(TVertex);
    NewSize:=Val*SizeOf(TVertex);
    OldPoints:=FPointList;
    FPointList:=nil;
    OldKnuckle:=FKnuckleList;
    FKnuckleList:=nil;

    if Val>0 then
    begin
      GetMem(FPointList,NewSize);
      GetMem(FKnuckleList,Val);
      FillChar(FKnuckleList^,Val,0);
      if FCapacity<>0 then
      begin
        Move(OldKnuckle^,FKnuckleList^,FCapacity);
        Move(OldPoints^,FPointList^,CurrentSize);
      end;
    end;

    if CurrentSize<>0 then
    begin
      FreeMem(OldPoints,CurrentSize);
      FreeMem(OldKnuckle,FCapacity);
    end;

    FCapacity:=Val;
  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