teespline.pas

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

        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;

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


var I,J      : 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);

    GetMem(FVertexList,(FNoVertices+2)*SizeOf(TVertex));

    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
      for i:=1 to FNoVertices do
      begin
        GetMem(Matrix[I],FNoVertices*SizeOf(TDatatype));
        FillChar(Matrix[I]^,FNoVertices*SizeOf(TDatatype),0);
      end;

      FillMatrix;
      Finterpolate;

      for i:=1 to FNoVertices do
      begin
        FreeMem(Matrix[I],FNoVertices*SizeOf(TDatatype));
        Matrix[I]:=nil;
      end;
    end;
  end;
  FBuild:=true;
  FPhantomPoints;
end;

procedure TBSpline.FInterpolate;
var I,J,K  : Integer;
    Factor : TDataType;
    Tmp    : P2DVertexList;
begin
  if (FNoVertices<MaxInterpolatedVertices) and (FNoVertices>2) then
  begin
    GetMem(Tmp,(FNoVertices+2)*SizeOf(TVertex));

    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 FSetCapacity(FCapacity+VerticesIncrement);
  Inc(FNoPoints);
  Vertex.X:=X;
  Vertex.Y:=Y;
  Point[FNoPoints]:=Vertex;
  Build:=false;
end;

procedure TBSpline.ClearVertexList;
begin
  if Assigned(FVertexList) then
  begin
    FreeMem(FVertexList,(FNoVertices+2)*SizeOf(TVertex));
    FVertexList:=nil;
  end;
end;

procedure TBSpline.Clear;
begin
  if NumberOfVertices>0 then ClearVertexList;
  FNoPoints:=0;
  FNoVertices:=0;
  Build:=False;
  FSetCapacity(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
    ParentSeries.Clear;
    if Source.Count>0 then
    begin
      tmpList:=ValueList(Source);
      With Source do
      for t:=0 to Count-1 do
      begin
        BSpline.AddPoint(XValues.Value[t],tmpList.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, @TeeMsg_FunctionSmooth, @TeeMsg_GalleryExtended );
finalization
  UnRegisterTeeFunctions([TSmoothingFunction]);
end.