{********************************************}
{ TSeriesTool Editor Dialog                  }
{ Copyright (c) 2012-2020 by Steema Software }
{********************************************}
unit TeeFibonacci;
{$I TeeDefs.inc}

interface

uses
  {$IFNDEF LINUX}
  {$IFNDEF FMX}
  Windows, Messages,
  {$ENDIF}
  {$ENDIF}
  SysUtils, Classes,
  {$IFDEF D6}
  Types,
  {$ENDIF}

  {$IFDEF FMX}
  System.UITypes, FMX.Types,
  {$IFDEF D17}
  System.UIConsts,
  {$ENDIF}
  {$ELSE}

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

  Graphics,
  {$ENDIF}

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

type
  TFibonacciStyle=(fsArc, fsFan, fsRetracement);

  TFibonacciTool=class;

  TFibonacciItem=class(TCollectionItem)
  private
    FPen   : TChartPen;
    FValue : TChartValue;

    ITool  : TFibonacciTool;

    procedure SetPen(const Value: TChartPen);
    procedure SetValue(const Value: TChartValue);
  public
    Constructor Create(Collection:TCollection); override;
    Destructor Destroy; override;

    procedure Assign(Source:TPersistent); override;
  published
    property Pen:TChartPen read FPen write SetPen;
    property Value:TChartValue read FValue write SetValue;
  end;

  TFibonacciLevels=class(TOwnedCollection)
  private
    ITool : TFibonacciTool;

    function Get(Index: Integer): TFibonacciItem;
    procedure Put(Index: Integer; const Value: TFibonacciItem);
  public
    property Level[Index:Integer]:TFibonacciItem read Get write Put; default;
  end;

  // Fibonacci fans and arcs financial tool. Tool supports Fibonacci arcs and
  // fans.
  //
  // Fibonacci arcs are charting technique consisting of three curved lines that
  // are drawn for the purpose of anticipating key support, resistance levels
  // and areas of ranging.
  // Fibonacci arcs are created by first drawing an invisible trendline between
  // two points  (usually the high and low in a given period), and then by
  // drawing three curves that intersect this trendline at the key Fibonacci
  // levels of 38.2%, 50% and 61.8%.
  //
  // Fibonacci fans are charting technique consisting of three diagonal lines
  // that use Fibonacci ratios to help identify key levels of support and
  // resistance.
  // Fibonacci fans are created by first drawing a trendline through two points
  // (usually the high and low in a given period), and then by dividing the
  // vertical distance between the two points by the key Fibonacci ratios of
  // 38.2%, 50% and 61.8%. The result of these divisions each represent a point
  // within the vertical distance. The three 'fan' lines are then created by
  // drawing a line from the leftmost point to each of the three representing
  // a Fibonacci ratio.

  TFibonacciTool=class(TTeeCustomToolSeries)
  private
    FDrawStyle  : TFibonacciStyle;
    FEndX       : Double;
    FEndY       : Double;
    FLabelsAngle: Integer;
    FLabelFont  : TTeeFont;
    FLevels     : TFibonacciLevels;
    FShowLabels : Boolean;
    FStartX     : Double;
    FStartY     : Double;
    FTrendPen   : TChartPen;

    IDefaultFab : TDoubleArray;
    ISp         : TPoint;

    procedure ClipDrawingRegion;
    procedure SetDrawStyle(const Value: TFibonacciStyle);
    procedure SetEndX(const Value: Double);
    procedure SetEndY(const Value: Double);
    procedure SetLabelsAngle(const Value: Integer);
    procedure SetLabelsFont(const Value: TTeeFont);
    procedure SetShowLabels(const Value: Boolean);
    procedure SetStartX(const Value: Double);
    procedure SetStartY(const Value: Double);
    procedure SetTrendPen(const Value: TChartPen);
    procedure SetLevels(const Value: TFibonacciLevels);
  protected
    Procedure ChartEvent(AEvent:TChartToolEvent); override;
    procedure DrawLevel(Index:Integer);
    class Function GetEditorClass:String; override;
  public
    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    Procedure Assign(Source:TPersistent); override;

    function AxisPoint(const X,Y:Double):TPoint;
    procedure CreateDefaultLevels;
    class Function Description:String; override;
    class Function LongDescription:String; override;
    function Radius:Double;
  published
    property Active;
    property DrawStyle:TFibonacciStyle read FDrawStyle write SetDrawStyle default fsArc;
    property EndX:Double read FEndX write SetEndX;
    property EndY:Double read FEndY write SetEndY;
    property LabelsAngle:Integer read FLabelsAngle write SetLabelsAngle default 90;
    property LabelsFont:TTeeFont read FLabelFont write SetLabelsFont;
    property Levels:TFibonacciLevels read FLevels write SetLevels;
    property Pen;
    property Series;
    property ShowLabels:Boolean read FShowLabels write SetShowLabels default True;
    property StartX:Double read FStartX write SetStartX;
    property StartY:Double read FStartY write SetStartY;
    property TrendPen:TChartPen read FTrendPen write SetTrendPen;
  end;

