paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-02 04:00:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

TAChart: Add cubic spline series

Browse Source 
git-svn-id: trunk@31407 -
This commit is contained in:
ask 2011-06-26 17:24:55 +00:00
parent 86b18e0c0a
commit 8697a41ace
1 changed files with 186 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

224
components/tachart/tafuncseries.pas
View File

@ -23,7 +23,7 @@ unit TAFuncSeries;
interface
uses
Classes, Graphics,
Classes, Graphics, typ,
TAChartUtils, TACustomSeries, TACustomSource, TADrawUtils, TALegend, TATypes;
const
@ -132,6 +132,44 @@ type
read FStep write SetStep default DEF_SPLINE_STEP;
end;
{ TCubicSplineSeries }
TCubicSplineSeries = class(TBasicPointSeries)
private
FPen: TChartPen;
FStep: TFuncSeriesStep;
procedure SetPen(AValue: TChartPen);
procedure SetStep(AValue: TFuncSeriesStep);
private
FX, FY, FCoeff: array of ArbFloat;
procedure PrepareCoeffs;
function Calculate(AX: Double): Double;
protected
procedure GetLegendItems(AItems: TChartLegendItems); override;
procedure SourceChanged(ASender: TObject); override;
public
procedure Assign(ASource: TPersistent); override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Draw(ADrawer: IChartDrawer); override;
published
property Active default true;
property AxisIndexX;
property AxisIndexY;
property ShowInLegend;
property Source;
property Title;
property ZPosition;
published
property Pen: TChartPen read FPen write SetPen;
property Step: TFuncSeriesStep
read FStep write SetStep default DEF_SPLINE_STEP;
end;
TFuncCalculate3DEvent =
procedure (const AX, AY: Double; out AZ: Double) of object;
@ -183,7 +221,7 @@ type
implementation
uses
Math, SysUtils, TAGeometry, TAGraph;
ipf, Math, SysUtils, TAGeometry, TAGraph;
function DoublePointRotated(AX, AY: Double): TDoublePoint;
begin
@ -277,21 +315,27 @@ begin
OnCalculate(AX, Result)
end;
procedure TFuncSeries.Draw(ADrawer: IChartDrawer);
type
TTransform = function (A: Double): Double of object;
TCustomSeriesCrack = class(TCustomChartSeries);
procedure DrawFunction(
ADrawer: IChartDrawer; ASeries: TCustomChartSeries;
ADomainExclusions: TIntervalList; ACalc: TTransform; AStep: Integer);
type
TMakeDoublePoint = function (AX, AY: Double): TDoublePoint;
var
axisToGraphXr, axisToGraphYr, graphToAxisXr, calc: TTransform;
axisToGraphXr, axisToGraphYr, graphToAxisXr: TTransform;
makeDP: TMakeDoublePoint;
r: TDoubleRect = (coords:(NegInfinity, NegInfinity, Infinity, Infinity));
prev: TDoublePoint;
prevInExtent: Boolean;
chart: TChart;
procedure CalcAt(AXg, AXa: Double; out APt: TDoublePoint; out AIn: Boolean);
begin
APt := makeDP(AXg, axisToGraphYr(calc(AXa)));
APt := makeDP(AXg, axisToGraphYr(ACalc(AXa)));
AIn := (r.a <= APt) and (APt <= r.b);
end;
@ -299,7 +343,7 @@ var
begin
CalcAt(AXg, AXa, prev, prevInExtent);
if prevInExtent then
ADrawer.MoveTo(FChart.GraphToImage(prev));
ADrawer.MoveTo(chart.GraphToImage(prev));
end;
procedure LineTo(AXg, AXa: Double);
@ -310,10 +354,10 @@ var
CalcAt(AXg, AXa, p, inExtent);
t := p;
if inExtent and prevInExtent then
ADrawer.LineTo(FChart.GraphToImage(p))
ADrawer.LineTo(chart.GraphToImage(p))
else if LineIntersectsRect(prev, t, r) then begin
ADrawer.MoveTo(FChart.GraphToImage(prev));
ADrawer.LineTo(FChart.GraphToImage(t));
ADrawer.MoveTo(chart.GraphToImage(prev));
ADrawer.LineTo(chart.GraphToImage(t));
end;
prevInExtent := inExtent;
prev := p;
@ -323,46 +367,41 @@ var
hint: Integer;
xg, xa, xg1, xa1, xmax, graphStep: Double;
begin
if Assigned(OnCalculate) then
calc := @DoCalculate
else if csDesigning in ComponentState then
calc := @DoCalcIdentity
else
exit;
GetGraphBounds(r);
RectIntersectsRect(r, FChart.CurrentExtent);
chart := TCustomSeriesCrack(ASeries).FChart;
TCustomSeriesCrack(ASeries).GetGraphBounds(r);
RectIntersectsRect(r, chart.CurrentExtent);
if IsRotated then begin
axisToGraphXr := @AxisToGraphY;
axisToGraphYr := @AxisToGraphX;
graphToAxisXr := @GraphToAxisY;
makeDP := @DoublePointRotated;
graphStep := FChart.YImageToGraph(-Step) - FChart.YImageToGraph(0);
xg := r.a.Y;
xmax := r.b.Y;
end
else begin
axisToGraphXr := @AxisToGraphX;
axisToGraphYr := @AxisToGraphY;
graphToAxisXr := @GraphToAxisX;
makeDP := @DoublePoint;
graphStep := FChart.XImageToGraph(Step) - FChart.XImageToGraph(0);
xg := r.a.X;
xmax := r.b.X;
end;
with TCustomSeriesCrack(ASeries) do
if IsRotated then begin
axisToGraphXr := @AxisToGraphY;
axisToGraphYr := @AxisToGraphX;
graphToAxisXr := @GraphToAxisY;
makeDP := @DoublePointRotated;
graphStep := chart.YImageToGraph(-AStep) - chart.YImageToGraph(0);
xg := r.a.Y;
xmax := r.b.Y;
end
else begin
axisToGraphXr := @AxisToGraphX;
axisToGraphYr := @AxisToGraphY;
graphToAxisXr := @GraphToAxisX;
makeDP := @DoublePoint;
graphStep := chart.XImageToGraph(AStep) - chart.XImageToGraph(0);
xg := r.a.X;
xmax := r.b.X;
end;
hint := 0;
xa := graphToAxisXr(xg);
if DomainExclusions.Intersect(xa, xa, hint) then
if ADomainExclusions.Intersect(xa, xa, hint) then
xg := axisToGraphXr(xa);
MoveTo(xg, xa);
ADrawer.Pen := Pen;
while xg < xmax do begin
xg1 := xg + graphStep;
xa1 := graphToAxisXr(xg1);
if DomainExclusions.Intersect(xa, xa1, hint) then begin
if ADomainExclusions.Intersect(xa, xa1, hint) then begin
LineTo(axisToGraphXr(xa), xa);
xg1 := axisToGraphXr(xa1);
MoveTo(xg1, xa1);
@ -374,6 +413,22 @@ begin
end;
end;
procedure TFuncSeries.Draw(ADrawer: IChartDrawer);
var
calc: TTransform;
begin
if Assigned(OnCalculate) then
calc := @DoCalculate
else if csDesigning in ComponentState then
calc := @DoCalcIdentity
else
exit;
ADrawer.Pen := Pen;
DrawFunction(
ADrawer, TCustomSeriesCrack(TCustomChartSeries(Self)),
DomainExclusions, calc, Step);
end;
procedure TFuncSeries.GetLegendItems(AItems: TChartLegendItems);
begin
AItems.Add(TLegendItemLine.Create(Pen, Title));
@ -533,6 +588,98 @@ begin
UpdateParentChart;
end;
{ TCubicSplineSeries }
procedure TCubicSplineSeries.Assign(ASource: TPersistent);
begin
if ASource is TCubicSplineSeries then
with TCubicSplineSeries(ASource) do begin
Self.Pen := FPen;
Self.FStep := FStep;
end;
inherited Assign(ASource);
end;
function TCubicSplineSeries.Calculate(AX: Double): Double;
var
ok: Integer;
begin
Result := ipfspn(High(FCoeff) - 1, FX[0], FY[0], FCoeff[0], AX, ok);
end;
constructor TCubicSplineSeries.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FPen := TChartPen.Create;
FPen.OnChange := @StyleChanged;
FStep := DEF_SPLINE_STEP;
end;
destructor TCubicSplineSeries.Destroy;
begin
FreeAndNil(FPen);
inherited;
end;
procedure TCubicSplineSeries.Draw(ADrawer: IChartDrawer);
var
de: TIntervalList;
begin
if FCoeff = nil then
PrepareCoeffs;
if FCoeff = nil then exit;
de := TIntervalList.Create;
try
ADrawer.Pen := Pen;
DrawFunction(ADrawer, Self, de, @Calculate, Step);
finally
de.Free;
end;
end;
procedure TCubicSplineSeries.GetLegendItems(AItems: TChartLegendItems);
begin
AItems.Add(TLegendItemLine.Create(Pen, Title));
end;
procedure TCubicSplineSeries.PrepareCoeffs;
var
i, n: Integer;
begin
n := Source.Count;
SetLength(FX, n);
SetLength(FY, n);
SetLength(FCoeff, n);
for i := 0 to n - 1 do
with Source[i]^ do begin
FX[i] := X;
FY[i] := Y;
end;
ipfisn(n - 2, FX[0], FY[0], FCoeff[0], i);
if i > 1 then
FCoeff := nil;
end;
procedure TCubicSplineSeries.SetPen(AValue: TChartPen);
begin
if FPen = AValue then exit;
FPen.Assign(AValue);
UpdateParentChart;
end;
procedure TCubicSplineSeries.SetStep(AValue: TFuncSeriesStep);
begin
if FStep = AValue then exit;
FStep := AValue;
UpdateParentChart;
end;
procedure TCubicSplineSeries.SourceChanged(ASender: TObject);
begin
inherited SourceChanged(ASender);
FCoeff := nil;
end;
{ TColorMapSeries }
procedure TColorMapSeries.Assign(ASource: TPersistent);
@ -736,6 +883,7 @@ end;
initialization
RegisterSeriesClass(TFuncSeries, 'Function series');
RegisterSeriesClass(TBSplineSeries, 'B-Spline series');
RegisterSeriesClass(TCubicSplineSeries, 'Cubic spline series');
RegisterSeriesClass(TColorMapSeries, 'Color map series');
end.