From 7e2608eff772e3eae630dbe6d778839bb14e5992 Mon Sep 17 00:00:00 2001 From: wp Date: Wed, 6 Mar 2019 09:10:33 +0000 Subject: [PATCH] TAChart: Fix extent of TFitSeries ignoring shape of calculated fit curve. Based on patch by Marcin Wiazowski, issue #35183 git-svn-id: trunk@60597 - --- components/tachart/demo/fit/Main.lfm | 47 ++++++++++++------ components/tachart/demo/fit/Main.pas | 10 +++- components/tachart/tafuncseries.pas | 39 +++++++++++++-- components/tachart/tagraph.pas | 72 +++++++++++++++------------- 4 files changed, 118 insertions(+), 50 deletions(-) diff --git a/components/tachart/demo/fit/Main.lfm b/components/tachart/demo/fit/Main.lfm index f70b7827e9..a7bda71c96 100644 --- a/components/tachart/demo/fit/Main.lfm +++ b/components/tachart/demo/fit/Main.lfm @@ -2,10 +2,10 @@ object frmMain: TfrmMain Left = 319 Height = 503 Top = 133 - Width = 997 + Width = 1026 Caption = 'frmMain' ClientHeight = 503 - ClientWidth = 997 + ClientWidth = 1026 OnCreate = FormCreate ShowHint = True LCLVersion = '2.1.0.0' @@ -544,22 +544,23 @@ object frmMain: TfrmMain Left = 429 Height = 487 Top = 8 - Width = 560 + Width = 589 Align = alClient BorderSpacing.Around = 8 BevelOuter = bvNone ClientHeight = 487 - ClientWidth = 560 + ClientWidth = 589 TabOrder = 1 object Chart: TChart Left = 0 Height = 445 Top = 0 - Width = 560 + Width = 589 AxisList = < item Grid.Visible = False Intervals.Tolerance = 2 + Marks.LabelFont.Height = -13 Marks.LabelBrush.Style = bsClear Minors = < item @@ -568,6 +569,7 @@ object frmMain: TfrmMain Intervals.Options = [aipUseCount, aipUseMinLength] Marks.LabelBrush.Style = bsClear end> + Title.LabelFont.Height = -15 Title.LabelFont.Orientation = 900 Title.LabelFont.Style = [fsBold] Title.Visible = True @@ -578,6 +580,7 @@ object frmMain: TfrmMain Grid.Visible = False Intervals.Tolerance = 2 Alignment = calBottom + Marks.LabelFont.Height = -13 Marks.LabelBrush.Style = bsClear Minors = < item @@ -586,6 +589,7 @@ object frmMain: TfrmMain Intervals.Options = [aipUseCount, aipUseMinLength] Marks.LabelBrush.Style = bsClear end> + Title.LabelFont.Height = -15 Title.LabelFont.Style = [fsBold] Title.Visible = True Title.Caption = 'x' @@ -595,6 +599,7 @@ object frmMain: TfrmMain Foot.Brush.Color = clBtnFace Foot.Font.Color = clBlue Legend.Alignment = laTopCenter + Legend.Font.Height = -13 Legend.Visible = True Title.Brush.Color = clBtnFace Title.Font.Color = clRed @@ -658,12 +663,12 @@ object frmMain: TfrmMain Left = 0 Height = 42 Top = 445 - Width = 560 + Width = 589 Align = alBottom AutoSize = True BevelOuter = bvNone ClientHeight = 42 - ClientWidth = 560 + ClientWidth = 589 TabOrder = 1 object cbLogX: TCheckBox AnchorSideLeft.Control = pnlLog @@ -694,11 +699,11 @@ object frmMain: TfrmMain AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = pnlLog AnchorSideTop.Side = asrCenter - Left = 113 + Left = 109 Height = 19 Top = 12 Width = 102 - BorderSpacing.Left = 20 + BorderSpacing.Left = 16 Caption = 'Show error bars' OnChange = cbShowErrorbarsChange TabOrder = 2 @@ -707,11 +712,11 @@ object frmMain: TfrmMain AnchorSideLeft.Control = cbShowErrorbars AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = pnlLog - Left = 235 + Left = 227 Height = 19 Top = 0 Width = 158 - BorderSpacing.Left = 20 + BorderSpacing.Left = 16 Caption = 'Show confidence intervals' OnChange = cbShowConfidenceIntervalsChange TabOrder = 3 @@ -720,7 +725,7 @@ object frmMain: TfrmMain AnchorSideLeft.Control = cbShowConfidenceIntervals AnchorSideTop.Control = cbShowConfidenceIntervals AnchorSideTop.Side = asrBottom - Left = 235 + Left = 227 Height = 19 Top = 19 Width = 153 @@ -733,15 +738,29 @@ object frmMain: TfrmMain AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = pnlLog AnchorSideTop.Side = asrCenter - Left = 413 + Left = 401 Height = 19 Top = 12 Width = 53 - BorderSpacing.Left = 20 + BorderSpacing.Left = 16 Caption = 'HTML' OnChange = CbHTMLChange TabOrder = 5 end + object CbCombinedExtent: TCheckBox + AnchorSideLeft.Control = CbHTML + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = pnlLog + AnchorSideTop.Side = asrCenter + Left = 470 + Height = 19 + Top = 12 + Width = 111 + BorderSpacing.Left = 16 + Caption = 'Combined extent' + OnChange = CbCombinedExtentChange + TabOrder = 6 + end end end object Splitter1: TSplitter diff --git a/components/tachart/demo/fit/Main.pas b/components/tachart/demo/fit/Main.pas index 13c8c82564..5de494fdfd 100644 --- a/components/tachart/demo/fit/Main.pas +++ b/components/tachart/demo/fit/Main.pas @@ -25,6 +25,7 @@ type cbShowConfidenceIntervals: TCheckBox; cbShowPredictionIntervals: TCheckBox; CbHTML: TCheckBox; + CbCombinedExtent: TCheckBox; UpperConfIntervalSeries: TFuncSeries; LowerConfIntervalSeries: TFuncSeries; UpperPredIntervalSeries: TFuncSeries; @@ -69,6 +70,7 @@ type TabSheet2: TTabSheet; procedure BtnLoadClick(Sender: TObject); procedure btnSaveClick(Sender: TObject); + procedure CbCombinedExtentChange(Sender: TObject); procedure cbDrawFitRangeOnlyClick(Sender: TObject); procedure cbFitEquationSelect(Sender: TObject); procedure CbHTMLChange(Sender: TObject); @@ -178,6 +180,11 @@ begin end; end; +procedure TfrmMain.CbCombinedExtentChange(Sender: TObject); +begin + FitSeries.CombinedExtentY := CbCombinedExtent.Checked; +end; + procedure TfrmMain.BtnLoadClick(Sender: TObject); begin if OpenDialog1.Execute then @@ -246,7 +253,8 @@ end; procedure TfrmMain.CbHTMLChange(Sender: TObject); begin if CbHtml.Checked then Chart.Legend.TextFormat := tfHTML else Chart.Legend.TextFormat := tfNormal; - FitSeries.Title := 'fitted data'; // the fit equation is appended automatically + FitSeries.Title := 'fitted data'; + // the fit equation is appended automatically due to FitSeries.Legend.Format end; procedure TfrmMain.cbShowConfidenceIntervalsChange(Sender: TObject); diff --git a/components/tachart/tafuncseries.pas b/components/tachart/tafuncseries.pas index 627a841a53..592513e16c 100644 --- a/components/tachart/tafuncseries.pas +++ b/components/tachart/tafuncseries.pas @@ -293,6 +293,7 @@ type strict private FAutoFit: Boolean; FDrawFitRangeOnly: Boolean; + FCombinedExtentY: Boolean; FFitEquation: TFitEquation; FFitParams: TFitParamArray; // raw values, not transformed! FFitRange: TChartRange; @@ -312,6 +313,7 @@ type function GetParam_RawValue(AIndex: Integer): Double; function GetParam_tValue(AIndex: Integer): Double; function IsFixedParamsStored: Boolean; + procedure SetCombinedExtentY(AValue: Boolean); procedure SetDrawFitRangeOnly(AValue: Boolean); procedure SetFitEquation(AValue: TFitEquation); procedure SetFitRange(AValue: TChartRange); @@ -336,6 +338,7 @@ type function PrepareIntervals: TIntervalList; procedure SourceChanged(ASender: TObject); override; public + procedure Assign(ASource: TPersistent); override; constructor Create(AOwner: TComponent); override; destructor Destroy; override; public @@ -373,6 +376,8 @@ type property AutoFit: Boolean read FAutoFit write FAutoFit default true; property AxisIndexX; property AxisIndexY; + property CombinedExtentY: Boolean + read FCombinedExtentY write SetCombinedExtentY default false; property DrawFitRangeOnly: Boolean read FDrawFitRangeOnly write SetDrawFitRangeOnly default true; property FitEquation: TFitEquation @@ -599,7 +604,7 @@ end; procedure TCustomFuncSeries.Assign(ASource: TPersistent); begin if ASource is TCustomFuncSeries then - with TFuncSeries(ASource) do begin + with TCustomFuncSeries(ASource) do begin Self.FDomainExclusions.Assign(FDomainExclusions); Self.FExtentAutoY := FExtentAutoY; Self.Pen := FPen; @@ -1617,11 +1622,30 @@ begin FFitRange.Intersect(AXMin, AXMax); end; +procedure TFitSeries.Assign(ASource: TPersistent); +begin + if ASource is TFitSeries then + with TFitSeries(ASource) do begin + Self.FAutoFit := FAutoFit; + Self.FConfidenceLevel := FConfidenceLevel; + Self.FDrawFitRangeOnly := FDrawFitRangeOnly; + Self.FCombinedExtentY := FCombinedExtentY; + Self.FFitEquation := FFitEquation; + Self.FFitRange.Assign(FFitRange); + Self.FFixedParams := FFixedParams; + Self.ParamCount := GetParamCount; + Self.Pen := FPen; + Self.FStep := FStep; + end; + inherited Assign(ASource); +end; + constructor TFitSeries.Create(AOwner: TComponent); begin inherited Create(AOwner); ToolTargets := [nptPoint, nptCustom]; FAutoFit := true; + FCombinedExtentY := false; FFitEquation := fePolynomial; FFitRange := TFitSeriesRange.Create(Self); FDrawFitRangeOnly := true; @@ -1798,10 +1822,12 @@ var begin Result := Source.BasicExtent; if IsEmpty or (not Active) then exit; + if not FCombinedExtentY then exit; + // TDrawFuncHelper needs a valid image-to-graph conversion if ParentChart = nil then exit; - ParentChart.ScaleNeedsSecondPass := True; - if not ParentChart.ScaleValid then exit; + ParentChart.MultiPassScalingNeeded; + if not ParentChart.ScalingValid then exit; if FAutoFit then ExecFit; @@ -2142,6 +2168,13 @@ begin end; end; +procedure TFitSeries.SetCombinedExtentY(AValue: Boolean); +begin + if FCombinedExtentY = AValue then exit; + FCombinedExtentY := AValue; + UpdateParentChart; +end; + procedure TFitSeries.SetDrawFitRangeOnly(AValue: Boolean); begin if FDrawFitRangeOnly = AValue then exit; diff --git a/components/tachart/tagraph.pas b/components/tachart/tagraph.pas index 1e7e2dece4..c1984b1c76 100644 --- a/components/tachart/tagraph.pas +++ b/components/tachart/tagraph.pas @@ -233,8 +233,8 @@ type FOnExtentChanging: TChartEvent; FPrevLogicalExtent: TDoubleRect; FScale: TDoublePoint; // Coordinates transformation - FScaleValid: Boolean; - FScaleNeedsSecondPass: Boolean; + FScalingValid: Boolean; + FMultiPassScalingNeeded: Boolean; FSavedClipRect: TRect; FClipRectLock: Integer; @@ -361,8 +361,8 @@ type function XImageToGraph(AX: Integer): Double; inline; function YGraphToImage(AY: Double): Integer; inline; function YImageToGraph(AY: Integer): Double; inline; - property ScaleValid: Boolean read FScaleValid; - property ScaleNeedsSecondPass: Boolean read FScaleNeedsSecondPass write FScaleNeedsSecondPass; + procedure MultiPassScalingNeeded; inline; + property ScalingValid: Boolean read FScalingValid; public procedure LockClipRect; @@ -595,7 +595,7 @@ begin FOffset.Y := rY.CalcOffset(FScale.Y); rX.UpdateMinMax(@XImageToGraph); rY.UpdateMinMax(@YImageToGraph); - FScaleValid := True; + FScalingValid := True; end; procedure TChart.Clear(ADrawer: IChartDrawer; const ARect: TRect); @@ -691,8 +691,8 @@ begin FGUIConnectorListener := TListener.Create(@FGUIConnector, @StyleChanged); FScale := DoublePoint(1, -1); - FScaleValid := False; - FScaleNeedsSecondPass := False; + FScalingValid := False; + FMultiPassScalingNeeded := False; Width := DEFAULT_CHART_WIDTH; Height := DEFAULT_CHART_HEIGHT; @@ -884,46 +884,49 @@ end; procedure TChart.Draw(ADrawer: IChartDrawer; const ARect: TRect); var + NewClipRect: TRect; ldd: TChartLegendDrawingData; tmpExtent: TDoubleRect; tries: Integer; s: TBasicChartSeries; ts: TBasicChartToolset; begin + ADrawer.SetRightToLeft(BiDiMode <> bdLeftToRight); + + NewClipRect := ARect; + with NewClipRect do begin + Left += MarginsExternal.Left; + Top += MarginsExternal.Top; + Right -= MarginsExternal.Right; + Bottom -= MarginsExternal.Bottom; + FTitle.Measure(ADrawer, 1, Left, Right, Top); + FFoot.Measure(ADrawer, -1, Left, Right, Bottom); + end; + ldd.FItems := nil; try Prepare; - ADrawer.SetRightToLeft(BiDiMode <> bdLeftToRight); + if Legend.Visible then + ldd := PrepareLegend(ADrawer, NewClipRect); - for tries := 1 to 2 do + for tries := 3 downto 0 do begin - FClipRect := ARect; - with MarginsExternal do begin - FClipRect.Left += Left; - FClipRect.Top += Top; - FClipRect.Right -= Right; - FClipRect.Bottom -= Bottom; - end; - - with ClipRect do begin - FTitle.Measure(ADrawer, 1, Left, Right, Top); - FFoot.Measure(ADrawer, -1, Left, Right, Bottom); - end; - - if Legend.Visible then - ldd := PrepareLegend(ADrawer, FClipRect); + FClipRect := NewClipRect; PrepareAxis(ADrawer); - if not FScaleNeedsSecondPass then break; + if (tries = 0) or (not FMultiPassScalingNeeded) then break; - if FIsZoomed then break; // GetFullExtent() has not been called in this case, - // in the Prepare() call above - tmpExtent := GetFullExtent; // perform second pass - if tmpExtent = FLogicalExtent then break; // second pass hasn't changed the extent + // FIsZoom=true: GetFullExtent has not been called in Prepare() above + if FIsZoomed then break; - // as in the Prepare() call + // Perform a next pass of extent calculation + tmpExtent := GetFullExtent; + // Converged successfully - next pass has not changed the extent --> break + if tmpExtent = FLogicalExtent then break; + + // As in the Prepare() call above FLogicalExtent := tmpExtent; FCurrentExtent := FLogicalExtent; end; @@ -1494,8 +1497,8 @@ var a: TChartAxis; s: TBasicChartSeries; begin - FScaleValid := False; - FScaleNeedsSecondPass := False; + FScalingValid := False; + FMultiPassScalingNeeded := False; for a in AxisList do if a.Transformations <> nil then @@ -1881,6 +1884,11 @@ begin Result := (AY - FOffset.Y) / FScale.Y; end; +procedure TChart.MultiPassScalingNeeded; +begin + FMultiPassScalingNeeded := True; +end; + procedure TChart.ZoomFull(AImmediateRecalc: Boolean); begin if AImmediateRecalc then