implementation

uses
  {$IFDEF FMX}
  FMXTee.ProConstants
  {$ELSE}
  TeeProCo
  {$ENDIF};

{ TFibonacciTool }

Constructor TFibonacciTool.Create(AOwner: TComponent);
begin
  inherited;

  SetLength(IDefaultFab,3);
  IDefaultFab[0]:=38.2;
  IDefaultFab[1]:=50.0;
  IDefaultFab[2]:=61.8;

  FLevels:=TFibonacciLevels.Create(Self,TFibonacciItem);
  FLevels.ITool:=Self;

  FTrendPen:=CreateChartPen;
  FTrendPen.Color:={$IFDEF FMX}claRed{$ELSE}clRed{$ENDIF};

  FDrawStyle:=fsArc;

  ISp:=TeePoint(-1,-1);

  FShowLabels:=True;
  FLabelsAngle:=90;

  FLabelFont:=TTeeFont.Create(CanvasChanged);

  CreateDefaultLevels;
end;

Destructor TFibonacciTool.Destroy;
begin
  IDefaultFab:=nil;
  FTrendPen.Free;
  FLabelFont.Free;
  FLevels.Free;
  inherited;
end;

procedure TFibonacciTool.Assign(Source: TPersistent);
begin
  if Source is TFibonacciTool then
  with TFibonacciTool(Source) do
  begin
    Self.FDrawStyle:=FDrawStyle;
    Self.FEndX:=FEndX;
    Self.FEndY:=FEndY;
    Self.FLabelsAngle:=FLabelsAngle;
    Self.LabelsFont:=LabelsFont;
    Self.Levels:=Levels;
    Self.FShowLabels:=FShowLabels;
    Self.FStartX:=FStartX;
    Self.FStartY:=FStartY;
    Self.TrendPen:=TrendPen;
  end;

  inherited;
end;

class function TFibonacciTool.Description: String;
begin
  result:=TeeMsg_Fibonacci;
end;

class function TFibonacciTool.GetEditorClass: String;
begin
  result:='TFibonacciEditor';
end;

class function TFibonacciTool.LongDescription: String;
begin
  result:=TeeMsg_FibonacciDesc;
end;

procedure TFibonacciTool.SetDrawStyle(const Value: TFibonacciStyle);
begin
  if FDrawStyle<>Value then
  begin
    FDrawStyle:=Value;
    Repaint;
  end;
end;

procedure TFibonacciTool.SetEndX(const Value: Double);
begin
  SetDoubleProperty(FEndX,Value);
end;

procedure TFibonacciTool.SetEndY(const Value: Double);
begin
  SetDoubleProperty(FEndY,Value);
end;

procedure TFibonacciTool.SetLabelsAngle(const Value: Integer);
begin
  SetIntegerProperty(FLabelsAngle,Value);
end;

procedure TFibonacciTool.SetLabelsFont(const Value: TTeeFont);
begin
  FLabelFont.Assign(Value);
end;

procedure TFibonacciTool.SetShowLabels(const Value: Boolean);
begin
  SetBooleanProperty(FShowLabels,Value);
end;

procedure TFibonacciTool.SetStartX(const Value: Double);
begin
  SetDoubleProperty(FStartX,Value);
end;

procedure TFibonacciTool.SetStartY(const Value: Double);
begin
  SetDoubleProperty(FStartY,Value);
end;

procedure TFibonacciTool.SetTrendPen(const Value: TChartPen);
begin
  FTrendPen.Assign(Value);
end;

