lazarus/components/tachart/taseries.pas

{
 /***************************************************************************
                               TASeries.pas
                               ------------
                Component Library Standard Graph Series


 ***************************************************************************/

 *****************************************************************************
 *                                                                           *
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,    *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************

Authors: Luís Rodrigues, Philippe Martinole, Alexander Klenin

}

unit TASeries;

{$H+}

interface

uses
  Classes, Graphics,
  TAChartUtils, TADrawUtils, TACustomSeries, TAGraph, TALegend, TATypes;

const
  DEF_BAR_WIDTH_PERCENT = 70;

type
  EBarError = class(EChartError);

  TLabelDirection = (ldLeft, ldTop, ldRight, ldBottom);

  { TBasicPointSeries }

  TBasicPointSeries = class(TChartSeries)
  private
    procedure SetUseReticule(AValue: Boolean);

  protected
    FUseReticule: Boolean;

    procedure DrawLabels(ACanvas: TCanvas);
    function GetLabelDirection(AIndex: Integer): TLabelDirection; virtual;
    procedure UpdateMargins(ACanvas: TCanvas; var AMargins: TRect); override;
    property UseReticule: Boolean
      read FUseReticule write SetUseReticule default false;
  public
    function GetNearestPoint(
      ADistFunc: TPointDistFunc; const APoint: TPoint;
      out AIndex: Integer; out AImg: TPoint; out AValue: TDoublePoint): Boolean;
      override;
    procedure MovePoint(var AIndex: Integer; const ANewPos: TPoint); override;
  end;

  { TBarSeries }

  TBarSeries = class(TBasicPointSeries)
  private
    FBarBrush: TBrush;
    FBarPen: TPen;
    FBarWidthPercent: Integer;

    function CalcBarWidth(AX: Double; AIndex: Integer): Double;
    procedure SetBarBrush(Value: TBrush);
    procedure SetBarPen(Value: TPen);
    procedure SetBarWidthPercent(Value: Integer);
    procedure SetSeriesColor(AValue: TColor);
  protected
    procedure GetLegendItems(AItems: TChartLegendItems); override;
    function GetSeriesColor: TColor; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  public
    procedure Draw(ACanvas: TCanvas); override;
    function Extent: TDoubleRect; override;
  published
    property AxisIndexX;
    property AxisIndexY;
    property BarBrush: TBrush read FBarBrush write SetBarBrush;
    property BarPen: TPen read FBarPen write SetBarPen;
    property BarWidthPercent: Integer
      read FBarWidthPercent write SetBarWidthPercent default DEF_BAR_WIDTH_PERCENT;
    property Depth;
    property SeriesColor: TColor
      read GetSeriesColor write SetSeriesColor default clTAColor;
    property Source;
    property UseReticule;
  end;

  { TPieSeries }

  TPieSeries = class(TChartSeries)
  private
    FExploded: Boolean;
    procedure SetExploded(const AValue: Boolean);
    function SliceColor(AIndex: Integer): TColor;
  protected
    procedure AfterAdd; override;
    procedure GetLegendItems(AItems: TChartLegendItems); override;
  public
    function AddPie(Value: Double; Text: String; Color: TColor): Longint;
    procedure Draw(ACanvas: TCanvas); override;
  published
    // Offset slices away from center based on X value.
    property Exploded: Boolean read FExploded write SetExploded default false;
    property Source;
  end;

  { TAreaSeries }

  TAreaSeries = class(TBasicPointSeries)
  private
    FAreaBrush: TBrush;
    FAreaLinesPen: TPen;
    FInvertedStairs: Boolean;
    FStairs: Boolean;

    procedure SetAreaBrush(Value: TBrush);
    procedure SetInvertedStairs(Value: Boolean);
    procedure SetSeriesColor(AValue: TColor);
    procedure SetStairs(Value: Boolean);
  protected
    function GetLabelDirection(AIndex: Integer): TLabelDirection; override;
    procedure GetLegendItems(AItems: TChartLegendItems); override;
    function GetSeriesColor: TColor; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Draw(ACanvas: TCanvas); override;
  published
    property AxisIndexX;
    property AxisIndexY;
  published
    property AreaBrush: TBrush read FAreaBrush write SetAreaBrush;
    property AreaLinesPen: TPen read FAreaLinesPen write FAreaLinesPen;
    property Depth;
    property InvertedStairs: Boolean
      read FInvertedStairs write SetInvertedStairs default false;
    property SeriesColor: TColor
      read GetSeriesColor write SetSeriesColor default clTAColor;
    property Source;
    property Stairs: Boolean read FStairs write SetStairs default false;
    property UseReticule;
  end;

  TSeriesPointerDrawEvent = procedure (
    ASender: TChartSeries; ACanvas: TCanvas; AIndex: Integer;
    ACenter: TPoint) of object;

  TLineType = (ltNone, ltFromPrevious, ltFromOrigin, ltStepXY, ltStepYX);

  { TLineSeries }

  TLineSeries = class(TBasicPointSeries)
  private
    FLinePen: TPen;
    FLineType: TLineType;
    FOnDrawPointer: TSeriesPointerDrawEvent;
    FPointer: TSeriesPointer;
    FShowPoints: Boolean;

    function GetShowLines: Boolean;
    procedure SetLinePen(AValue: TPen);
    procedure SetLineType(AValue: TLineType);
    procedure SetPointer(Value: TSeriesPointer);
    procedure SetSeriesColor(AValue: TColor);
    procedure SetShowLines(Value: Boolean);
    procedure SetShowPoints(Value: Boolean);
  protected
    procedure AfterAdd; override;
    procedure GetLegendItems(AItems: TChartLegendItems); override;
    function GetSeriesColor: TColor; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

    procedure Draw(ACanvas: TCanvas); override;
  public
    procedure BeginUpdate;
    procedure EndUpdate;
  published
    property AxisIndexX;
    property AxisIndexY;
    property Depth;
    property LinePen: TPen read FLinePen write SetLinePen;
    property LineType: TLineType
      read FLineType write SetLineType default ltFromPrevious;
    property OnDrawPointer: TSeriesPointerDrawEvent
      read FOnDrawPointer write FOnDrawPointer;
    property Pointer: TSeriesPointer read FPointer write SetPointer;
    property SeriesColor: TColor
      read GetSeriesColor write SetSeriesColor default clTAColor;
    property ShowLines: Boolean
      read GetShowLines write SetShowLines stored false default true;
    property ShowPoints: Boolean
      read FShowPoints write SetShowPoints default false;
    property Source;
    property UseReticule default true;
  end;

  // 'TSerie' alias is for compatibility with older versions of TAChart.
  // Use TLineSeries instead.
  TSerie = TLineSeries deprecated;

  TLineStyle = (lsVertical, lsHorizontal);

  { TConstantLine }

  TConstantLine = class(TCustomChartSeries)
  private
    FLineStyle: TLineStyle;
    FPen: TPen;
    FPosGraph: Double; // Graph coordinate of line
    FUseBounds: Boolean;

    function GetSeriesColor: TColor;
    procedure SavePosToCoord(var APoint: TDoublePoint);
    procedure SetLineStyle(AValue: TLineStyle);
    procedure SetPen(AValue: TPen);
    procedure SetPos(AValue: Double);
    procedure SetSeriesColor(AValue: TColor);
    procedure SetUseBounds(AValue: Boolean);
  protected
    procedure GetBounds(var ABounds: TDoubleRect); override;
    procedure GetLegendItems(AItems: TChartLegendItems); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;

    procedure Draw(ACanvas: TCanvas); override;
    function GetNearestPoint(
      ADistFunc: TPointDistFunc;
      const APoint: TPoint; out AIndex: Integer; out AImg: TPoint;
      out AValue: TDoublePoint): Boolean; override;
    procedure MovePoint(var AIndex: Integer; const ANewPos: TPoint); override;

  published
    property Active default true;
    property LineStyle: TLineStyle
      read FLineStyle write SetLineStyle default lsHorizontal;
    property Pen: TPen read FPen write SetPen;
    property Position: Double read FPosGraph write SetPos;
    property SeriesColor: TColor
      read GetSeriesColor write SetSeriesColor default clTAColor;
    property ShowInLegend;
    property Title;
    property UseBounds: Boolean read FUseBounds write SetUseBounds default true;
    property ZPosition;
  end;

  // 'TLine' alias is for compatibility with older versions of TAChart.
  // Use TConstantLine instead.
  TLine = class(TConstantLine) end deprecated;

  TFuncCalculateEvent = procedure (const AX: Double; out AY: Double) of object;

  TFuncSeriesStep = 1..MaxInt;

  { TFuncSeries }

  TFuncSeries = class(TCustomChartSeries)
  private
    FDomainExclusions: TIntervalList;
    FExtent: TChartExtent;
    FOnCalculate: TFuncCalculateEvent;
    FPen: TChartPen;
    FStep: TFuncSeriesStep;

    procedure SetExtent(const AValue: TChartExtent);
    procedure SetOnCalculate(const AValue: TFuncCalculateEvent);
    procedure SetPen(const AValue: TChartPen);
    procedure SetStep(AValue: TFuncSeriesStep);
  protected
    procedure GetBounds(var ABounds: TDoubleRect); override;
    procedure GetLegendItems(AItems: TChartLegendItems); override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure Draw(ACanvas: TCanvas); override;
    function IsEmpty: Boolean; override;
  public
    property DomainExclusions: TIntervalList read FDomainExclusions;
  published
    property Active default true;
    property AxisIndexY;
    property Extent: TChartExtent read FExtent write SetExtent;
    property OnCalculate: TFuncCalculateEvent read FOnCalculate write SetOnCalculate;
    property Pen: TChartPen read FPen write SetPen;
    property ShowInLegend;
    property Step: TFuncSeriesStep read FStep write SetStep default 2;
    property Title;
    property ZPosition;
  end;

  TSeriesDrawEvent = procedure (ACanvas: TCanvas; const ARect: TRect) of object;
  TSeriesGetBoundsEvent = procedure (var ABounds: TDoubleRect) of object;

  { TUserDrawnSeries }

  TUserDrawnSeries = class(TCustomChartSeries)
  private
    FOnDraw: TSeriesDrawEvent;
    FOnGetBounds: TSeriesGetBoundsEvent;
    procedure SetOnDraw(AValue: TSeriesDrawEvent);
    procedure SetOnGetBounds(AValue: TSeriesGetBoundsEvent);
  protected
    procedure GetBounds(var ABounds: TDoubleRect); override;
    procedure GetLegendItems(AItems: TChartLegendItems); override;
  public
    procedure Draw(ACanvas: TCanvas); override;
    function IsEmpty: Boolean; override;
  published
    property Active default true;
    property ZPosition;
  published
    property OnDraw: TSeriesDrawEvent read FOnDraw write SetOnDraw;
    property OnGetBounds: TSeriesGetBoundsEvent
      read FOnGetBounds write SetOnGetBounds;
  end;

