teespline.pas

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

          Inc(I,2);
        end
        else Inc(I);
      end;
    end;
  end;


var I,J,t    : integer;
    Vertex2D : TVertex;
begin
  if FNoPoints>1 then
  begin
    ClearVertexList;
    FNoVertices:=0;

    for i:=1 to FNoPoints do
        if Knuckle[I] then Inc(FNoVertices,3)
                      else Inc(FNoVertices,1);

    SetLength(FVertexList,FNoVertices+2);

    J:=0;
    for i:=1 to FNoPoints do
    begin
      Vertex2D:=Point[I];
      if Knuckle[I] then
      begin
        FVertexList[J+1]:=Vertex2D;
        FVertexList[J+2]:=Vertex2D;
        Inc(J,2);
      end;

      FVertexList[J+1]:=FPointList[I];
      Inc(J);
    end;

    if Interpolated then
    begin
      // Init Matrix
      SetLength(Matrix,FNoVertices+1);  // 6.01

      for i:=1 to FNoVertices do
      begin
        SetLength(Matrix[I],FNoVertices+1);  // 6.02
        for t:=0 to FNoVertices-1 do Matrix[i][t]:=0;
      end;

      FillMatrix;
      Finterpolate;

      // Release memory
      for i:=1 to FNoVertices do Matrix[I]:=nil;

      Matrix:=nil;
    end;
  end;
  FBuild:=true;
  FPhantomPoints;
end;

procedure TBSpline.FInterpolate;
var I,J,K  : Integer;
    Factor : TDataType;
    Tmp    : TVertexList;
begin
  if (FNoVertices>2) // and (FNoVertices<MaxInterpolatedVertices)
     then
  begin
    SetLength(Tmp,FNoVertices+2);

    for i:=1 to FNoVertices do
      for J:=I+1 to FNoVertices do
      begin
        factor:=Matrix[J][I]/Matrix[I][I];
        for K:=1 to FNoVertices do
            Matrix[J][K]:=Matrix[J][K]-factor*Matrix[I][K];
        FVertexList[J].x:=FVertexList[J].x-factor*FVertexList[J-1].x;
        FVertexList[J].y:=FVertexList[J].y-factor*FVertexList[J-1].y;
      end;

    Tmp[FNoVertices].x:=FVertexList[FNoVertices].x/Matrix[FNoVertices][FNoVertices];
    Tmp[FNoVertices].y:=FVertexList[FNoVertices].y/Matrix[FNoVertices][FNoVertices];

    for I:=FNoVertices-1 downto 1 do
    begin
      Tmp[I].x:=(1/Matrix[I][I])*(FVertexList[I].x-Matrix[I][I+1]*Tmp[I+1].x);
      Tmp[I].y:=(1/Matrix[I][I])*(FVertexList[I].y-Matrix[I][I+1]*Tmp[I+1].y);
    end;

    ClearVertexList;
    FVertexList:=Tmp;
  end;
end;

procedure TBSpline.AddPoint(const X,Y:Double);
var Vertex : TVertex;
begin
  if FNoPoints=FCapacity then
     SetCapacity(FCapacity+VerticesIncrement);

  Inc(FNoPoints);
  Vertex.X:=X;
  Vertex.Y:=Y;
  Point[FNoPoints]:=Vertex;
  Build:=false;
end;

procedure TBSpline.ClearVertexList;
begin
  FVertexList:=nil;
end;

procedure TBSpline.Clear;
begin
  if NumberOfVertices>0 then ClearVertexList;
  FNoPoints:=0;
  FNoVertices:=0;
  Build:=False;
  SetCapacity(0);
  FInterpolated:=False;
  FFragments:=100;
end;