procedure TFibonacciTool.SetLevels(const Value: TFibonacciLevels);
begin
  FLevels.Assign(Value);
end;

function TFibonacciTool.Radius:Double;
var rx : Integer;
    ry : Integer;
begin
  rx:=GetHorizAxis.CalcSizeValue(Abs(FEndX - FStartX));
  ry:=GetVertAxis.CalcSizeValue(Abs(FEndY - FStartY));
  result:=TeeDistance(rx,ry)
end;

procedure TFibonacciTool.ClipDrawingRegion;
var tmpR : TRect;
begin
  if Assigned(Series) then
  begin
    tmpR.Left:=GetHorizAxis.IStartPos;
    tmpR.Top:=GetVertAxis.IStartPos;
    tmpR.Right:=GetHorizAxis.IEndPos;
    tmpR.Bottom:=GetVertAxis.IEndPos;
  end
  else
    tmpR:=ParentChart.ChartRect;

  if ParentChart.CanClip then
     ParentChart.Canvas.ClipCube(tmpR,0,ParentChart.Width3D);
end;

function TFibonacciTool.AxisPoint(const X,Y:Double):TPoint;
begin
  result:=TeePoint(GetHorizAxis.CalcPosValue(X),GetVertAxis.CalcPosValue(Y));
end;

type
  TTeePanelAccess=class(TCustomTeePanel);

procedure TFibonacciTool.ChartEvent(AEvent:TChartToolEvent);

  function SamePoint(const A,B:TPoint):Boolean;
  begin
    result:=(A.X=B.X) and (A.Y=B.Y);
  end;

var t : Integer;
    PStart, PEnd: TPoint;
begin
  inherited;

  if AEvent=cteAfterDraw then
  begin
    ClipDrawingRegion;

    ParentChart.Canvas.BackMode:=cbmTransparent;
    
    // Draw trendline
    if TrendPen.Visible then
    begin
      ParentChart.Canvas.AssignVisiblePen(TrendPen);

      if FDrawStyle = fsRetracement then        // Draw 0% and 100% lines for Fibonacci Retracement
      begin
        ParentChart.Canvas.Line(AxisPoint(FStartX,FStartY), AxisPoint(FEndX,FStartY));
        ParentChart.Canvas.Line(AxisPoint(FStartX,FEndY), AxisPoint(FEndX,FEndY));

        if ShowLabels then
        begin
          TTeePanelAccess(ParentChart).TryAssignFont(LabelsFont);
          PStart := AxisPoint(FEndX,FStartY);
          PEnd := AxisPoint(FEndX,FEndY);

          if FStartY < FEndY then
          begin
            ParentChart.Canvas.TextOut(PStart.X, PStart.Y, '0');
            ParentChart.Canvas.TextOut(PEnd.X, PEnd.Y, '100');
          end
          else
          begin
            ParentChart.Canvas.TextOut(PStart.X, PStart.Y, '100');
            ParentChart.Canvas.TextOut(PEnd.X, PEnd.Y, '0');
          end;
        end;
      end
      else
        ParentChart.Canvas.Line(AxisPoint(FStartX,FStartY),AxisPoint(FEndX,FEndY));
    end;

    // Draw levels, but only if there is a trendline
    if (FLevels.Count > 0) and
       (not SamePoint(AxisPoint(FStartX,FStartY),AxisPoint(FEndX,FEndY))) then
    begin
      case FDrawStyle of
        fsArc: ISp:=AxisPoint(endx,endy);
        fsFan: ISp:=AxisPoint(startx,starty);
      end;

      for t:=0 to FLevels.Count-1 do
          DrawLevel(t);
    end;

    ParentChart.Canvas.UnClipRectangle;
  end;
end;

procedure TFibonacciTool.DrawLevel(Index:Integer);

  procedure Arc(const Center:TPoint; Rad:Integer; Upper:Boolean);
  var tmp,l,r,t,b : Integer;
  begin
    tmp:={$IFDEF FMX}Round{$ENDIF}(Center.X);
    l := tmp - rad;
    r := tmp + rad;

    tmp:={$IFDEF FMX}Round{$ENDIF}(Center.Y);
    t := tmp - rad;
    b := tmp + rad;

    if Upper then
       ParentChart.Canvas.Arc(l, t, r, b, 0, 180)
    else
       ParentChart.Canvas.Arc(l, t, r, b, 180, 180);
  end;

  procedure Fan(const startp, endp:TPoint);
  begin
    ParentChart.Canvas.MoveTo(startp);
    ParentChart.Canvas.LineTo(endp);
  end;