implementation

uses
  GraphMath, Math, PropEdits, SysUtils, Types;

{ TLineSeries }

procedure TLineSeries.AfterAdd;
begin
  inherited AfterAdd;
  FPointer.SetOwner(FChart);
end;

procedure TLineSeries.BeginUpdate;
begin
  ListSource.BeginUpdate;
end;

constructor TLineSeries.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FLinePen := TPen.Create;
  FLinePen.OnChange := @StyleChanged;
  FLineType := ltFromPrevious;
  FPointer := TSeriesPointer.Create(FChart);
  FUseReticule := true;
end;

destructor TLineSeries.Destroy;
begin
  FreeAndNil(FLinePen);
  FreeAndNil(FPointer);
  inherited;
end;

procedure TLineSeries.Draw(ACanvas: TCanvas);
var
  points: array of TPoint;
  pointCount: Integer = 0;
  breaks: TIntegerDynArray;
  breakCount: Integer = 0;

  procedure CacheLine(AA, AB: TDoublePoint);
  var
    ai, bi: TPoint;
  begin
    // This is not an optimization, but a safety check to avoid
    // integer overflow with extreme zoom-ins.
    if not LineIntersectsRect(AA, AB, ParentChart.CurrentExtent) then exit;
    ai := ParentChart.GraphToImage(AA);
    bi := ParentChart.GraphToImage(AB);
    if ai = bi then exit;
    if (pointCount = 0) or (points[pointCount - 1] <> ai) then begin
      breaks[breakCount] := pointCount;
      breakCount += 1;
      points[pointCount] := ai;
      pointCount += 1;
    end;
    points[pointCount] := bi;
    pointCount += 1;
  end;

