MycLib/Src/Myc.Fmx.Chart.Series.pas

unit Myc.FMX.Chart.Series;

interface

uses
    System.SysUtils,
    System.SyncObjs,
    System.UITypes,
    FMX.Graphics,
    Myc.Trade.DataArray,
    Myc.Trade.DataPoint,
    Myc.Lazy,
    Myc.Fmx.Chart;

type
    TChartSeriesCounter<T> = class(TMycConverter<T, Int64>)
    private
        FCount: Int64;
    protected
        function ProcessData(const Value: T): Boolean; override;
    public
        constructor Create;
    end;

    TChartSeriesReceiver<T> = class(TMycProcessor<T>)
    strict private
        FCurrData: TMycDataArray<T>;
        FLookback: TWriteable<Int64>;
    private
        FData: TWriteable<TMycDataArray<T>>;
    protected
        function ProcessData(const Value: T): Boolean; override;
    public
        constructor Create(const ALookback: TWriteable<Int64>);
        property Data: TWriteable<TMycDataArray<T>> read FData;
    end;

    TChartSeriesProcessor<T> = class(TMycChart.TSeries)
    strict private
        FDataSeries: TMycDataArray<T>;
        FLock: TSpinLock;
    private
        FData: TMycDataArray<T>;
        FDataProvider: IMycDataProvider<T>;
        FReceiver: TChartSeriesReceiver<T>;
        FReceiverTag: TTag;
    protected
        function GetCount: Int64; override;
        function GetTotalCount: Int64; override;
        procedure Update; override;

    public
        constructor Create(AOwner: TMycChart; const ADataProvider: IMycDataProvider<T>);
        destructor Destroy; override;
        property Data: TMycDataArray<T> read FData;
    end;

    { TChartOhlcSeries }
    TChartOhlcSeries = class(TChartSeriesProcessor<TOhlcItem>)
    private
        FUpColor: TAlphaColor;
        FDownColor: TAlphaColor;
    protected
        function GetValueRange(First, Last: Int64; out MinValue, MaxValue: Double): Boolean; override;
        procedure Paint(const Canvas: TCanvas; First, Last: Int64; const XForm, YForm: TFunc<Double, Single>); override;
    public
        constructor Create(AOwner: TMycChart; const ADataProvider: IMycDataProvider<TOhlcItem>; const AUpColor, ADownColor: TAlphaColor);
    end;

    { TChartLineSeries }
    TChartLineSeries = class(TChartSeriesProcessor<Double>)
    private
        FLineColor: TAlphaColor;
        FLineWidth: Single;
    protected
        function GetValueRange(First, Last: Int64; out MinValue, MaxValue: Double): Boolean; override;
        procedure Paint(const Canvas: TCanvas; First, Last: Int64; const XForm, YForm: TFunc<Double, Single>); override;
    public
        constructor Create(
            AOwner: TMycChart;
            const ADataProvider: IMycDataProvider<Double>;
            const ALineColor: TAlphaColor;
            ALineWidth: Single
        );
    end;

implementation

uses
    System.Types,
    System.Math,
    FMX.Types;

constructor TChartSeriesCounter<T>.Create;
begin
    inherited Create;
    FCount := 0;
end;

function TChartSeriesCounter<T>.ProcessData(const Value: T): Boolean;
begin
    Result := true;
    Broadcast(FCount);
    inc(FCount);
end;

{ TChartSeriesReceiver<T> }

constructor TChartSeriesReceiver<T>.Create(const ALookback: TWriteable<Int64>);
begin
    inherited Create;
    FLookback := ALookback;
    FCurrData := TMycDataArray<T>.CreateEmpty;
    FData := TWriteable<TMycDataArray<T>>.CreateWriteable(FCurrData).Protect;
end;

function TChartSeriesReceiver<T>.ProcessData(const Value: T): Boolean;
begin
    Result := true;
    FCurrData := FCurrData.Add(Value, FLookback.Value);
    FData.Value := FCurrData;
end;

{ TChartSeriesProcessor<T> }

constructor TChartSeriesProcessor<T>.Create(AOwner: TMycChart; const ADataProvider: IMycDataProvider<T>);
begin
    inherited Create(AOwner);
    FLock := TSpinLock.Create(false);
    FDataSeries := TMycDataArray<T>.CreateEmpty;
    FData := FDataSeries;
    FDataProvider := ADataProvider;
    FReceiver := TChartSeriesReceiver<T>.Create(AOwner.Lookback);
    FReceiverTag := FDataProvider.Link(FReceiver);
end;