var tmpRadius : Integer;
    yretrac,
    xend,
    yend,
    k    : Double;
    endP : TPoint;
begin
  ParentChart.Canvas.AssignVisiblePen(Levels[Index].Pen);

  case FDrawStyle of
   fsArc: begin
            tmpRadius:=Round(Radius* Levels[Index].Value * 0.01);
            Arc(ISp,tmpRadius,FEndY>FStartY);

            if ShowLabels then
            begin
              TTeePanelAccess(ParentChart).TryAssignFont(LabelsFont);
              ParentChart.Canvas.RotateLabel({$IFDEF FMX}Round{$ENDIF}(ISp.X)-
                                tmpRadius,
                                {$IFDEF FMX}Round{$ENDIF}(ISp.Y),
                                FloatToStr(Levels[Index].Value), LabelsAngle);
            end;
          end;

   fsFan: begin
            if Assigned(Series) then xend:=Series.XValues.Last
                                else xend:=endx;

            k:=(endy - starty) / (endx - startx) * (100.0-Levels[Index].Value) * 0.01;
            yend:=Starty + k * (xend - startx);
            endp:=AxisPoint(xend,yend);

            Fan(ISp,endp);

            if ShowLabels then
            begin
              TTeePanelAccess(ParentChart).TryAssignFont(LabelsFont);
              ParentChart.Canvas.RotateLabel({$IFDEF FMX}Round{$ENDIF}(endp.X),
                      {$IFDEF FMX}Round{$ENDIF}(endp.Y),
                      FloatToStr(Levels[Index].Value), LabelsAngle);
            end;
          end;

   fsRetracement:
          begin
            if FStartY > FEndY then
              yretrac := FEndY + (Abs(StartY-EndY) * Levels[Index].Value * 0.01)
            else
              yretrac := StartY + (Abs(StartY-EndY) * Levels[Index].Value * 0.01);

            Fan(AxisPoint(StartX,yretrac), AxisPoint(EndX,yretrac));

            if ShowLabels then
            begin
              TTeePanelAccess(ParentChart).TryAssignFont(LabelsFont);
              ParentChart.Canvas.TextOut(GetHorizAxis.CalcPosValue(EndX), GetVertAxis.CalcPosValue(yretrac), FloatToStr(Levels[Index].Value));
            end;
          end;
  end;
end;

procedure TFibonacciTool.CreateDefaultLevels;
var t : Integer;
begin
  FLevels.Clear;

  for t:=Low(IDefaultFab) to High(IDefaultFab) do
      TFibonacciItem(FLevels.Add).FValue:=IDefaultFab[t];
end;

{ TFibonacciItem }

procedure TFibonacciItem.Assign(Source: TPersistent);
begin
  if Source is TFibonacciItem then
  with TFibonacciItem(Source) do
  begin
    Self.Pen:=Pen;
    Self.FValue:=FValue;
  end
  else
    inherited;
end;

Constructor TFibonacciItem.Create(Collection:TCollection);
begin
  inherited;
  ITool:=TFibonacciLevels(Collection).ITool;
  FPen:=ITool.CreateChartPen;
end;

Destructor TFibonacciItem.Destroy;
begin
  FPen.Free;
  inherited;
end;

procedure TFibonacciItem.SetPen(const Value: TChartPen);
begin
  FPen.Assign(Value);
end;

procedure TFibonacciItem.SetValue(const Value: TChartValue);
begin
  if FValue<>Value then
  begin
    FValue:=Value;
    ITool.Repaint;
  end;
end;

{ TFibonacciLevels }

function TFibonacciLevels.Get(Index: Integer): TFibonacciItem;
begin
  result:=TFibonacciItem(inherited Items[Index]);
end;

procedure TFibonacciLevels.Put(Index: Integer;
  const Value: TFibonacciItem);
begin
  inherited Items[Index]:=Value;
end;

initialization
  RegisterTeeTools([TFibonacciTool]);
finalization
  UnRegisterTeeTools([TFibonacciTool]);
end.