var
  gp: array of TDoublePoint;

  procedure DrawLines;
  var
    i, j: Integer;
    orig, m: TDoublePoint;
  begin
    if LineType = ltNone then exit;
    // For extremely long series (10000 points or more), the Canvas.Line
    // call becomes a bottleneck. So represent a serie as a sequence of polylines.
    // This achieves approximately 3x speedup for the typical case.
    SetLength(points, 2 * Length(gp));
    SetLength(breaks, Length(gp) + 1);
    case LineType of
      ltFromPrevious: begin
        for i := 0 to High(gp) - 1 do
          CacheLine(gp[i], gp[i + 1]);
      end;
      ltFromOrigin: begin
        orig := AxisToGraph(ZeroDoublePoint);
        for i := 0 to High(gp) do
          CacheLine(orig, gp[i]);
      end;
      ltStepXY, ltStepYX: begin
        for i := 0 to High(gp) - 1 do begin
          if (LineType = ltStepXY) xor IsRotated then
            m := DoublePoint(gp[i + 1].X, gp[i].Y)
          else
            m := DoublePoint(gp[i].X, gp[i + 1].Y);
          CacheLine(gp[i], m);
          CacheLine(m, gp[i + 1]);
        end;
      end;
    end;
    breaks[breakCount] := pointCount;
    breakCount += 1;
    SetLength(points, pointCount);
    SetLength(breaks, breakCount);

    ACanvas.Pen.Assign(LinePen);
    if Depth = 0 then
      for i := 0 to High(breaks) - 1 do
        ACanvas.Polyline(points, breaks[i], breaks[i + 1] - breaks[i])
    else begin
      ACanvas.Brush.Style := bsSolid;
      ACanvas.Brush.Color := LinePen.Color;
      ACanvas.Pen.Color := clBlack;
      for i := 0 to High(breaks) - 1 do
        for j := breaks[i] to breaks[i + 1] - 2 do
          DrawLineDepth(ACanvas, points[j], points[j + 1], Depth);
    end;
  end;

var
  i, lb, ub: Integer;
  ai: TPoint;
  ext: TDoubleRect;
begin
  // Do not draw anything if the series extent does not intersect CurrentExtent.
  ext.a := AxisToGraph(Source.Extent.a);
  ext.b := AxisToGraph(Source.Extent.b);
  if LineType = ltFromOrigin then
    ExpandRect(ext, AxisToGraph(ZeroDoublePoint));
  if not RectIntersectsRect(ext, ParentChart.CurrentExtent) then exit;

  // Find an interval of x-values intersecting the CurrentExtent.
  // Requires monotonic (but not necessarily increasing) axis transformation.
  lb := 0;
  ub := Count - 1;
  if LineType <> ltFromOrigin then begin
    if IsRotated then
      Source.FindBounds(GraphToAxisY(ext.a.Y), GraphToAxisY(ext.b.Y), lb, ub)
    else
      Source.FindBounds(GraphToAxisX(ext.a.X), GraphToAxisX(ext.b.X), lb, ub);
    lb := Max(lb - 1, 0);
    ub := Min(ub + 1, Count - 1);
  end;

  SetLength(gp, ub - lb + 1);
  if (AxisIndexX < 0) and (AxisIndexY < 0) then
    // Optimization: bypass transformations in the default case.
    for i := lb to ub do
      with Source[i]^ do
        gp[i - lb] := DoublePoint(X, Y)
  else
    for i := lb to ub do
      gp[i - lb] := GetGraphPoint(i);

  DrawLines;
  DrawLabels(ACanvas);

  if FShowPoints then
    for i := lb to ub do begin
      if not ParentChart.IsPointInViewPort(gp[i - lb]) then continue;
      ai := ParentChart.GraphToImage(gp[i - lb]);
      FPointer.Draw(ACanvas, ai, GetColor(i));
      if Assigned(FOnDrawPointer) then
        FOnDrawPointer(Self, ACanvas, i, ai);
    end;
