lazarus/components/tachart/tapolygonseries.pas

unit TAPolygonSeries;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Graphics,
  TAChartUtils, TADrawUtils, TACustomSeries, TALegend;

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);
  protected
    procedure GetLegendItems(AItems: TChartLegendItems); override;

  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, j: 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;

  // Single polygon --> we can use the standard Polygon() routine
  if nStart = 1 then
  begin
    SetLength(FPoints, nPoints);
    ADrawer.SetBrush(FBrush);
    ADrawer.SetPen(FPen);
    ADrawer.Polygon(FPoints, 0, Length(FPoints));
    exit;
  end;

  // If we get here we have multiple polygons. We must add points for a
  // "clean retreat" to the starting point, and then we fill the borderless
  // polygon and draw the border separately.

  // 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);

  SetLength(FPoints, nPoints + Length(FStart) - 1);
  j := nPoints;
  for i := High(FStart) downto 1 do
  begin
    FPoints[j] := FPoints[FStart[i]];
    inc(j);
  end;

  // Draw polygon fill
  if FBrush.Style <> bsClear then
  begin
    ADrawer.SetBrush(FBrush);
    ADrawer.SetPenParams(psClear, clTAColor);
    ADrawer.Polygon(FPoints, 0, Length(FPoints));
  end;

  // Draw border
  if FPen.Style <> psClear then
  begin
    ADrawer.Pen := FPen;
    for i := 0 to High(FStart) - 1 do
      ADrawer.PolyLine(FPoints, FStart[i], FStart[i+1] - FStart[i]);
  end;
end;

procedure TPolygonSeries.GetLegendItems(AItems: TChartLegendItems);
begin
  GetLegendItemsRect(AItems, FBrush, FPen);
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.