From 0bfea66f90cc6646b6eddcf9b913fec69ac9b80f Mon Sep 17 00:00:00 2001 From: wp Date: Sun, 24 Mar 2019 21:39:45 +0000 Subject: [PATCH] TAChart: Add clipping option to TDatapointDistanceTool. Update demo. git-svn-id: trunk@60766 - --- components/tachart/demo/distance/Main.lfm | 54 ++++++++++++------- components/tachart/demo/distance/Main.pas | 7 +++ .../tachart/demo/distance/distancedemo.lpi | 7 ++- components/tachart/fpdoc/tagraph.xml | 3 +- components/tachart/tadatatools.pas | 43 +++++++++------ 5 files changed, 72 insertions(+), 42 deletions(-) diff --git a/components/tachart/demo/distance/Main.lfm b/components/tachart/demo/distance/Main.lfm index 5894dac6c5..846d36760b 100644 --- a/components/tachart/demo/distance/Main.lfm +++ b/components/tachart/demo/distance/Main.lfm @@ -44,23 +44,24 @@ object Form1: TForm1 end object Panel1: TPanel Left = 4 - Height = 92 - Top = 407 + Height = 99 + Top = 400 Width = 797 Align = alBottom + AutoSize = True BorderSpacing.Left = 4 BorderSpacing.Top = 8 BorderSpacing.Right = 8 BorderSpacing.Bottom = 8 BevelOuter = bvNone - ClientHeight = 92 + ClientHeight = 99 ClientWidth = 797 TabOrder = 2 object rgSnapMode: TRadioGroup AnchorSideLeft.Control = Panel1 AnchorSideTop.Control = Panel1 Left = 0 - Height = 89 + Height = 99 Top = 0 Width = 103 AutoFill = True @@ -68,13 +69,14 @@ object Form1: TForm1 Caption = 'Snapping mode' ChildSizing.LeftRightSpacing = 6 ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 5 ChildSizing.EnlargeHorizontal = crsHomogenousChildResize ChildSizing.EnlargeVertical = crsHomogenousChildResize ChildSizing.ShrinkHorizontal = crsScaleChilds ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 1 - ClientHeight = 69 + ClientHeight = 79 ClientWidth = 99 ItemIndex = 0 Items.Strings = ( @@ -90,7 +92,7 @@ object Form1: TForm1 AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 Left = 217 - Height = 89 + Height = 99 Top = 0 Width = 98 AutoFill = True @@ -99,13 +101,14 @@ object Form1: TForm1 Caption = 'Drawing mode' ChildSizing.LeftRightSpacing = 6 ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 5 ChildSizing.EnlargeHorizontal = crsHomogenousChildResize ChildSizing.EnlargeVertical = crsHomogenousChildResize ChildSizing.ShrinkHorizontal = crsScaleChilds ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 1 - ClientHeight = 69 + ClientHeight = 79 ClientWidth = 94 ItemIndex = 1 Items.Strings = ( @@ -122,9 +125,8 @@ object Form1: TForm1 AnchorSideTop.Side = asrBottom Left = 439 Height = 19 - Top = 27 + Top = 23 Width = 82 - BorderSpacing.Top = 4 Caption = 'Rotate label' Checked = True OnClick = cbRotateLabelClick @@ -235,9 +237,8 @@ object Form1: TForm1 AnchorSideTop.Side = asrBottom Left = 439 Height = 19 - Top = 73 + Top = 61 Width = 114 - BorderSpacing.Top = 4 Caption = 'Hide at mouse up' OnClick = cbHideClick TabOrder = 5 @@ -247,7 +248,7 @@ object Form1: TForm1 AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 Left = 111 - Height = 89 + Height = 99 Top = 0 Width = 98 AutoFill = True @@ -256,13 +257,14 @@ object Form1: TForm1 Caption = 'Measure mode' ChildSizing.LeftRightSpacing = 6 ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 5 ChildSizing.EnlargeHorizontal = crsHomogenousChildResize ChildSizing.EnlargeVertical = crsHomogenousChildResize ChildSizing.ShrinkHorizontal = crsScaleChilds ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 1 - ClientHeight = 69 + ClientHeight = 79 ClientWidth = 94 ItemIndex = 0 Items.Strings = ( @@ -280,8 +282,8 @@ object Form1: TForm1 AnchorSideBottom.Control = cbHide AnchorSideBottom.Side = asrBottom Left = 561 - Height = 42 - Top = 50 + Height = 48 + Top = 32 Width = 128 Anchors = [akTop, akLeft, akRight, akBottom] Lines.Strings = ( @@ -296,7 +298,7 @@ object Form1: TForm1 AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Panel1 Left = 323 - Height = 89 + Height = 99 Top = 0 Width = 108 AutoFill = True @@ -305,13 +307,14 @@ object Form1: TForm1 Caption = 'Data point mode' ChildSizing.LeftRightSpacing = 6 ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 5 ChildSizing.EnlargeHorizontal = crsHomogenousChildResize ChildSizing.EnlargeVertical = crsHomogenousChildResize ChildSizing.ShrinkHorizontal = crsScaleChilds ChildSizing.ShrinkVertical = crsScaleChilds ChildSizing.Layout = cclLeftToRightThenTopToBottom ChildSizing.ControlsPerLine = 1 - ClientHeight = 69 + ClientHeight = 79 ClientWidth = 104 ItemIndex = 0 Items.Strings = ( @@ -328,17 +331,28 @@ object Form1: TForm1 AnchorSideTop.Side = asrBottom Left = 439 Height = 19 - Top = 50 + Top = 42 Width = 67 - BorderSpacing.Top = 4 Caption = 'Flip label' OnClick = cbFlipLabelClick TabOrder = 9 end + object cbClipping: TCheckBox + AnchorSideLeft.Control = cbShowLabel + AnchorSideTop.Control = cbHide + AnchorSideTop.Side = asrBottom + Left = 439 + Height = 19 + Top = 80 + Width = 65 + Caption = 'Clipping' + OnChange = cbClippingChange + TabOrder = 10 + end end object Chart1: TChart Left = 0 - Height = 399 + Height = 392 Top = 0 Width = 809 AutoFocus = True diff --git a/components/tachart/demo/distance/Main.pas b/components/tachart/demo/distance/Main.pas index a6eed7a151..b7e47e0fa0 100644 --- a/components/tachart/demo/distance/Main.pas +++ b/components/tachart/demo/distance/Main.pas @@ -27,6 +27,7 @@ type ChartAxisTransformations1LogarithmAxisTransform1: TLogarithmAxisTransform; ChartAxisTransformations3: TChartAxisTransformations; ChartAxisTransformations3AutoScaleAxisTransform1: TAutoScaleAxisTransform; + cbClipping: TCheckBox; chFit: TChart; chFitFitSeries1: TFitSeries; chFitLineSeries1: TLineSeries; @@ -60,6 +61,7 @@ type StatusBar1: TStatusBar; tsMain: TTabSheet; tsFit: TTabSheet; + procedure cbClippingChange(Sender: TObject); procedure cbFlipLabelClick(Sender: TObject); procedure cbHideClick(Sender: TObject); procedure cbRotateLabelClick(Sender: TObject); @@ -107,6 +109,11 @@ begin SwitchOptions([dpdoFlipLabel], cbFlipLabel.Checked); end; +procedure TForm1.cbClippingChange(Sender: TObject); +begin + SwitchOptions([dpdoClipping], cbClipping.Checked); +end; + procedure TForm1.cbHideClick(Sender: TObject); begin SwitchOptions([dpdoPermanent], not cbHide.Checked); diff --git a/components/tachart/demo/distance/distancedemo.lpi b/components/tachart/demo/distance/distancedemo.lpi index dec82b8e39..5160d889cc 100644 --- a/components/tachart/demo/distance/distancedemo.lpi +++ b/components/tachart/demo/distance/distancedemo.lpi @@ -1,11 +1,10 @@ - - + + - <Scaled Value="True"/> <ResourceType Value="res"/> @@ -17,7 +16,7 @@ <i18n> <EnableI18N LFM="False"/> </i18n> - <BuildModes Count="1"> + <BuildModes> <Item1 Name="Default" Default="True"/> </BuildModes> <PublishOptions> diff --git a/components/tachart/fpdoc/tagraph.xml b/components/tachart/fpdoc/tagraph.xml index c75b52f3af..f5fc86eb5c 100644 --- a/components/tachart/fpdoc/tagraph.xml +++ b/components/tachart/fpdoc/tagraph.xml @@ -339,8 +339,7 @@ chart margin and the space reserved for series marks. <var>Drawer</var>. Unlike <var>PaintOnCanvas</var> the chart can be drawn on non-canvas devices, such as a svg file. </descr> - <seealso> - <link id=""/> + <seealso><link id=""/> </seealso> </element> <element name="TChart.Create"> diff --git a/components/tachart/tadatatools.pas b/components/tachart/tadatatools.pas index d657966dd6..4993116fcf 100644 --- a/components/tachart/tadatatools.pas +++ b/components/tachart/tadatatools.pas @@ -50,7 +50,7 @@ type TDataPointMode = (dpmFree, dpmSnap, dpmLock); TOptions = set of ( - dpdoRotateLabel, dpdoLabelAbove, dpdoPermanent, dpdoFlipLabel); + dpdoRotateLabel, dpdoLabelAbove, dpdoPermanent, dpdoFlipLabel, dpdoClipping); strict private // Workaround for FPC 2.6 bug. Remove after migration to 2.8. @@ -230,6 +230,7 @@ var flip: Boolean; begin if not (IsActive or (FChart <> nil) and (dpdoPermanent in Options)) then exit; + p1 := FChart.GraphToImage(PointStart.GraphPos); p2 := FChart.GraphToImage(PointEnd.GraphPos); case MeasureMode of @@ -238,23 +239,33 @@ begin end; if p1 = p2 then exit; StartTransparency; - if LinePen.Visible then begin - FChart.Drawer.Pen := LinePen; - FChart.Drawer.Line(p1, p2); - end; - a := ArcTan2(p2.Y - p1.Y, p2.X - p1.X); - DrawPointer(PointerStart, p1); - DrawPointer(PointerEnd, p2); - if Marks.Visible then begin - flip := (dpdoFlipLabel in Options) and ((a > Pi /2) or (a < -Pi / 2)); - Marks.SetAdditionalAngle( - IfThen(dpdoRotateLabel in Options, IfThen(flip, Pi - a, -a), 0)); - p1 := (p1 + p2) div 2; - a += IfThen((dpdoLabelAbove in Options) xor flip, -Pi / 2, Pi / 2); - p2 := p1 + RotatePointX(Marks.Distance, a); - Marks.DrawLabel(FChart.Drawer, p1, p2, GetDistanceText, dummy); + + if dpdoClipping in FOptions then + FChart.Drawer.ClippingStart(FChart.ClipRect); + try + if LinePen.Visible then begin + FChart.Drawer.Pen := LinePen; + FChart.Drawer.Line(p1, p2); + end; + a := ArcTan2(p2.Y - p1.Y, p2.X - p1.X); + DrawPointer(PointerStart, p1); + DrawPointer(PointerEnd, p2); + + if Marks.Visible then begin + flip := (dpdoFlipLabel in Options) and ((a > Pi /2) or (a < -Pi / 2)); + Marks.SetAdditionalAngle( + IfThen(dpdoRotateLabel in Options, IfThen(flip, Pi - a, -a), 0)); + p1 := (p1 + p2) div 2; + a += IfThen((dpdoLabelAbove in Options) xor flip, -Pi / 2, Pi / 2); + p2 := p1 + RotatePointX(Marks.Distance, a); + Marks.DrawLabel(FChart.Drawer, p1, p2, GetDistanceText, dummy); + end; + finally + if dpdoClipping in FOptions then FChart.Drawer.ClippingStop; end; + inherited; + Chart.Drawer.SetTransparency(0); end;