{*********************************************}
{  TeeChart Pro                               }
{  TPyramid Series                            }
{                                             }
{  Copyright (c) 1996-2020 by Steema Software }
{        All Rights Reserved                  }
{*********************************************}
unit TeePyramid;
{$I TeeDefs.inc}

interface

Uses
  {$IFNDEF LINUX}
  {$IFNDEF FMX}
  Windows,
  {$ENDIF}
  {$ENDIF}
  Classes,

  {$IFDEF D9}
  Types,
  {$ENDIF}

  {$IFDEF D16}
  System.UITypes,
  {$ENDIF}

  {$IFDEF FMX}
  FMX.Types,
  {$ELSE}
  Graphics,
  {$ENDIF}

  {$IFDEF FMX}
  FMXTee.Engine, FMXTee.Canvas
  {$ELSE}
  TeEngine, TeCanvas
  {$ENDIF};

type
  TPyramidSeries=class(TChartSeries)
  private
    FSize : Integer;

    Function AcumUpTo(UpToIndex:Integer):Double;
    procedure SetSize(const Value: Integer);
  protected
    Procedure CalcHorizMargins(Var LeftMargin,RightMargin:Integer); override;
    function CalcSector(ValueIndex:Integer; out tmpZ,tmpX,tmpZ2:Single):TRectF;
    Procedure CalcZOrder; override;
    Procedure DrawLegendShape(ValueIndex:Integer; Const Rect:TRect); override;
    class Function GetEditorClass:String; override;
    Procedure DrawAllValues; override;
    Procedure DrawMark( ValueIndex:Integer; Const St:String;
                        APosition:TSeriesMarkPosition); override;
    function DrawSeriesAscending:Boolean; override;
    Procedure DrawValue(ValueIndex:Integer); override;
    function InvertedLegend:Boolean; override;
    Function MoreSameZOrder:Boolean; override;
  public
    Constructor Create(AOwner:TComponent); override;

    Function Clicked(x,y:Integer):Integer; override; // TV52010045
    Function DrawValuesForward:Boolean; override;
    Function CalcXPos(ValueIndex:Integer):Integer; override;
    Function MaxXValue:TChartValue; override;
    Function MinXValue:TChartValue; override;
    Function MaxYValue:TChartValue; override;
    Function MinYValue:TChartValue; override;
  published
    property Active;
    property Brush;
    property ColorEachPoint default True;
    property ColorSource;
    property Cursor;
    property Depth;
    property HorizAxis;
    property Marks;
    property ParentChart;
    property DataSource;
    property Pen;
    property PercentFormat;
    property SeriesColor;
    property ShowInLegend;
    property SizePercent:Integer read FSize write SetSize default 50;
    property Title;
    property ValueFormat;
    property VertAxis;
    property XLabelsSource;
    property XValues;
    property YValues;

    { events }
    property AfterDrawValues;
    property BeforeDrawValues;
    property OnAfterAdd;
    property OnBeforeAdd;
    property OnClearValues;
    property OnClick;
    property OnDblClick;
    property OnGetMarkText;
    property OnMouseEnter;
    property OnMouseLeave;
  end;

implementation

Uses
  {$IFDEF FMX}
  FMXTee.Chart, FMXTee.Constants, FMXTee.ProConstants
  {$ELSE}
  Chart, TeeConst, TeeProCo
  {$ENDIF}
  ;

{ TPyramidSeries }
constructor TPyramidSeries.Create(AOwner: TComponent);
begin
  inherited;
  CalcVisiblePoints:=False;
  ColorEachPoint:=True;
  FSize:=50;
end;

procedure TPyramidSeries.CalcHorizMargins(var LeftMargin,
  RightMargin: Integer);
begin
  LeftMargin:=20;
  RightMargin:=20;
end;

Function TPyramidSeries.AcumUpTo(UpToIndex:Integer):Double;
var t : Integer;
begin
  result:=0;
  for t:=0 to UpToIndex do result:=result+MandatoryValueList.Value[t];
end;

function TPyramidSeries.CalcSector(ValueIndex:Integer; out tmpZ,tmpX,tmpZ2:Single):TRectF;
var tmp,
    tmpTrunc,
    tmpTruncZ,
    tmpSize   : Single;
begin
  tmp:=AcumUpTo(ValueIndex-1);
  tmpTrunc:=100.0-(tmp*100.0/MandatoryValueList.Total);

  tmpSize:=SizePercent*GetHorizAxis.CalcSizeValue(1)*0.005;

  tmpX:=tmpTrunc*tmpSize*0.01;
  result.Left:=GetHorizAxis.CalcPosValue(SeriesIndex)-tmpX;
  result.Right:=result.Left+2*tmpX;

  tmpTruncZ:=100.0-tmpTrunc;
  if tmpTruncZ>0 then tmpZ:=tmpTruncZ*(EndZ-StartZ)*0.005
                 else tmpZ:=0;

  result.Bottom:=GetVertAxis.CalcPosValue(tmp);

  tmp:=tmp+MandatoryValueList.Value[ValueIndex];
  result.Top:=GetVertAxis.CalcPosValue(tmp);

  tmpTrunc:=100.0-(tmp*100.0/MandatoryValueList.Total);

  if tmpTrunc<100 then tmpZ2:=tmpTrunc*(EndZ-StartZ)*0.005
                  else tmpZ2:=0;

  tmpX:=tmpTrunc*tmpSize*0.01;