destructor TChartSeriesProcessor<T>.Destroy;
begin
    FDataProvider.Unlink(FReceiverTag);
    inherited;
end;

function TChartSeriesProcessor<T>.GetCount: Int64;
begin
    Result := FData.Count;
end;

function TChartSeriesProcessor<T>.GetTotalCount: Int64;
begin
    Result := FData.TotalCount;
end;

procedure TChartSeriesProcessor<T>.Update;
begin
    FData := FReceiver.Data.Value;
end;

{ TChartLineSeries }

constructor TChartLineSeries.Create(
    AOwner: TMycChart;
    const ADataProvider: IMycDataProvider<Double>;
    const ALineColor: TAlphaColor;
    ALineWidth: Single
);
begin
    inherited Create(AOwner, ADataProvider);
    FLineColor := ALineColor;
    FLineWidth := ALineWidth;
end;

function TChartLineSeries.GetValueRange(First, Last: Int64; out MinValue, MaxValue: Double): Boolean;
var
    i: Int64;
begin
    MinValue := MaxDouble;
    MaxValue := -MaxDouble;
    for i := First to Last do
    begin
        var v := Data.Items[i];
        if not IsNaN(v) then
        begin
            MinValue := Min(MinValue, v);
            MaxValue := Max(MaxValue, v);
        end;
    end;
    Result := (MinValue <> MaxDouble);
end;

procedure TChartLineSeries.Paint(const Canvas: TCanvas; First, Last: Int64; const XForm, YForm: TFunc<Double, Single>);
var
    points: TPathData;
    i, n: Int64;
begin
    points := TPathData.Create;
    try
        // Skip warmup data
        n := First;
        while (n <= Last) and (IsNaN(Data[n])) do
            inc(n);
        if (n > Last) then
            exit;

        points.MoveTo(TPointF.Create(XForm(n), YForm(Data[n])));
        for i := n + 1 to Last do
            if not IsNaN(Data[i]) then
                points.LineTo(TPointF.Create(XForm(i), YForm(Data[i])));

        Canvas.Stroke.Color := FLineColor;
        Canvas.Stroke.Thickness := FLineWidth;
        Canvas.DrawPath(points, 1);
    finally
        points.Free;
    end;
end;

{ TChartOhlcSeries }

constructor TChartOhlcSeries.Create(
    AOwner: TMycChart;
    const ADataProvider: IMycDataProvider<TOhlcItem>;
    const AUpColor, ADownColor: TAlphaColor
);
begin
    inherited Create(AOwner, ADataProvider);
    FUpColor := AUpColor;
    FDownColor := ADownColor;
end;

function TChartOhlcSeries.GetValueRange(First, Last: Int64; out MinValue, MaxValue: Double): Boolean;
var
    i: Int64;
begin
    MinValue := MaxDouble;
    MaxValue := -MaxDouble;

    for i := First to Last do
    begin
        var item := Data.Items[i];
        MinValue := Min(MinValue, item.Low);
        MaxValue := Max(MaxValue, item.High);
    end;
    Result := (MinValue <> MaxDouble);
end;

procedure TChartOhlcSeries.Paint(const Canvas: TCanvas; First, Last: Int64; const XForm, YForm: TFunc<Double, Single>);
var
    i: Int64;
    x, candleWidth: Single;
    yOpen, yHigh, yLow, yClose: Single;
    item: TOhlcItem;
    isUp: boolean;
begin
    candleWidth := Max(2, 0.8 * Abs((XForm(First + 1) - XForm(First))));

    for i := First to Last do
    begin
        item := Data.Items[i];
        x := XForm(i);
        yOpen := YForm(item.Open);
        yClose := YForm(item.Close);
        yHigh := YForm(item.High);
        yLow := YForm(item.Low);
        isUp := item.Close >= item.Open;

        if isUp then
            Canvas.Stroke.Color := FUpColor
        else
            Canvas.Stroke.Color := FDownColor;
        Canvas.Stroke.Thickness := 1.0;

        Canvas.DrawLine(TPointF.Create(x, yHigh), TPointF.Create(x, yLow), 1);

        Canvas.Fill.Color := Canvas.Stroke.Color;
        if isUp then
            Canvas.FillRect(TRectF.Create(x - candleWidth / 2, yClose, x + candleWidth / 2, yOpen), 0, 0, AllCorners, 1)
        else
            Canvas.FillRect(TRectF.Create(x - candleWidth / 2, yOpen, x + candleWidth / 2, yClose), 0, 0, AllCorners, 1);
    end;
end;

end.