procedure TBSpline.FPhantomPoints;
var I : integer;
begin
  if NumberOfVertices>1 then
  begin
    I:=0;
    FVertexList[I].X:=2*FVertexList[I+1].X-FVertexList[I+2].X;
    FVertexList[I].Y:=2*FVertexList[I+1].Y-FVertexList[I+2].Y;
    FVertexList[NumberOfVertices+1].X:=2*FVertexList[NumberOfVertices].X-FVertexList[NumberOfVertices-1].X;
    FVertexList[NumberOfVertices+1].Y:=2*FVertexList[NumberOfVertices].Y-FVertexList[NumberOfVertices-1].Y;
  end;
end;

function TBSpline.Value(const Parameter:TDataType):TVertex;
var c,S,E : integer;
    Dist  : TDataType;
    Mix   : TDataType;
    Mid   : TDataType;
begin
  result.X:=0;
  result.Y:=0;

  if FNoPoints<2 then Exit;

  if not FBuild then Rebuild;

  Mid:=(NumberOfVertices-1)*Parameter+1;
  S:=Trunc(Mid-1);
  if S<0 then S:=0;
  E:=S+3;
  if S>FNovertices+1 then S:=FNovertices+1;

  for c:=S to E do
  begin
    dist:=Abs(C-Mid);
    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+FVertexList[c].x*mix;
      result.y:=Result.y+FVertexList[c].y*mix;
    end;
  end;
end;

{ TSmoothingFunction }
constructor TSmoothingFunction.Create(AOwner: TComponent);
begin
  inherited;
  CanUsePeriod:=False;
  SingleSource:=True;
  FInterpolate:=True;
  FFactor:=4;
  InternalSetPeriod(1);
end;

procedure TSmoothingFunction.AddPoints(Source: TChartSeries);
var BSpline : TBSpline;
    t       : Integer;
    tmpList : TChartValueList;
begin
  BSpline:=TBSpline.Create;
  try
    with ParentSeries do
    begin
      Clear;

      if YMandatory=Source.YMandatory then  // 7.0
      begin
        NotMandatoryValueList.Order:=loAscending;
        MandatoryValueList.Order:=loNone;
        CalcVisiblePoints:=True;
      end
      else
      begin
        NotMandatoryValueList.Order:=loNone;
        MandatoryValueList.Order:=loAscending;
        CalcVisiblePoints:=False;
      end;
    end;

    if Source.Count>0 then
    begin
      tmpList:=ValueList(Source);

      With Source do
      for t:=0 to Count-1 do
      begin
        if ParentSeries.YMandatory then
           BSpline.AddPoint(XValues.Value[t],tmpList.Value[t])
        else
           BSpline.AddPoint(tmpList.Value[t],XValues.Value[t]);

        BSpline.Knuckle[t]:=False;
      end;

      BSpline.Interpolated:=Interpolate;
      BSpline.Fragments:=Source.Count*Factor;

      with BSpline do
      for t:=0 to Fragments do
          with Value(t/Fragments) do
               if ParentSeries.YMandatory then ParentSeries.AddXY(X,Y)
                                          else ParentSeries.AddXY(Y,X);
    end;
  finally
    BSpline.Free;
  end;
end;

procedure TSmoothingFunction.SetFactor(const Value: Integer);
begin
  if FFactor<>Value then
  begin
    FFactor:=Math.Max(1,Value);
    Recalculate;
  end;
end;

procedure TSmoothingFunction.SetInterpolate(const Value: Boolean);
begin
  if FInterpolate<>Value then
  begin
    FInterpolate:=Value;
    Recalculate;
  end;
end;

class function TSmoothingFunction.GetEditorClass: String;
begin
  result:='TSmoothFuncEditor';
end;

initialization
  RegisterTeeFunction( TSmoothingFunction, {$IFNDEF CLR}@{$ENDIF}TeeMsg_FunctionSmooth,
                                           {$IFNDEF CLR}@{$ENDIF}TeeMsg_GalleryExtended );
finalization
  UnRegisterTeeFunctions([TSmoothingFunction]);
end.