end;

Procedure TPyramidSeries.DrawAllValues;
var tmpBlend : TTeeBlend;
    tmpTransp: Boolean;
begin
  tmpTransp:=(Transparency>0) and ParentChart.Canvas.SupportsAlpha;

  if tmpTransp then
     tmpBlend:=ParentChart.Canvas.BeginBlending(TeeZeroRect,Transparency)
  else
     tmpBlend:=nil;

  inherited;

  if tmpTransp then
     ParentChart.Canvas.EndBlending(tmpBlend);
end;

function TPyramidSeries.InvertedLegend:Boolean;
begin
  result:=not GetVertAxis.Inverted;
end;

function TPyramidSeries.DrawSeriesAscending:Boolean;
begin
  result:=GetVertAxis.Inverted;
end;

procedure TPyramidSeries.DrawValue(ValueIndex: Integer);
var R     : TRectF;
    tmpZ,
    tmpX,
    tmpZ2 : Single;
    tmpBottom,
    tmpCovers : Boolean;
begin
  if not IsNull(ValueIndex) then
  begin
    ParentChart.SetBrushCanvas(ValueColor[ValueIndex],Brush,Brush.Color);

    if not PrepareHoverPen(ValueIndex) then
       ParentChart.Canvas.AssignVisiblePen(Pen);

    R:=CalcSector(ValueIndex,tmpZ,tmpX,tmpZ2);

    // Draw covers only for last bottom point, or when previous/next point is null,
    // or we have transparency:

    tmpCovers:=ParentChart.View3D;

    tmpBottom:=((ValueIndex>0) and IsNull(ValueIndex-1)) or (ValueIndex=0);

    ParentChart.Canvas.PyramidTrunc(R,StartZ+tmpZ,EndZ-tmpZ,tmpX,tmpZ2,
            tmpCovers and (ValueIndex<Count-1) and IsNull(ValueIndex+1),
            tmpCovers and ( (Transparency>0) or tmpBottom ));
  end;
end;

Procedure TPyramidSeries.CalcZOrder;
begin
//  inherited;  <-- do not call inherited here ! TV520100404
  IZOrder:=-1;
end;

Function TPyramidSeries.CalcXPos(ValueIndex:Integer):Integer;
begin
  result:=GetHorizAxis.CalcPosValue(SeriesIndex);
end;

function TPyramidSeries.MaxXValue: TChartValue;
begin
  result:=SeriesIndex+0.5;
end;

function TPyramidSeries.MaxYValue: TChartValue;
begin
  result:=MandatoryValueList.TotalABS
end;

function TPyramidSeries.MinXValue: TChartValue;
begin
  result:=SeriesIndex-0.5;
end;

function TPyramidSeries.MinYValue: TChartValue;
begin
  result:=0;
end;

procedure TPyramidSeries.SetSize(const Value: Integer);
begin
  SetIntegerProperty(FSize,Value);
end;

class function TPyramidSeries.GetEditorClass: String;
begin
  result:='TPyramidSeriesEditor';
end;

procedure TPyramidSeries.DrawMark(ValueIndex: Integer; const St: String;
  APosition: TSeriesMarkPosition);
begin
  APosition.LeftTop.Y:=GetVertAxis.CalcPosValue(AcumUpTo(ValueIndex));
  inherited;
end;

function TPyramidSeries.DrawValuesForward: Boolean;
begin
  result:=not GetVertAxis.Inverted;
end;

function TPyramidSeries.Clicked(x, y: Integer): Integer;
var t : Integer;
    tmpZ,
    tmpX,
    tmpZ2 : Single;
begin
  for t:=0 to Count-1 do
  if (not IsNull(t)) and PointInRect(CalcSector(t,tmpZ,tmpX,tmpZ2),x,y) then
  begin
    result:=t;
    exit;
  end;

  result:=TeeNoPointClicked;
end;

procedure TPyramidSeries.DrawLegendShape(ValueIndex: Integer;
  const Rect: TRect);
var P : TTrianglePoints;
begin
  P[0]:=TeePoint(Rect.Left,Rect.Bottom);
  P[1]:=TeePoint((Rect.Left+Rect.Right) {$IFDEF FMX}*0.5{$ELSE}div 2{$ENDIF},Rect.Top);
  P[2]:=TeePoint(Rect.Right,Rect.Bottom);

  ParentChart.Canvas.Polygon(P);
end;

function TPyramidSeries.MoreSameZOrder: Boolean;
begin
  result:=False; // Do not paint interleaved pyramids (when having more than one Pyramid Series)
end;

initialization
  RegisterTeeSeries(TPyramidSeries,
           @TeeMsg_GalleryPyramid,
           @TeeMsg_GalleryExtended,2);
finalization
  UnRegisterTeeSeries([TPyramidSeries]);
end.
