{************************************************************}
{                                                            }
{ Unit Name: TeeFunnel                                       }
{ Purpose  : The Funnel or Pipeline Series                   }
{ Author   : Marjan Slatinek                                 }
{ History  : v1.0 (Requires TeeChart v5 or later)            }
{          : v1.5 (Ported to VCL/FMX by Steema Software)     }
{                                                            }
{ Copyright (c) 2003-2020 by Marjan Slatinek                 }
{ All Rights Reserved                                        }
{************************************************************}
unit TeeFunnel;
{$I TeeDefs.inc}

interface

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

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

     {$IFDEF FMX}
     FMX.Types,

     {$IFDEF D19}
     FMX.Graphics,
     {$ENDIF}

     {$IFDEF D17}
     System.UIConsts,
     {$ENDIF}

     {$ELSE}
     Graphics,
     {$ENDIF}

     Classes, SysUtils,

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

type
  TFunnelSeries = class(TChartSeries)
  private
    FAboveColor   : TColor;
    FAutoUpdate   : Boolean;
    FBelowColor   : TColor;
    FDifferenceLimit: Double;
    FLinesPen     : TChartPen;
    FOpportunityValues: TChartValueList;
    FQuotesSorted : Boolean;
    FWithinColor  : TColor;

    { internal }
    IOldAxisVisible : Boolean;
    IPolyPoints   : Array of TPoint;
    ISorted : Boolean;
    IMin    : Double;
    IMax    : Double;
    ISlope  : Double;
    IDiff   : Double;
    BoundingPoints: Array[0..3] of TPoint;

    function DefineFunnelRegion(ValueIndex: Integer): TColor;
    function GetQuoteValues: TChartValueList; virtual;
    procedure SetAboveColor(const Value: TColor);
    procedure SetAutoUpdate(const Value: boolean);
    procedure SetBelowColor(const Value: TColor);
    procedure SetDifferenceLimit(const Value: double);
    procedure SetLinesPen(const Value: TChartPen);
    procedure SetOpportunityValues(const Value: TChartValueList);
    procedure SetQuotesSorted(const Value: boolean);
    procedure SetQuoteValues(const Value: TChartValueList); virtual;
    procedure SetWithinColor(const Value: TColor);
  protected
    procedure AddSampleValues(NumValues:Integer; OnlyMandatory:Boolean=False); override;
    procedure DoBeforeDrawChart; override;
    procedure DrawAllValues; override;
    Procedure DrawMark( ValueIndex:Integer; Const St:String;
                                       APosition:TSeriesMarkPosition); override;
    procedure DrawValue(ValueIndex: Integer); override;
    class Function GetEditorClass:String; override;
    procedure GetMarkText(Sender: TChartSeries; ValueIndex: Integer;
                          var MarkText: String);
    Procedure SetActive(Value:Boolean); override;
    Procedure SetParentChart(Const Value:TCustomAxisPanel); override;
  public
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;

    function AddSegment(Const AQuote, AOpportunity: Double;
                        Const ALabel: String; AColor: TColor=clTeeColor): Integer;
    function Clicked(X,Y:Integer):Integer; override;
    Function CountLegendItems:Integer; override;
    Function LegendItemColor(LegendIndex:Integer):TColor; override;
    Function LegendString( LegendIndex:Integer;
                           LegendTextStyle:TLegendTextStyle ):String; override;
    Function MaxXValue:TChartValue; override;
    Function MinXValue:TChartValue; override;
    Function MinYValue:TChartValue; override;
    procedure Recalc;
  published
    property Brush;
    property Pen;
    property AboveColor: TColor read FAboveColor write SetAboveColor default {$IFDEF FMX}claGreen{$ELSE}clGreen{$ENDIF};
    property AutoUpdate: boolean read FAutoUpdate write SetAutoUpdate default True;
    property BelowColor : TColor read FBelowColor write SetBelowColor default {$IFDEF FMX}claRed{$ELSE}clRed{$ENDIF};
    property DifferenceLimit : Double read FDifferenceLimit write SetDifferenceLimit;
    property LinesPen:TChartPen read FLinesPen write SetLinesPen;
    property OpportunityValues: TChartValueList read FOpportunityValues write SetOpportunityValues;
    property QuotesSorted : Boolean read FQuotesSorted write SetQuotesSorted default False;
    property QuoteValues: TChartValueList read GetQuoteValues write SetQuoteValues;
    property WithinColor : TColor read FWithinColor write SetWithinColor default {$IFDEF FMX}claYellow{$ELSE}clYellow{$ENDIF};
  end;