end;

procedure TLineSeries.EndUpdate;
begin
  ListSource.EndUpdate;
  UpdateParentChart;
end;

procedure TLineSeries.GetLegendItems(AItems: TChartLegendItems);
begin
  AItems.Add(TLegendItemLine.Create(LinePen, Title));
end;

function TLineSeries.GetSeriesColor: TColor;
begin
  Result := FLinePen.Color;
end;

function TLineSeries.GetShowLines: Boolean;
begin
  Result := FLineType <> ltNone;
end;

procedure TLineSeries.SetLinePen(AValue: TPen);
begin
  FLinePen.Assign(AValue);
end;

procedure TLineSeries.SetLineType(AValue: TLineType);
begin
  if FLineType = AValue then exit;
  FLineType := AValue;
  UpdateParentChart;
end;

procedure TLineSeries.SetPointer(Value: TSeriesPointer);
begin
  FPointer.Assign(Value);
  UpdateParentChart;
end;

procedure TLineSeries.SetSeriesColor(AValue: TColor);
begin
  FLinePen.Color := AValue;
end;

procedure TLineSeries.SetShowLines(Value: Boolean);
begin
  if ShowLines = Value then exit;
  if Value then
    FLineType := ltFromPrevious
  else
    FLineType := ltNone;
  UpdateParentChart;
end;

procedure TLineSeries.SetShowPoints(Value: Boolean);
begin
  FShowPoints := Value;
  UpdateParentChart;
end;

{ TConstantLine }

constructor TConstantLine.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FLineStyle := lsHorizontal;
  FPen := TPen.Create;
  FPen.OnChange := @StyleChanged;
  FUseBounds := true;
end;

destructor TConstantLine.Destroy;
begin
  FreeAndNil(FPen);
  inherited;
end;

procedure TConstantLine.Draw(ACanvas: TCanvas);
begin
  ACanvas.Brush.Style := bsClear;
  ACanvas.Pen.Assign(FPen);

  with ParentChart do
    case LineStyle of
      lsHorizontal:
        DrawLineHoriz(ACanvas, YGraphToImage(FPosGraph));
      lsVertical:
        DrawLineVert(ACanvas, XGraphToImage(FPosGraph));
    end;
end;

procedure TConstantLine.GetBounds(var ABounds: TDoubleRect);
begin
  if not UseBounds then exit;
  SavePosToCoord(ABounds.a);
  SavePosToCoord(ABounds.b);
end;

procedure TConstantLine.GetLegendItems(AItems: TChartLegendItems);
begin
  AItems.Add(TLegendItemLine.Create(Pen, Title));
end;

function TConstantLine.GetNearestPoint(ADistFunc: TPointDistFunc;
  const APoint: TPoint; out AIndex: Integer; out AImg: TPoint; out
  AValue: TDoublePoint): Boolean;
begin
  Unused(ADistFunc);
  Result := true;
  AIndex := -1;
  AImg := APoint;
  // Return the actual nearest point of the line.
  if LineStyle = lsVertical then begin
    AValue.Y := FChart.YImageToGraph(APoint.Y);
    AImg.X := FChart.XGraphToImage(Position);
  end
  else begin
    AValue.X := FChart.XImageToGraph(APoint.X);
    AImg.Y := FChart.YGraphToImage(Position);
  end;
  SavePosToCoord(AValue);
end;

function TConstantLine.GetSeriesColor: TColor;
begin
  Result := FPen.Color;
end;

procedure TConstantLine.MovePoint(var AIndex: Integer; const ANewPos: TPoint);
begin
  Unused(AIndex);
  if LineStyle = lsVertical then
    Position := FChart.XImageToGraph(ANewPos.X)
  else
    Position := FChart.YImageToGraph(ANewPos.Y);
end;

procedure TConstantLine.SavePosToCoord(var APoint: TDoublePoint);
begin
  if LineStyle = lsVertical then
    APoint.X := Position
  else
    APoint.Y := Position;
end;

procedure TConstantLine.SetLineStyle(AValue: TLineStyle);
begin
  if FLineStyle = AValue then exit;
  FLineStyle := AValue;
  UpdateParentChart;
end;

procedure TConstantLine.SetPen(AValue: TPen);
begin
  FPen.Assign(AValue);
end;

procedure TConstantLine.SetPos(AValue: Double);
begin
  if FPosGraph = AValue then exit;
  FPosGraph := AValue;
  UpdateParentChart;
end;

procedure TConstantLine.SetSeriesColor(AValue: TColor);
begin
  if FPen.Color = AValue then exit;
  FPen.Color := AValue;
end;

procedure TConstantLine.SetUseBounds(AValue: Boolean);
begin
  if FUseBounds = AValue then exit;
  FUseBounds := AValue;
  UpdateParentChart;
end;

{ TBasicPointSeries }

procedure TBasicPointSeries.DrawLabels(ACanvas: TCanvas);
var
  prevLabelPoly: TPointArray;

  procedure DrawLabel(
    const AText: String; const ADataPoint: TPoint; ADir: TLabelDirection);
  const
    OFFSETS: array [TLabelDirection] of TPoint =
      ((X: -1; Y: 0), (X: 0; Y: -1), (X: 1; Y: 0), (X: 0; Y: 1));
  var
    center: TPoint;
    sz: TSize;
  begin
    if AText = '' then exit;

    sz := Marks.MeasureLabel(ACanvas, AText);
    center := ADataPoint;
    center.X += OFFSETS[ADir].X * (Marks.Distance + sz.cx div 2);
    center.Y += OFFSETS[ADir].Y * (Marks.Distance + sz.cy div 2);
    Marks.DrawLabel(ACanvas, ADataPoint, center, AText, prevLabelPoly);
  end;

