From 48dfae77e3f61b0e918cad676d5947b9c9c5e59c Mon Sep 17 00:00:00 2001 From: wp Date: Sat, 19 Dec 2020 23:08:11 +0000 Subject: [PATCH] TAChart: Initial commit of new TPolygonSeries git-svn-id: trunk@64244 - --- .gitattributes | 1 + .../tachart/languages/tachartstrconsts.de.po | 7 +- .../tachart/languages/tachartstrconsts.fi.po | 4 + .../tachart/languages/tachartstrconsts.fr.po | 4 + .../tachart/languages/tachartstrconsts.hu.po | 4 + .../tachart/languages/tachartstrconsts.lt.po | 4 + .../tachart/languages/tachartstrconsts.pl.po | 4 + .../tachart/languages/tachartstrconsts.pot | 4 + .../languages/tachartstrconsts.pt_BR.po | 4 + .../tachart/languages/tachartstrconsts.ru.po | 4 + .../tachart/languages/tachartstrconsts.se.po | 4 + .../tachart/languages/tachartstrconsts.uk.po | 4 + .../languages/tachartstrconsts.zh_CN.po | 4 + components/tachart/tachartlazaruspkg.lpk | 6 +- components/tachart/tachartlazaruspkg.pas | 2 +- components/tachart/tachartstrconsts.pas | 1 + components/tachart/tapolygonseries.pas | 204 ++++++++++++++++++ 17 files changed, 261 insertions(+), 4 deletions(-) create mode 100644 components/tachart/tapolygonseries.pas diff --git a/.gitattributes b/.gitattributes index 3778a8c6be..14428b80bb 100644 --- a/.gitattributes +++ b/.gitattributes @@ -5432,6 +5432,7 @@ components/tachart/talegendpanel.pas svneol=native#text/pascal components/tachart/tamath.pas svneol=native#text/pascal components/tachart/tamultiseries.pas svneol=native#text/pascal components/tachart/tanavigation.pas svneol=native#text/pascal +components/tachart/tapolygonseries.pas svneol=native#text/pascal components/tachart/taradialseries.pas svneol=native#text/pascal components/tachart/taseries.pas svneol=native#text/plain components/tachart/tasources.pas svneol=native#text/pascal diff --git a/components/tachart/languages/tachartstrconsts.de.po b/components/tachart/languages/tachartstrconsts.de.po index 483e0d9b92..530b25f56b 100644 --- a/components/tachart/languages/tachartstrconsts.de.po +++ b/components/tachart/languages/tachartstrconsts.de.po @@ -10,7 +10,7 @@ msgstr "" "MIME-Version: 1.0\n" "Content-Transfer-Encoding: 8bit\n" "Language: de\n" -"X-Generator: Poedit 2.2\n" +"X-Generator: Poedit 2.4.2\n" "X-Poedit-SourceCharset: UTF-8\n" #: tachartstrconsts.descolor @@ -422,6 +422,10 @@ msgstr "Punkt" msgid "Polar series" msgstr "Polar-Diagramm" +#: tachartstrconsts.rspolygonseries +msgid "Polygon series" +msgstr "Polygon-Diagramm" + #: tachartstrconsts.rspsclear msgctxt "tachartstrconsts.rspsclear" msgid "no line" @@ -548,4 +552,3 @@ msgstr "Fehler beim Umbenennen von Komponenten: %s" #: tachartstrconsts.tastoolseditortitle msgid "Edit tools" msgstr "Werkzeuge bearbeiten" - diff --git a/components/tachart/languages/tachartstrconsts.fi.po b/components/tachart/languages/tachartstrconsts.fi.po index 6a5e0bcdfa..aef8ceb0e9 100644 --- a/components/tachart/languages/tachartstrconsts.fi.po +++ b/components/tachart/languages/tachartstrconsts.fi.po @@ -410,6 +410,10 @@ msgstr "" msgid "Polar series" msgstr "Napakuvaaja" +#: tachartstrconsts.rspolygonseries +msgid "Polygon series" +msgstr "" + #: tachartstrconsts.rspsclear msgctxt "tachartstrconsts.rspsclear" msgid "no line" diff --git a/components/tachart/languages/tachartstrconsts.fr.po b/components/tachart/languages/tachartstrconsts.fr.po index b39d566582..a6e5238ab9 100644 --- a/components/tachart/languages/tachartstrconsts.fr.po +++ b/components/tachart/languages/tachartstrconsts.fr.po @@ -420,6 +420,10 @@ msgstr "Point" msgid "Polar series" msgstr "Séries polaires" +#: tachartstrconsts.rspolygonseries +msgid "Polygon series" +msgstr "" + #: tachartstrconsts.rspsclear msgctxt "tachartstrconsts.rspsclear" msgid "no line" diff --git a/components/tachart/languages/tachartstrconsts.hu.po b/components/tachart/languages/tachartstrconsts.hu.po index acfd1b5bd8..928844cf44 100644 --- a/components/tachart/languages/tachartstrconsts.hu.po +++ b/components/tachart/languages/tachartstrconsts.hu.po @@ -420,6 +420,10 @@ msgstr "Pont" msgid "Polar series" msgstr "Polár" +#: tachartstrconsts.rspolygonseries +msgid "Polygon series" +msgstr "" + #: tachartstrconsts.rspsclear msgctxt "tachartstrconsts.rspsclear" msgid "no line" diff --git a/components/tachart/languages/tachartstrconsts.lt.po b/components/tachart/languages/tachartstrconsts.lt.po index 5ba2e56507..ce21f8c7e3 100644 --- a/components/tachart/languages/tachartstrconsts.lt.po +++ b/components/tachart/languages/tachartstrconsts.lt.po @@ -421,6 +421,10 @@ msgstr "Taškas" msgid "Polar series" msgstr "Polinės sekos" +#: tachartstrconsts.rspolygonseries +msgid "Polygon series" +msgstr "" + #: tachartstrconsts.rspsclear msgctxt "tachartstrconsts.rspsclear" msgid "no line" diff --git a/components/tachart/languages/tachartstrconsts.pl.po b/components/tachart/languages/tachartstrconsts.pl.po index aae2fe30f2..0a6a198001 100644 --- a/components/tachart/languages/tachartstrconsts.pl.po +++ b/components/tachart/languages/tachartstrconsts.pl.po @@ -420,6 +420,10 @@ msgstr "" msgid "Polar series" msgstr "" +#: tachartstrconsts.rspolygonseries +msgid "Polygon series" +msgstr "" + #: tachartstrconsts.rspsclear msgid "no line" msgstr "" diff --git a/components/tachart/languages/tachartstrconsts.pot b/components/tachart/languages/tachartstrconsts.pot index 9b98134a6a..e0ad0d50fd 100644 --- a/components/tachart/languages/tachartstrconsts.pot +++ b/components/tachart/languages/tachartstrconsts.pot @@ -410,6 +410,10 @@ msgstr "" msgid "Polar series" msgstr "" +#: tachartstrconsts.rspolygonseries +msgid "Polygon series" +msgstr "" + #: tachartstrconsts.rspsclear msgctxt "tachartstrconsts.rspsclear" msgid "no line" diff --git a/components/tachart/languages/tachartstrconsts.pt_BR.po b/components/tachart/languages/tachartstrconsts.pt_BR.po index 697ff3fe31..2ba7fee28b 100644 --- a/components/tachart/languages/tachartstrconsts.pt_BR.po +++ b/components/tachart/languages/tachartstrconsts.pt_BR.po @@ -420,6 +420,10 @@ msgstr "Ponto" msgid "Polar series" msgstr "Série Polar" +#: tachartstrconsts.rspolygonseries +msgid "Polygon series" +msgstr "" + #: tachartstrconsts.rspsclear msgctxt "tachartstrconsts.rspsclear" msgid "no line" diff --git a/components/tachart/languages/tachartstrconsts.ru.po b/components/tachart/languages/tachartstrconsts.ru.po index 39898106a2..f122c1ef3d 100644 --- a/components/tachart/languages/tachartstrconsts.ru.po +++ b/components/tachart/languages/tachartstrconsts.ru.po @@ -420,6 +420,10 @@ msgstr "Точка" msgid "Polar series" msgstr "Лепестковая диаграмма" +#: tachartstrconsts.rspolygonseries +msgid "Polygon series" +msgstr "" + #: tachartstrconsts.rspsclear msgctxt "tachartstrconsts.rspsclear" msgid "no line" diff --git a/components/tachart/languages/tachartstrconsts.se.po b/components/tachart/languages/tachartstrconsts.se.po index 1292975487..d1b70a09e5 100644 --- a/components/tachart/languages/tachartstrconsts.se.po +++ b/components/tachart/languages/tachartstrconsts.se.po @@ -423,6 +423,10 @@ msgstr "" msgid "Polar series" msgstr "Polardiagram" +#: tachartstrconsts.rspolygonseries +msgid "Polygon series" +msgstr "" + #: tachartstrconsts.rspsclear msgctxt "tachartstrconsts.rspsclear" msgid "no line" diff --git a/components/tachart/languages/tachartstrconsts.uk.po b/components/tachart/languages/tachartstrconsts.uk.po index 65d256c419..6d3533a2f0 100644 --- a/components/tachart/languages/tachartstrconsts.uk.po +++ b/components/tachart/languages/tachartstrconsts.uk.po @@ -423,6 +423,10 @@ msgstr "Точка" msgid "Polar series" msgstr "Пелюсткова діаграма" +#: tachartstrconsts.rspolygonseries +msgid "Polygon series" +msgstr "" + #: tachartstrconsts.rspsclear msgctxt "tachartstrconsts.rspsclear" msgid "no line" diff --git a/components/tachart/languages/tachartstrconsts.zh_CN.po b/components/tachart/languages/tachartstrconsts.zh_CN.po index 210a7adfcc..812583c0fd 100644 --- a/components/tachart/languages/tachartstrconsts.zh_CN.po +++ b/components/tachart/languages/tachartstrconsts.zh_CN.po @@ -421,6 +421,10 @@ msgstr "点" msgid "Polar series" msgstr "极线系列(Polar)" +#: tachartstrconsts.rspolygonseries +msgid "Polygon series" +msgstr "" + #: tachartstrconsts.rspsclear msgctxt "tachartstrconsts.rspsclear" msgid "no line" diff --git a/components/tachart/tachartlazaruspkg.lpk b/components/tachart/tachartlazaruspkg.lpk index 0a8181894d..d005b2ddd4 100644 --- a/components/tachart/tachartlazaruspkg.lpk +++ b/components/tachart/tachartlazaruspkg.lpk @@ -30,7 +30,7 @@ for details about the copyright. "/> - + @@ -266,6 +266,10 @@ + + + + diff --git a/components/tachart/tachartlazaruspkg.pas b/components/tachart/tachartlazaruspkg.pas index 473f1e8f8f..a7565b727b 100644 --- a/components/tachart/tachartlazaruspkg.pas +++ b/components/tachart/tachartlazaruspkg.pas @@ -19,7 +19,7 @@ uses TACustomFuncSeries, TAFitUtils, TAGUIConnector, TADiagram, TADiagramDrawing, TADiagramLayout, TAChartStrConsts, TAChartCombos, TAHtml, TAFonts, TAExpressionSeries, TAFitLib, TASourcePropEditors, TADataPointsEditor, - LazarusPackageIntf; + TAPolygonSeries, LazarusPackageIntf; implementation diff --git a/components/tachart/tachartstrconsts.pas b/components/tachart/tachartstrconsts.pas index 8be98c2a17..bb9a1372f9 100644 --- a/components/tachart/tachartstrconsts.pas +++ b/components/tachart/tachartstrconsts.pas @@ -26,6 +26,7 @@ resourcestring rsUserDrawnSeries = 'User-drawn series'; rsExpressionSeries = 'Math expression series'; rsExpressionColorMapSeries = 'Math expression color map series'; + rsPolygonSeries = 'Polygon series'; // Series editor sesSeriesEditorTitle = 'Edit series'; diff --git a/components/tachart/tapolygonseries.pas b/components/tachart/tapolygonseries.pas new file mode 100644 index 0000000000..64c994efea --- /dev/null +++ b/components/tachart/tapolygonseries.pas @@ -0,0 +1,204 @@ +unit TAPolygonSeries; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Graphics, + TAChartUtils, TADrawUtils, TACustomSeries; + +type + TPolygonSeries = class(TBasicPointSeries) + private + FBrush: TBrush; + FPen: TPen; + FPoints: array of TPoint; + FStart: array of Integer; + procedure SetBrush(AValue: TBrush); + procedure SetPen(AValue: TPen); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Draw(ADrawer: IChartDrawer); override; + function GetNearestPoint(const AParams: TNearestPointParams; + out AResults: TNearestPointResults): Boolean; override; + + published + property Brush: TBrush read FBrush write SetBrush; + property Pen: TPen read FPen write SetPen; + property ToolTargets default [nptPoint, nptCustom]; + + // inherited + property AxisIndexX; + property AxisIndexY; + property Source; + end; + +implementation + +uses + TAChartStrConsts, TAGeometry, TAGraph; + +constructor TPolygonSeries.Create(AOwner: TComponent); +begin + inherited; + ToolTargets := [nptPoint, nptCustom]; + + FPen := TPen.Create; + FPen.OnChange := @StyleChanged; + FBrush := TBrush.Create; + FBrush.OnChange := @StyleChanged; +end; + +destructor TPolygonSeries.Destroy; +begin + FPoints := nil; + FStart := nil; + FPen.Free; + FBrush.Free; + inherited; +end; + +procedure TPolygonSeries.Draw(ADrawer: IChartDrawer); +const + START_BLOCKSIZE = 100; +var + ext: TDoubleRect; + ap, apStart: TDoublePoint; // axis units + gp: TDoublePoint; // graph units + pt: TPoint; // image units + nSource, nPoints: Integer; + nStart: Integer; + newPolygon: Boolean; + i: Integer; + + procedure SavePolygonStartIndex(AIndex: Integer); + begin + if nStart mod START_BLOCKSIZE = 0 then + SetLength(FStart, Length(FStart) + START_BLOCKSIZE); + FStart[nStart] := AIndex; + inc(nStart); + end; + +begin + if IsEmpty or (not Active) then + exit; + + // Do not draw anything if the series extent does not intersect CurrentExtent. + with Extent do begin + ext.a := AxisToGraph(a); + ext.b := AxisToGraph(b); + end; + NormalizeRect(ext); + if not RectIntersectsRect(ext, ParentChart.CurrentExtent) then + exit; + + nSource := Source.Count; + SetLength(FPoints, nSource); + SetLength(FStart, START_BLOCKSIZE); + nStart := 0; + nPoints := 0; + newPolygon := true; + + for i := 0 to nSource-1 do begin + // a new polygon begins with the current index --> store index in array FStart[]. + if newPolygon then begin + SavePolygonStartIndex(nPoints); + + // Since the polygon ends if the start point is met again we must store the start point. + apStart := Source.Item[i]^.Point; + end; + + // Get polygon point in image coordinates + ap := Source.Item[i]^.Point; + if IsRotated then + gp := DoublePoint(AxisToGraphX(ap.Y), AxisToGraphY(ap.X)) + else + gp := AxisToGraph(ap); + pt := ParentChart.GraphToImage(gp); + + // Store image point in FPoints array + FPoints[nPoints] := pt; + inc(nPoints); + + // Current point coincides with the polygon start point + // --> polygon is closed, set flag "newPolygon" to be processed in next iteration + if (ap = apStart) then + newPolygon := not newPolygon; + end; + + if nPoints = 0 then + exit; + + // Use length of FStart array as last array element for easier calculation + SavePolygonStartIndex(nPoints); + + // Trim length of FStart array to occupied length + SetLength(FStart, nStart); + + // Draw polygon(s) + ADrawer.SetBrush(FBrush); + ADrawer.SetPen(FPen); + for i := 0 to High(FStart)-1 do + ADrawer.Polygon(FPoints, FStart[i], FStart[i+1] - FStart[i]); + +end; + +{ Is overridden in order to detect tool events inside the polygon (nptCustom). + Otherwise only events on the perimenter would be detected. } +function TPolygonSeries.GetNearestPoint(const AParams: TNearestPointParams; + out AResults: TNearestPointResults): Boolean; +var + ext: TDoubleRect; +begin + Result := false; + AResults.FDist := sqr(AParams.FRadius) + 1; + AResults.FIndex := -1; + AResults.FXIndex := 0; + AResults.FYIndex := 0; + + Result := inherited; + + if Result or not ((nptCustom in AParams.FTargets) and (nptCustom in ToolTargets)) then + exit; + + with Extent do begin + ext.a := AxisToGraph(a); + ext.b := AxisToGraph(b); + end; + NormalizeRect(ext); + // Do not do anything if the series extent does not intersect CurrentExtent. + if not RectIntersectsRect(ext, ParentChart.CurrentExtent) then + exit; + + Result := IsPointInPolygon(AParams.FPoint, FPoints); + if Result then + begin + AResults.FDist := 0; + AResults.FIndex := 0; + AResults.FYIndex := 0; + AResults.FValue := ParentChart.ImageToGraph(AParams.FPoint); + AResults.FImg := AParams.FPoint; + end; +end; + + +procedure TPolygonSeries.SetBrush(AValue: TBrush); +begin + FBrush.Assign(AValue); + UpdateParentChart; +end; + +procedure TPolygonSeries.SetPen(AValue: TPen); +begin + FPen.Assign(AValue); + UpdateParentChart; +end; + + +initialization + RegisterSeriesClass(TPolygonSeries, @rsPolygonSeries); + +end. +