implementation

Uses {$IFDEF D6}
     Types,
     {$ENDIF}
     {$IFDEF FMX}
     FMXTee.Procs, FMXTee.Constants, FMXTee.ProConstants
     {$ELSE}
     TeeProcs, TeeProCo, TeeConst
     {$ENDIF};

{ TFunnelSeries }
Constructor TFunnelSeries.Create(AOwner: TComponent);
begin
  inherited;

  FOpportunityValues := TChartValueList.Create(Self,TeeMsg_OpportunityValues);
  Self.XValues.Name := '';
  Self.XValues.Order := loNone;

  PercentFormat:=TeeMsg_FunnelPercent;

  FOpportunityValues.Order := loNone;
  Self.QuoteValues.Order := loDescending;
  Self.YValues.Name := TeeMsg_QuoteValues;
  FAutoUpdate := True;

  FDifferenceLimit := 30.0;
  FAboveColor := {$IFDEF FMX}claGreen{$ELSE}clGreen{$ENDIF};
  FWithinColor := {$IFDEF FMX}claYellow{$ELSE}clYellow{$ENDIF};
  FBelowColor := {$IFDEF FMX}claRed{$ELSE}clRed{$ENDIF};
  OnGetMarkText := GetMarkText;
  FLinesPen:=CreateChartPen;
  IUseSeriesColor:=False;
end;

Destructor TFunnelSeries.Destroy;
begin
  FLinesPen.Free;
  IPolyPoints:=nil;
  inherited;
end;

function TFunnelSeries.AddSegment(const AQuote, AOpportunity: Double;
  const ALabel: String; AColor: TColor): Integer;
begin
  FOpportunityValues.TempValue := AOpportunity;

  Result := Add(AQuote,ALabel,AColor);

  if Not FQuotesSorted then
  begin
    YValues.Sort;
    XVAlues.FillSequence;
    ISorted := true;
  end;
end;

function TFunnelSeries.GetQuoteValues: TChartValueList;
begin
  Result := MandatoryValueList;
end;

procedure TFunnelSeries.Recalc;
begin
  if not ISorted then
  begin
    QuoteValues.Sort;
    XValues.FillSequence;
    ISorted := True;
  end;

  if Count>0 then
  begin
    IMax := QuoteValues.First;
    IMin := QuoteValues.Last;
    ISlope := 0.5*(IMax-IMin) / Count;
  end
  else
    ISlope:=0;
end;

procedure TFunnelSeries.SetAutoUpdate(const Value: boolean);
begin
  FAutoUpdate := Value;
  if FAutoUpdate then Recalc;
end;

procedure TFunnelSeries.SetQuoteValues(const Value: TChartValueList);
begin
  SetYValues(Value); { overrides the default YValues }
end;

procedure TFunnelSeries.SetQuotesSorted(const Value: boolean);
begin
  FQuotesSorted := Value;
  ISorted := FQuotesSorted;
end;

procedure TFunnelSeries.SetOpportunityValues(const Value: TChartValueList);
begin
  SetChartValueList(FOpportunityValues,Value); { standard method }
end;

procedure TFunnelSeries.DrawValue(ValueIndex: Integer);
begin
  With ParentChart.Canvas do
  begin
    AssignBrush(Self.Brush,DefineFunnelRegion(ValueIndex));

    if ParentChart.View3D then PolygonWithZ(IPolyPoints,StartZ)
                          else Polygon(IPolyPoints);
  end
end;

procedure TFunnelSeries.DrawAllValues;

  procedure DrawVertLine(ValueIndex: Integer);
  var tmpX : Integer;
  begin
    tmpX:=CalcXPosValue(ValueIndex + 0.5);
    With ParentChart.Canvas do
      if ParentChart.View3D then
         VertLine3D(tmpX,CalcYPosValue(IMax - ISlope*(ValueIndex+1)),
                         CalcYPosValue(ISlope*(ValueIndex+1)),StartZ)
      else
         DoVertLine(tmpX,CalcYPosValue(IMax - ISlope*(ValueIndex+1)),
                         CalcYPosValue(ISlope*(ValueIndex+1)));
  end;