var
  g: TDoublePoint;
  i: Integer;
begin
  if not Marks.IsMarkLabelsVisible then exit;
  for i := 0 to Count - 1 do begin
    g := GetGraphPoint(i);
    with ParentChart do
      if IsPointInViewPort(g) then
        DrawLabel(FormattedMark(i), GraphToImage(g), GetLabelDirection(i));
  end;
end;

function TBasicPointSeries.GetLabelDirection(AIndex: Integer): TLabelDirection;
const
  DIR: array [Boolean, Boolean] of TLabelDirection =
    ((ldTop, ldBottom), (ldRight, ldLeft));
begin
  Result := DIR[IsRotated, GetGraphPointY(AIndex) < 0];
end;

function TBasicPointSeries.GetNearestPoint(
  ADistFunc: TPointDistFunc; const APoint: TPoint;
  out AIndex: Integer; out AImg: TPoint; out AValue: TDoublePoint): Boolean;
var
  dist, minDist, i: Integer;
  pt: TPoint;
begin
  Result := UseReticule and (Count > 0);
  minDist := MaxInt;
  for i := 0 to Count - 1 do begin
    pt := Point(GetXImgValue(i), GetYImgValue(i));
    dist := ADistFunc(APoint, pt);
    if dist >= minDist then
      Continue;
    minDist := dist;
    AIndex := i;
    AImg := pt;
    AValue.X := GetXValue(i);
    AValue.Y := GetYValue(i);
  end;
end;

procedure TBasicPointSeries.MovePoint(
  var AIndex: Integer; const ANewPos: TPoint);
var
  p: TDoublePoint;
begin
  if not InRange(AIndex, 0, Count - 1) then exit;
  p := FChart.ImageToGraph(ANewPos);
  with ListSource do begin
    AIndex := SetXValue(AIndex, p.X);
    SetYValue(AIndex, p.Y);
  end;
end;

procedure TBasicPointSeries.SetUseReticule(AValue: Boolean);
begin
  if FUseReticule = AValue then exit;
  FUseReticule := AValue;
  UpdateParentChart;
end;

procedure TBasicPointSeries.UpdateMargins(ACanvas: TCanvas; var AMargins: TRect);
const
  LABEL_TO_BORDER = 4;
var
  i, d: Integer;
  labelText: String;
  dir: TLabelDirection;
  m: array [TLabelDirection] of Integer absolute AMargins;
begin
  if not Marks.IsMarkLabelsVisible then exit;

  for i := 0 to Count - 1 do begin
    if not ParentChart.IsPointInViewPort(GetGraphPoint(i)) then continue;
    labelText := FormattedMark(i);
    if labelText = '' then continue;

    dir := GetLabelDirection(i);
    with Marks.MeasureLabel(ACanvas, labelText) do
      d := IfThen(dir in [ldLeft, ldRight], cx, cy);
    m[dir] := Max(m[dir], d + Marks.Distance + LABEL_TO_BORDER);
  end;
end;

{ TBarSeries }

function TBarSeries.CalcBarWidth(AX: Double; AIndex: Integer): Double;
begin
  case CASE_OF_TWO[AIndex > 0, AIndex < Count - 1] of
    cotNone: Result := 1.0;
    cotFirst: Result := Abs(AX - GetGraphPointX(AIndex - 1));
    cotSecond: Result := Abs(AX - GetGraphPointX(AIndex + 1));
    cotBoth: Result := Min(
      Abs(AX - GetGraphPointX(AIndex - 1)),
      Abs(AX - GetGraphPointX(AIndex + 1)));
  end;
  Result *= FBarWidthPercent * PERCENT / 2;
end;

constructor TBarSeries.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBarWidthPercent := DEF_BAR_WIDTH_PERCENT;

  FBarBrush := TBrush.Create;
  FBarBrush.OnChange := @StyleChanged;

  FBarPen := TPen.Create;
  FBarPen.OnChange := @StyleChanged;
  FBarPen.Color := clBlack;
  FBarBrush.Color := clRed;
end;

destructor TBarSeries.Destroy;
begin
  FreeAndNil(FBarPen);
  FreeAndNil(FBarBrush);
  inherited;
end;

procedure TBarSeries.Draw(ACanvas: TCanvas);

  procedure DrawBar(const AR: TRect);
  var
    sz: TSize;
  begin
    sz := Size(AR);
    if (sz.cx > 2) and (sz.cy > 2) then
      ACanvas.Pen.Assign(BarPen)
    else begin
      // Bars are too small to distinguish border from interior.
      ACanvas.Pen.Color := ACanvas.Brush.Color;
      ACanvas.Pen.Style := psSolid;
    end;

    ACanvas.Rectangle(AR);

    if Depth = 0 then exit;
    DrawLineDepth(ACanvas, AR.Left, AR.Top, AR.Right - 1, AR.Top, Depth);
    DrawLineDepth(
      ACanvas, AR.Right - 1, AR.Top, AR.Right - 1, AR.Bottom - 1, Depth);
  end;

var
  i: Integer;
  ext2, graphBar: TDoubleRect;
  imageBar: TRect;
  w: Double;
  p: TDoublePoint;
begin
  if IsEmpty then exit;

  ext2 := ParentChart.CurrentExtent;
  ExpandRange(ext2.a.X, ext2.b.X, 1.0);
  ExpandRange(ext2.a.Y, ext2.b.Y, 1.0);

  ACanvas.Brush.Assign(BarBrush);
  for i := 0 to Count - 1 do begin
    p := GetGraphPoint(i);
    w := CalcBarWidth(GetGraphPointX(i), i);
    if IsRotated then
      graphBar := DoubleRect(AxisToGraphX(0), p.Y - w, p.X, p.Y + w)
    else
      graphBar := DoubleRect(p.X - w, AxisToGraphY(0), p.X + w, p.Y);
    if not RectIntersectsRect(graphBar, ext2) then continue;

    with imageBar do begin
      TopLeft := ParentChart.GraphToImage(graphBar.a);
      BottomRight := ParentChart.GraphToImage(graphBar.b);
      NormalizeRect(imageBar);

      // Draw a line instead of an empty rectangle.
      if Bottom = Top then Dec(Top);
      if Left = Right then Inc(Right);
    end;
    ACanvas.Brush.Color := GetColor(i);
    DrawBar(imageBar);
  end;

  DrawLabels(ACanvas);
end;

function TBarSeries.Extent: TDoubleRect;
var
  x: Double;
begin
  Result := inherited Extent;
  if IsEmpty then exit;
  UpdateMinMax(0, Result.a.Y, Result.b.Y);
  // Show first and last bars fully.
  x := GetGraphPointX(0);
  Result.a.X := Min(Result.a.X, x - CalcBarWidth(x, 0));
  x := GetGraphPointX(Count - 1);
  Result.b.X := Max(Result.b.X, x + CalcBarWidth(x, Count - 1));
end;

procedure TBarSeries.GetLegendItems(AItems: TChartLegendItems);
begin
  AItems.Add(TLegendItemBrushRect.Create(BarBrush, Title));
end;

function TBarSeries.GetSeriesColor: TColor;
begin
  Result := FBarBrush.Color;
end;

procedure TBarSeries.SetBarBrush(Value: TBrush);
begin
  FBarBrush.Assign(Value);
end;

procedure TBarSeries.SetBarPen(Value:TPen);
begin
  FBarPen.Assign(Value);
end;

procedure TBarSeries.SetBarWidthPercent(Value: Integer);
begin
  if (Value < 1) or (Value > 100) then
    raise EBarError.Create('Wrong BarWidth Percent');
  FBarWidthPercent := Value;
end;

procedure TBarSeries.SetSeriesColor(AValue: TColor);
begin
  FBarBrush.Color := AValue;
end;

{ TPieSeries }

function TPieSeries.AddPie(Value: Double; Text: String; Color: TColor): Longint;
begin
  Result := AddXY(GetXMaxVal + 1, Value, Text, Color);
end;

procedure TPieSeries.AfterAdd;
begin
  // disable axis when we have TPie series
  ParentChart.LeftAxis.Visible := false;
  ParentChart.BottomAxis.Visible := false;
end;

procedure TPieSeries.Draw(ACanvas: TCanvas);
var
  labelWidths, labelHeights: TIntegerDynArray;
  labelTexts: TStringDynArray;

  procedure Measure(out ACenter: TPoint; out ARadius: Integer);
  const
    MARGIN = 8;
  var
    i: Integer;
  begin
    SetLength(labelWidths, Count);
    SetLength(labelHeights, Count);
    SetLength(labelTexts, Count);
    for i := 0 to Count - 1 do begin
      labelTexts[i] := FormattedMark(i);
      with Marks.MeasureLabel(ACanvas, labelTexts[i]) do begin
        labelWidths[i] := cx;
        labelHeights[i] := cy;
      end;
    end;

    with ParentChart do begin
      ACenter := CenterPoint(ClipRect);
      // Reserve space for labels.
      ARadius := Min(
        ClipRect.Right - ACenter.x - MaxIntValue(labelWidths),
        ClipRect.Bottom - ACenter.y - MaxIntValue(labelHeights));
    end;
    if Marks.IsMarkLabelsVisible then
      ARadius -= Marks.Distance;
    ARadius := Max(ARadius - MARGIN, 0);
    if Exploded then
      ARadius := Trunc(ARadius / (Max(Source.Extent.b.X, 0) + 1));
  end;

var
  i, radius: Integer;
  prevAngle: Double = 0;
  d, angleStep, sliceCenterAngle: Double;
  c, center: TPoint;
  sa, ca: Extended;
  prevLabelPoly: TPointArray = nil;
const
  RAD_TO_DEG16 = 360 * 16;
begin
  if IsEmpty then exit;

  Measure(center, radius);
  for i := 0 to Count - 1 do begin
    ACanvas.Pen.Color := clBlack;
    ACanvas.Pen.Style := psSolid;
    ACanvas.Brush.Style := bsSolid;
    ACanvas.Brush.Color := SliceColor(i);

    with Source[i]^ do begin
      angleStep := Y / Source.ValuesTotal * RAD_TO_DEG16;
      sliceCenterAngle := prevAngle + angleStep / 2;
      if Exploded and (X > 0) then
        c := LineEndPoint(center, sliceCenterAngle, radius * X)
      else
        c := center;
    end;
    ACanvas.RadialPie(
      c.x - radius, c.y - radius, c.x + radius, c.y + radius,
      round(prevAngle), round(angleStep));

    prevAngle += angleStep;

    if not Marks.IsMarkLabelsVisible then continue;

    // This is a crude approximation of label "radius", it may be improved.
    SinCos(DegToRad(sliceCenterAngle / 16), sa, ca);
    d := Max(Abs(labelWidths[i] * ca), Abs(labelHeights[i] * sa)) / 2;
    Marks.DrawLabel(
      ACanvas,
      LineEndPoint(c, sliceCenterAngle, radius),
      LineEndPoint(c, sliceCenterAngle, radius + Marks.Distance + d),
      labelTexts[i], prevLabelPoly);
  end;