var t : Integer;
begin
  inherited;

  With ParentChart.Canvas do
  begin
    AssignVisiblePen(Self.Pen);

    Brush.Style := bsClear;
    BoundingPoints[0] := TeePoint(CalcXPosValue(-0.5),CalcYPosValue(IMax));
    BoundingPoints[1] := TeePoint(CalcXPosValue(Count-0.5), CalcYPosValue((IMax+IMin)*0.5));
    BoundingPoints[2] := TeePoint(BoundingPoints[1].x, CalcYPosValue((IMax-IMin)*0.5));
    BoundingPoints[3] := TeePoint(BoundingPoints[0].x, CalcYPosValue(0.0));

    if ParentChart.View3D then PolygonWithZ(BoundingPoints,StartZ)
                          else Polygon(BoundingPoints);

    if Self.LinesPen.Visible then
    begin
      AssignVisiblePen(Self.LinesPen);

      for t:=FirstValueIndex to LastValueIndex-1 do
          DrawVertLine(t);
    end;
  end;
end;

function TFunnelSeries.MinYValue: TChartValue;
begin
  Result := 0;
end;

function TFunnelSeries.MaxXValue: TChartValue;
begin
  Result := Count -0.5;
end;

function TFunnelSeries.MinXValue: TChartValue;
begin
  Result := -0.5;
end;

procedure TFunnelSeries.SetDifferenceLimit(const Value: double);
begin
  if FDifferenceLimit<>Value then
  begin
    FDifferenceLimit:=Value;

    if FAutoUpdate then
       Recalc;

    Repaint;
  end;
end;

procedure TFunnelSeries.SetAboveColor(const Value: TColor);
begin
  SetColorProperty(FAboveColor,Value);
end;

procedure TFunnelSeries.SetBelowColor(const Value: TColor);
begin
  SetColorProperty(FBelowColor,Value);
end;

procedure TFunnelSeries.SetWithinColor(const Value: TColor);
begin
  SetColorProperty(FWithinColor,Value);
end;

procedure TFunnelSeries.GetMarkText(Sender: TChartSeries;
  ValueIndex: Integer; var MarkText: String);
begin
  MarkText := FormatFloat(PercentFormat,
       100*FOpportunityValues.Value[ValueIndex]/QuoteValues.Value[ValueIndex]);
end;

procedure TFunnelSeries.DrawMark(ValueIndex: Integer; const St: String;
  APosition: TSeriesMarkPosition);
begin
  APosition.LeftTop := TeePoint(CalcXPosValue(ValueIndex)-APosition.Width div 2,
                             CalcYPosValue(IMax*0.5)-APosition.Height div 2);
  inherited;
end;

function TFunnelSeries.DefineFunnelRegion(ValueIndex: Integer): TColor;
var tmpX, tmpY : Integer;
begin
   { Calculate multiplying factor }

   if QuoteValues.Value[ValueIndex]=0 then
      IDiff:=0
   else
      IDiff := FOpportunityValues.Value[ValueIndex]/QuoteValues.Value[ValueIndex];


   { calculate bouding rectangle }
   BoundingPoints[0] := TeePoint(CalcXPosValue(ValueIndex-0.5),CalcYPosValue(IMax - ISlope*ValueIndex));
   BoundingPoints[1] := TeePoint(CalcXPosValue(ValueIndex+0.5),CalcYPosValue(IMax - ISlope*(ValueIndex+1)));
   BoundingPoints[2] := TeePoint(BoundingPoints[1].x,CalcYPosValue(ISlope*(ValueIndex+1)));
   BoundingPoints[3] := TeePoint(BoundingPoints[0].x,CalcYPosValue(ISlope*ValueIndex));

   tmpY := CalcYPosValue((IMax - 2*ISlope*ValueIndex)*IDiff+ISlope*ValueIndex); { Actual value, expressed in axis scale }

   if tmpY <= BoundingPoints[0].Y then { IDiff >= 1 }
   begin
     SetLength(IPolyPoints,4);

     IPolyPoints[0] := BoundingPoints[0];
     IPolyPoints[1] := BoundingPoints[1];
     IPolyPoints[2] := BoundingPoints[2];
     IPolyPoints[3] := BoundingPoints[3];
   end
   else
   if (tmpY > BoundingPoints[0].Y) and (tmpY <= BoundingPoints[1].Y) then
   begin
     SetLength(IPolyPoints,5);

     IPolyPoints[0] := TeePoint(BoundingPoints[0].x,tmpY);
     tmpX := CalcXPosValue((IMax - 2*ISlope*ValueIndex)*(1-IDiff)/ISlope + ValueIndex - 0.5);

     IPolyPoints[1] := TeePoint(tmpX,tmpY);
     IPolyPoints[2] := BoundingPoints[1];
     IPolyPoints[3] := BoundingPoints[2];
     IPolyPoints[4] := BoundingPoints[3];
   end
   else
   if tmpY > BoundingPoints[2].y then
   begin
     SetLength(IPolyPoints,3);
     IPolyPoints[0] := TeePoint(BoundingPoints[0].x,tmpY);

     tmpX := CalcXPosValue((IMax - 2*ISlope*ValueIndex)*IDiff /ISlope + ValueIndex-0.5);
     IPolyPoints[1] := TeePoint(tmpX,tmpY);
     IPolyPoints[2] := BoundingPoints[3];
   end
   else
   begin
     SetLength(IPolyPoints,4);

     IPolyPoints[0] := TeePoint(BoundingPoints[0].x, tmpY);
     IPolyPoints[1] := TeePoint(BoundingPoints[1].x, tmpY);
     IPolyPoints[2] := BoundingPoints[2];
     IPolyPoints[3] := BoundingPoints[3];
   end;

   if IDiff >= 1 then
      Result := FAboveColor
   else
   if (1-IDiff)*100 > FDifferenceLimit then
      Result := FBelowColor
   else
      Result := FWithinColor;