end;

procedure TPieSeries.GetLegendItems(AItems: TChartLegendItems);
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    AItems.Add(TLegendItemColorRect.Create(SliceColor(i), FormattedMark(i)));
end;

procedure TPieSeries.SetExploded(const AValue: Boolean);
begin
  if FExploded = AValue then exit;
  FExploded := AValue;
  UpdateParentChart;
end;

function TPieSeries.SliceColor(AIndex: Integer): TColor;
begin
  Result :=
    ColorOrDefault(Source[AIndex]^.Color, Colors[AIndex mod High(Colors) + 1]);
end;

{ TAreaSeries }

constructor TAreaSeries.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAreaLinesPen := TPen.Create;
  FAreaLinesPen.OnChange := @StyleChanged;

  FAreaBrush := TBrush.Create;
  FAreaBrush.OnChange := @StyleChanged;
end;

destructor TAreaSeries.Destroy;
begin
  FreeAndNil(FAreaLinesPen);
  FreeAndNil(FAreaBrush);
  inherited;
end;

procedure TAreaSeries.Draw(ACanvas: TCanvas);
var
  pts: array [0..4] of TPoint;
  numPts: Integer;

  procedure PushPoint(const A: TPoint);
  begin
    pts[numPts] := A;
    Inc(numPts);
  end;

var
  i, ax, bx, ymin: Integer;
  a, b: TDoublePoint;
  ext, ext2: TDoubleRect;
  imageRect: TRect;
begin
  if Count = 0 then exit;

  ACanvas.Brush.Assign(AreaBrush);
  ACanvas.Pen.Assign(AreaLinesPen);

  ext := ParentChart.CurrentExtent;
  ext2 := ext;
  ExpandRange(ext2.a.X, ext2.b.X, 0.1);
  ExpandRange(ext2.a.Y, ext2.b.Y, 1.0);

  ymin := ParentChart.ClipRect.Bottom - 1;

  for i := 0 to Count - 2 do begin
    a := GetGraphPoint(i);
    b := GetGraphPoint(i + 1);
    if a.X > b.X then
      Exchange(a, b);
    if (a.X > ext.b.X) or (b.X < ext.a.X) then continue;
    if Stairs then begin
      if InvertedStairs then
        a.Y := b.Y
      else
        b.Y := a.Y;
    end;
    ax := ParentChart.XGraphToImage(Max(a.X, ext2.a.X));
    bx := ParentChart.XGraphToImage(Min(b.X, ext2.b.X));

    if LineIntersectsRect(a, b, ext2) then begin
      numPts := 0;
      PushPoint(Point(ax, ymin));
      if a.Y = ext2.b.Y then
        PushPoint(Point(ax, ParentChart.YGraphToImage(a.Y)));
      PushPoint(ParentChart.GraphToImage(a));
      PushPoint(ParentChart.GraphToImage(b));
      if b.Y = ext2.b.Y then
        PushPoint(Point(bx, ParentChart.YGraphToImage(b.Y)));
      PushPoint(Point(bx, ymin));
      ACanvas.Polygon(pts, false, 0, numPts);
    end
    else begin
      if a.Y > ext.b.Y then begin
        imageRect := Rect(ax, ParentChart.ClipRect.Top - 1, bx, ymin);
        NormalizeRect(imageRect);
        ACanvas.Rectangle(imageRect);
      end;
    end;
  end;
  DrawLabels(ACanvas);
end;

function TAreaSeries.GetLabelDirection(AIndex: Integer): TLabelDirection;
const
  DIR: array [Boolean] of TLabelDirection = (ldTop, ldRight);
begin
  Unused(AIndex);
  Result := DIR[IsRotated];
end;

procedure TAreaSeries.GetLegendItems(AItems: TChartLegendItems);
begin
  AItems.Add(TLegendItemBrushRect.Create(AreaBrush, Title));
end;

function TAreaSeries.GetSeriesColor: TColor;
begin
  Result := FAreaBrush.Color;
end;

procedure TAreaSeries.SetAreaBrush(Value: TBrush);
begin
  FAreaBrush.Assign(Value);
  UpdateParentChart;
end;

procedure TAreaSeries.SetInvertedStairs(Value: Boolean);
begin
  FInvertedStairs := Value;
  UpdateParentChart;
end;

procedure TAreaSeries.SetSeriesColor(AValue: TColor);
begin
  FAreaBrush.Color := AValue;
end;

procedure TAreaSeries.SetStairs(Value: Boolean);
begin
  FStairs := Value;
  UpdateParentChart;
end;

{ TFuncSeries }

constructor TFuncSeries.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FExtent := TChartExtent.Create(FChart);
  FDomainExclusions := TIntervalList.Create;
  FDomainExclusions.OnChange := @StyleChanged;
  FPen := TChartPen.Create;
  FPen.OnChange := @StyleChanged;
  FStep := 2;
end;

destructor TFuncSeries.Destroy;
begin
  FreeAndNil(FExtent);
  FreeAndNil(FDomainExclusions);
  FreeAndNil(FPen);
  inherited;
end;

procedure TFuncSeries.Draw(ACanvas: TCanvas);
var
  ygMin, ygMax: Double;

  function CalcY(AXg: Double): Integer;
  var
    yg: Double;
  begin
    OnCalculate(AXg, yg);
    Result := FChart.YGraphToImage(EnsureRange(AxisToGraphY(yg), ygMin, ygMax));
  end;

var
  x, xmax, hint: Integer;
  xg, xg1: Double;
begin
  if not Assigned(OnCalculate) then exit;

  x := FChart.ClipRect.Left;
  if Extent.UseXMin then
    x := Max(FChart.XGraphToImage(Extent.XMin), x);
  xmax := FChart.ClipRect.Right;
  if Extent.UseXMax then
    xmax := Min(FChart.XGraphToImage(Extent.XMax), xmax);

  ygMin := FChart.CurrentExtent.a.Y;
  if Extent.UseYMin and (ygMin < Extent.YMin) then
    ygMin := Extent.YMin;
  ygMax := FChart.CurrentExtent.b.Y;
  if Extent.UseYMax and (ygMax < Extent.YMax) then
    ygMax := Extent.YMax;
  ExpandRange(ygMin, ygMax, 1);

  hint := 0;
  xg := FChart.XImageToGraph(x);
  if DomainExclusions.Intersect(xg, xg, hint) then
    x := FChart.XGraphToImage(xg);
  ACanvas.MoveTo(x, CalcY(xg));

  ACanvas.Pen.Assign(Pen);
  while x < xmax do begin
    Inc(x, FStep);
    xg1 := FChart.XImageToGraph(x);
    if DomainExclusions.Intersect(xg, xg1, hint) then begin
      ACanvas.LineTo(FChart.XGraphToImage(xg), CalcY(xg));
      x := FChart.XGraphToImage(xg1);
      ACanvas.MoveTo(x, CalcY(xg1));
    end
    else
      ACanvas.LineTo(x, CalcY(xg1));
    xg := xg1;
  end;
end;

procedure TFuncSeries.GetBounds(var ABounds: TDoubleRect);
begin
  with Extent do begin
    if UseXMin then ABounds.a.X := XMin;
    if UseYMin then ABounds.a.Y := YMin;
    if UseXMax then ABounds.b.X := XMax;
    if UseYMax then ABounds.b.Y := YMax;
  end;
end;

procedure TFuncSeries.GetLegendItems(AItems: TChartLegendItems);
begin
  AItems.Add(TLegendItemLine.Create(Pen, Title));
end;

function TFuncSeries.IsEmpty: Boolean;
begin
  Result := not Assigned(OnCalculate);
end;

procedure TFuncSeries.SetExtent(const AValue: TChartExtent);
begin
  if FExtent = AValue then exit;
  FExtent.Assign(AValue);
  UpdateParentChart;
end;

procedure TFuncSeries.SetOnCalculate(const AValue: TFuncCalculateEvent);
begin
  if TMethod(FOnCalculate) = TMethod(AValue) then exit;
  FOnCalculate := AValue;
  UpdateParentChart;
end;

procedure TFuncSeries.SetPen(const AValue: TChartPen);
begin
  if FPen = AValue then exit;
  FPen.Assign(AValue);
  UpdateParentChart;
end;

procedure TFuncSeries.SetStep(AValue: TFuncSeriesStep);
begin
  if FStep = AValue then exit;
  FStep := AValue;
  UpdateParentChart;
end;

{ TUserDrawnSeries }

procedure TUserDrawnSeries.Draw(ACanvas: TCanvas);
begin
  if Assigned(FOnDraw) then
     FOnDraw(ACanvas, FChart.ClipRect);
end;

procedure TUserDrawnSeries.GetBounds(var ABounds: TDoubleRect);
begin
  if Assigned(FOnGetBounds) then
    FOnGetBounds(ABounds);
end;

procedure TUserDrawnSeries.GetLegendItems(AItems: TChartLegendItems);
begin
  Unused(AItems);
end;

function TUserDrawnSeries.IsEmpty: Boolean;
begin
  Result := not Assigned(FOnDraw);
end;

procedure TUserDrawnSeries.SetOnDraw(AValue: TSeriesDrawEvent);
begin
  if TMethod(FOnDraw) = TMethod(AValue) then exit;
  FOnDraw := AValue;
  UpdateParentChart;
end;

procedure TUserDrawnSeries.SetOnGetBounds(AValue: TSeriesGetBoundsEvent);
begin
  if TMethod(FOnGetBounds) = TMethod(AValue) then exit;
  FOnGetBounds := AValue;
  UpdateParentChart;
end;

initialization
  RegisterSeriesClass(TLineSeries, 'Line series');
  RegisterSeriesClass(TAreaSeries, 'Area series');
  RegisterSeriesClass(TBarSeries, 'Bar series');
  RegisterSeriesClass(TPieSeries, 'Pie series');
  RegisterSeriesClass(TFuncSeries, 'Function series');
  RegisterSeriesClass(TUserDrawnSeries, 'User-drawn series');
  RegisterSeriesClass(TConstantLine, 'Constant line');
  {$WARNINGS OFF}RegisterSeriesClass(TLine, '');{$WARNINGS ON}
  RegisterPropertyEditor(
    TypeInfo(Boolean), TLineSeries, 'ShowLines', THiddenPropertyEditor);

end.