end;

function TFunnelSeries.Clicked(X, Y: Integer): Integer;
var t : Integer;
begin
  Result := inherited Clicked(X,Y);

  if (result=-1) and (FirstValueIndex>-1) and (LastValueIndex>-1) then
  for t := FirstValueIndex to LastValueIndex do
  begin
    DefineFunnelRegion(t);

    if PointInPolygon(TeePoint(X,Y),IPolyPoints) then
    begin
      Result := t;
      break;
    end
  end;
end;

procedure TFunnelSeries.AddSampleValues(NumValues: Integer; OnlyMandatory:Boolean=False);
var t: Integer;
begin
  for t := 0 to NumValues - 1 do
      AddSegment(2.3*NumValues*(t+1),(2.3-RandomValue(2))*NumValues*(t+2),
                 TeeMsg_FunnelSegment+TeeStr(t+1));
  Recalc;
end;

procedure TFunnelSeries.DoBeforeDrawChart;
begin
  inherited;

  if Visible and Assigned(GetVertAxis) then
     GetVertAxis.Visible:=False;

  if ISlope=0 then
     if FAutoUpdate then
        Recalc;
end;

function TFunnelSeries.CountLegendItems: Integer;
begin
  result:=3;
end;

function TFunnelSeries.LegendItemColor(LegendIndex: Integer): TColor;
begin
  Case LegendIndex of
    0: result:=AboveColor;
    1: result:=WithinColor;
  else
    result:=BelowColor;
  end;
end;

function TFunnelSeries.LegendString(LegendIndex: Integer;
  LegendTextStyle: TLegendTextStyle): String;
begin
  Case LegendIndex of
    0: result:=TeeMsg_FunnelExceed;
    1: result:=FormatFloat(PercentFormat,DifferenceLimit)+ TeeMsg_FunnelWithin;
  else
    result:=FormatFloat(PercentFormat,DifferenceLimit)+ TeeMsg_FunnelBelow;
  end;
end;

class function TFunnelSeries.GetEditorClass: String;
begin
  result:='TFunnelSeriesEditor'; // Do not localize
end;

procedure TFunnelSeries.SetLinesPen(const Value: TChartPen);
begin
  FLinesPen.Assign(Value);
end;

procedure TFunnelSeries.SetParentChart(const Value: TCustomAxisPanel);
begin
  if not Assigned(Value) then
     if Assigned(GetVertAxis) then
        GetVertAxis.Visible:=IOldAxisVisible;

  inherited;

  if Assigned(ParentChart) then
     IOldAxisVisible:=(GetVertAxis=nil) or GetVertAxis.Visible
end;

procedure TFunnelSeries.SetActive(Value: Boolean);
begin
  if not Value then
     if Assigned(GetVertAxis) then
        GetVertAxis.Visible:=IOldAxisVisible;

  inherited;
end;

initialization
  RegisterTeeSeries(TFunnelSeries, @TeeMsg_FunnelSeries,
                                   @TeeMsg_GalleryStats,1);
finalization
  UnRegisterTeeSeries([TFunnelSeries]);
end.
