MycLib/AuraTrader/TestChartControl.pas

unit TestChartControl;

interface

uses
    System.SysUtils,
    System.Types,
    System.UITypes,
    System.Classes,
    System.Variants,
    System.Generics.Collections,
    System.Math,
    System.UIConsts, // For AlphaColors
    FMX.Types,
    FMX.Controls,
    FMX.Forms,
    FMX.Graphics,
    FMX.Dialogs,
    FMX.Objects,
    Myc.Trade.DataPoint;

type
    // Declared for testing, will be moved to external unit
    TOhlcItem = record
        Open, High, Low, Close: Double;
    end;

    // Custom high-precision point type using Double.
    TPointD = record
    public
        X: Double;
        Y: Double;
        constructor Create(AX, AY: Double);
    end;

    // Custom high-precision rectangle type using Double.
    TRectD = record
    private
        function GetHeight: Double;
        function GetWidth: Double;
    public
        Left, Top, Right, Bottom: Double;
        constructor Create(const ALeft, ATop, ARight, ABottom: Double); overload;
        constructor Create(const ATopLeft, ABottomRight: TPointD); overload;
        property Width: Double read GetWidth;
        property Height: Double read GetHeight;
    end;

    TChart = class; // Forward declaration

    // Abstract base class for a single series in a chart.
    TChartSeries = class abstract(TCollectionItem)
    private
        FColor: TAlphaColor;
        FThickness: Single;
        procedure SetColor(const Value: TAlphaColor);
        procedure SetThickness(const Value: Single);
    protected
        function GetChart: TChart;
    public
        constructor Create(Collection: TCollection); override;
        // Calculates the bounding box for this series.
        procedure GetBounds(var MinPoint, MaxPoint: TPointD); virtual; abstract;
        // Draws the series on the canvas.
        procedure Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF); virtual; abstract;
    published
        property Color: TAlphaColor read FColor write SetColor;
        property Thickness: Single read FThickness write SetThickness;
    end;

    // Generic, abstract adapter to connect a TDataSeries<T> to a TChart.
    TChartSeriesAdapter<T> = class abstract(TChartSeries)
    private
        FDataSeries: TDataSeries<T>;
    protected
        procedure SetDataSeries(const Value: TDataSeries<T>); virtual;
        // Converts a data point from the source series to a high-precision visual point for the chart.
        // May not be applicable for all series types (e.g., OHLC).
        function DataToPoint(const DataPoint: TDataPoint<T>): TPointD; virtual; abstract;
    public
        constructor Create(Collection: TCollection); override;
        property DataSeries: TDataSeries<T> read FDataSeries write SetDataSeries;
    end;

    TDataSourceField = (dsfAsk, dsfBid);

    // Concrete series implementation for displaying TDataSeries<TAskBidItem>.
    TChartAskBidSeries = class(TChartSeriesAdapter<TAskBidItem>)
    private
        FDataSourceField: TDataSourceField;
        FCachedPoints: TArray<TPointD>;
        FCacheValid: Boolean;
        procedure SetDataSourceField(const Value: TDataSourceField);
        procedure EnsureCacheIsValid;
    protected
        procedure SetDataSeries(const Value: TDataSeries<TAskBidItem>); override;
        function DataToPoint(const DataPoint: TDataPoint<TAskBidItem>): TPointD; override;
    public
        constructor Create(Collection: TCollection); override;
        procedure GetBounds(var MinPoint, MaxPoint: TPointD); override;
        procedure Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF); override;
    published
        property DataSourceField: TDataSourceField read FDataSourceField write SetDataSourceField;
    end;

    // Concrete series implementation for displaying TDataSeries<TOhlcItem> as candlesticks.
    TChartOhlcSeries = class(TChartSeriesAdapter<TOhlcItem>)
    private
        FUpColor: TAlphaColor;
        FDownColor: TAlphaColor;
    protected
        // This function is not used for OHLC drawing but must be implemented.
        function DataToPoint(const DataPoint: TDataPoint<TOhlcItem>): TPointD; override;
    public
        constructor Create(Collection: TCollection); override;
        procedure GetBounds(var MinPoint, MaxPoint: TPointD); override;
        procedure Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF); override;
    published
        property UpColor: TAlphaColor read FUpColor write FUpColor;
        property DownColor: TAlphaColor read FDownColor write FDownColor;
    end;

    TChartSeriesCollection = class(TCollection)
    private
        [weak]
        FOwner: TChart;
        function GetItem(Index: Integer): TChartSeries;
        procedure SetItem(Index: Integer; const Value: TChartSeries);
    protected
        function GetOwner: TPersistent; override;
        procedure Update(Item: TCollectionItem); override;
    public
        constructor Create(AOwner: TChart);
        property Items[Index: Integer]: TChartSeries read GetItem write SetItem; default;
    end;

    // A control for displaying charts.
    TChart = class(TControl)
    private
        FSeries: TChartSeriesCollection;
        FAxisColor: TAlphaColor;
        FGridColor: TAlphaColor;
        FPadding: Single;
        procedure SetSeries(const Value: TChartSeriesCollection);
        procedure SetAxisColor(const Value: TAlphaColor);
        procedure SetGridColor(const Value: TAlphaColor);
        procedure SetPadding(const Value: Single);
    protected
        procedure Paint; override;
        procedure RecalcDataBounds(out MinPoint, MaxPoint: TPointD);
        procedure DrawAxes(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
        procedure DrawGrid(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
    public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        procedure Repaint;
    published
        property Align;
        property Anchors;
        property Series: TChartSeriesCollection read FSeries write SetSeries;
        property AxisColor: TAlphaColor read FAxisColor write SetAxisColor;
        property GridColor: TAlphaColor read FGridColor write SetGridColor;
        property Padding: Single read FPadding write SetPadding;
    end;

    TTestChartForm = class(TForm)
        procedure FormCreate(Sender: TObject);
    private
        FChart: TChart;
    public
    end;

var
    TestChartForm: TTestChartForm;

implementation

{$R *.fmx}

{ TPointD }

constructor TPointD.Create(AX, AY: Double);
begin
    X := AX;
    Y := AY;
end;

{ TRectD }

constructor TRectD.Create(const ALeft, ATop, ARight, ABottom: Double);
begin
    Left := ALeft;
    Top := ATop;
    Right := ARight;
    Bottom := ABottom;
end;

constructor TRectD.Create(const ATopLeft, ABottomRight: TPointD);
begin
    Left := ATopLeft.X;
    Top := ATopLeft.Y;
    Right := ABottomRight.X;
    Bottom := ABottomRight.Y;
end;

function TRectD.GetHeight: Double;
begin
    Result := Bottom - Top;
end;

function TRectD.GetWidth: Double;
begin
    Result := Right - Left;
end;

{ TChartSeries }

constructor TChartSeries.Create(Collection: TCollection);
begin
    inherited Create(Collection);
    FColor := TAlphaColors.Black; // Default color for wicks in OHLC
    FThickness := 1;
end;

function TChartSeries.GetChart: TChart;
begin
    Result := (Collection as TChartSeriesCollection).GetOwner as TChart;
end;

procedure TChartSeries.SetColor(const Value: TAlphaColor);
begin
    if (FColor <> Value) then
    begin
        FColor := Value;
        if Assigned(Collection) then
            Changed(False);
    end;
end;

procedure TChartSeries.SetThickness(const Value: Single);
begin
    if (FThickness <> Value) then
    begin
        FThickness := Value;
        if Assigned(Collection) then
            Changed(False);
    end;
end;

{ TChartSeriesAdapter<T> }

constructor TChartSeriesAdapter<T>.Create(Collection: TCollection);
begin
    inherited Create(Collection);
    FDataSeries := TDataSeries<T>.Null;
end;

procedure TChartSeriesAdapter<T>.SetDataSeries(const Value: TDataSeries<T>);
begin
    FDataSeries := Value;
    if Assigned(Collection) then
        Changed(False);
end;

{ TChartAskBidSeries }

constructor TChartAskBidSeries.Create(Collection: TCollection);
begin
    inherited Create(Collection);
    Self.Color := TAlphaColors.Blue; // Override default for line charts
    Self.Thickness := 2;
    FDataSourceField := dsfAsk;
    FCacheValid := False;
end;

procedure TChartAskBidSeries.EnsureCacheIsValid;
var
    i: Int64;
    pointCount: Int64;
begin
    if FCacheValid then
        Exit;
    pointCount := DataSeries.Count;
    SetLength(FCachedPoints, pointCount);
    if (pointCount > 0) then
    begin
        for i := 0 to pointCount - 1 do
        begin
            FCachedPoints[i] := DataToPoint(DataSeries[pointCount - 1 - i]);
        end;
    end;
    FCacheValid := True;
end;

procedure TChartAskBidSeries.GetBounds(var MinPoint, MaxPoint: TPointD);
var
    pt: TPointD;
    isFirst: Boolean;
begin
    EnsureCacheIsValid;
    if (Length(FCachedPoints) = 0) then
        Exit;
    isFirst := (MinPoint.X = MaxPoint.X) and (MinPoint.Y = MaxPoint.Y);
    if isFirst then
    begin
        MinPoint := FCachedPoints[0];
        MaxPoint := FCachedPoints[0];
    end;
    for pt in FCachedPoints do
    begin
        MinPoint.X := Min(MinPoint.X, pt.X);
        MinPoint.Y := Min(MinPoint.Y, pt.Y);
        MaxPoint.X := Max(MaxPoint.X, pt.X);
        MaxPoint.Y := Max(MaxPoint.Y, pt.Y);
    end;
end;

procedure TChartAskBidSeries.Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
var
    scaleX, scaleY: Double;
    pt1, pt2: TPointD;
    transformedPt1, transformedPt2: TPointF;
    j: Integer;
begin
    EnsureCacheIsValid;
    if Length(FCachedPoints) < 2 then
        Exit;
    if (ADataRect.Width <= 0) or (ADataRect.Height <= 0) then
        Exit;
    scaleX := ACanvasRect.Width / ADataRect.Width;
    scaleY := ACanvasRect.Height / ADataRect.Height;
    ACanvas.Stroke.Kind := TBrushKind.Solid;
    ACanvas.Stroke.Color := Self.Color;
    ACanvas.Stroke.Thickness := Self.Thickness;
    pt1 := FCachedPoints[0];
    for j := 1 to High(FCachedPoints) do
    begin
        pt2 := FCachedPoints[j];
        transformedPt1.X := ACanvasRect.Left + (pt1.X - ADataRect.Left) * scaleX;
        transformedPt1.Y := ACanvasRect.Bottom - (pt1.Y - ADataRect.Top) * scaleY;
        transformedPt2.X := ACanvasRect.Left + (pt2.X - ADataRect.Left) * scaleX;
        transformedPt2.Y := ACanvasRect.Bottom - (pt2.Y - ADataRect.Top) * scaleY;
        ACanvas.DrawLine(transformedPt1, transformedPt2, 1);
        pt1 := pt2;
    end;
end;

procedure TChartAskBidSeries.SetDataSeries(const Value: TDataSeries<TAskBidItem>);
begin
    inherited SetDataSeries(Value);
    FCacheValid := False;
end;

function TChartAskBidSeries.DataToPoint(const DataPoint: TDataPoint<TAskBidItem>): TPointD;
begin
    Result.X := DataPoint.Time;
    case FDataSourceField of
        dsfAsk: Result.Y := DataPoint.Data.Ask;
        dsfBid: Result.Y := DataPoint.Data.Bid;
    else
        Result.Y := 0;
    end;
end;

procedure TChartAskBidSeries.SetDataSourceField(const Value: TDataSourceField);
begin
    if (FDataSourceField <> Value) then
    begin
        FDataSourceField := Value;
        FCacheValid := False;
        if Assigned(Collection) then
            Changed(False);
    end;
end;

{ TChartOhlcSeries }

constructor TChartOhlcSeries.Create(Collection: TCollection);
begin
    inherited Create(Collection);
    FUpColor := TAlphaColors.Green;
    FDownColor := TAlphaColors.Red;
end;

function TChartOhlcSeries.DataToPoint(const DataPoint: TDataPoint<TOhlcItem>): TPointD;
begin
    // Not used for OHLC series drawing, but must be implemented for the abstract parent.
    Result.X := DataPoint.Time;
    Result.Y := DataPoint.Data.Close;
end;

procedure TChartOhlcSeries.GetBounds(var MinPoint, MaxPoint: TPointD);
var
    isFirst: Boolean;
    i: Int64;
    dataPoint: TDataPoint<TOhlcItem>;
begin
    if (DataSeries.Count = 0) then
        Exit;
    isFirst := (MinPoint.X > MaxPoint.X); // A more robust check for an uninitialized state
    for i := 0 to DataSeries.Count - 1 do
    begin
        dataPoint := DataSeries[i];
        if isFirst then
        begin
            MinPoint.X := dataPoint.Time;
            MaxPoint.X := dataPoint.Time;
            MinPoint.Y := dataPoint.Data.Low;
            MaxPoint.Y := dataPoint.Data.High;
            isFirst := False;
        end
        else
        begin
            MinPoint.X := Min(MinPoint.X, dataPoint.Time);
            MaxPoint.X := Max(MaxPoint.X, dataPoint.Time);
            MinPoint.Y := Min(MinPoint.Y, dataPoint.Data.Low);
            MaxPoint.Y := Max(MaxPoint.Y, dataPoint.Data.High);
        end;
    end;
end;

procedure TChartOhlcSeries.Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
var
    scaleX, scaleY: Double;
    i: Int64;
    dataPoint: TDataPoint<TOhlcItem>;
    x_center, candleWidth: Single;
    y_high, y_low, y_open, y_close: Single;
    body: TRectF;
begin
    if (DataSeries.Count = 0) or (ADataRect.Width <= 0) or (ADataRect.Height <= 0) then
        Exit;
    scaleX := ACanvasRect.Width / ADataRect.Width;
    scaleY := ACanvasRect.Height / ADataRect.Height;
    candleWidth := Max(3.0, (ACanvasRect.Width / DataSeries.Count) * 0.8);

    for i := 0 to DataSeries.Count - 1 do
    begin
        dataPoint := DataSeries[i];
        x_center := ACanvasRect.Left + (dataPoint.Time - ADataRect.Left) * scaleX;
        y_high := ACanvasRect.Bottom - (dataPoint.Data.High - ADataRect.Top) * scaleY;
        y_low := ACanvasRect.Bottom - (dataPoint.Data.Low - ADataRect.Top) * scaleY;
        y_open := ACanvasRect.Bottom - (dataPoint.Data.Open - ADataRect.Top) * scaleY;
        y_close := ACanvasRect.Bottom - (dataPoint.Data.Close - ADataRect.Top) * scaleY;

        ACanvas.Stroke.Color := Self.Color;
        ACanvas.Stroke.Thickness := Self.Thickness;
        ACanvas.DrawLine(TPointF.Create(x_center, y_high), TPointF.Create(x_center, y_low), 1.0);

        if (dataPoint.Data.Close >= dataPoint.Data.Open) then
            ACanvas.Fill.Color := FUpColor
        else
            ACanvas.Fill.Color := FDownColor;

        body := TRectF.Create(x_center - candleWidth / 2, y_open, x_center + candleWidth / 2, y_close);
        NormalizeRect(body);
        ACanvas.FillRect(body, 0, 0, [], 1.0);
    end;
end;

{ TChartSeriesCollection }

constructor TChartSeriesCollection.Create(AOwner: TChart);
begin
    inherited Create(TChartSeries);
    FOwner := AOwner;
end;

function TChartSeriesCollection.GetItem(Index: Integer): TChartSeries;
begin
    Result := TChartSeries(inherited GetItem(Index));
end;

function TChartSeriesCollection.GetOwner: TPersistent;
begin
    Result := FOwner;
end;

procedure TChartSeriesCollection.SetItem(Index: Integer; const Value: TChartSeries);
begin
    inherited SetItem(Index, Value);
end;

procedure TChartSeriesCollection.Update(Item: TCollectionItem);
begin
    inherited;
    if Assigned(FOwner) then
        FOwner.Repaint;
end;

{ TChart }

constructor TChart.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    FSeries := TChartSeriesCollection.Create(Self);
    FAxisColor := TAlphaColors.Black;
    FGridColor := TAlphaColors.Lightgray;
    FPadding := 30;
end;

destructor TChart.Destroy;
begin
    FSeries.Free;
    inherited Destroy;
end;

procedure TChart.Paint;
var
    minPt, maxPt: TPointD;
    dataRect: TRectD;
    canvasRect: TRectF;
    series: TCollectionItem;
    hasData: Boolean;
begin
    inherited;
    Canvas.Fill.Color := TAlphaColors.White;
    Canvas.FillRect(LocalRect, 1);
    if (FSeries.Count = 0) then
        Exit;

    RecalcDataBounds(minPt, maxPt);
    hasData := (minPt.X < maxPt.X) and (minPt.Y < maxPt.Y);

    if not hasData then
        Exit;

    dataRect := TRectD.Create(minPt, maxPt);
    canvasRect := Self.LocalRect;
    canvasRect.Inflate(-FPadding, -FPadding);

    if (canvasRect.Width < 1) or (canvasRect.Height < 1) then
        Exit;

    DrawGrid(Canvas, dataRect, canvasRect);
    DrawAxes(Canvas, dataRect, canvasRect);

    for series in FSeries do
    begin
        (series as TChartSeries).Draw(Canvas, dataRect, canvasRect);
    end;
end;

procedure TChart.RecalcDataBounds(out MinPoint, MaxPoint: TPointD);
var
    series: TCollectionItem;
begin
    MinPoint := TPointD.Create(Infinity, Infinity);
    MaxPoint := TPointD.Create(NegInfinity, NegInfinity);

    for series in FSeries do
    begin
        (series as TChartSeries).GetBounds(MinPoint, MaxPoint);
    end;
end;

procedure TChart.DrawAxes(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
begin
    ACanvas.Stroke.Kind := TBrushKind.Solid;
    ACanvas.Stroke.Color := FAxisColor;
    ACanvas.Stroke.Thickness := 1;
    ACanvas.DrawLine(TPointF.Create(ACanvasRect.Left, ACanvasRect.Bottom), TPointF.Create(ACanvasRect.Right, ACanvasRect.Bottom), 1);
    ACanvas.DrawLine(TPointF.Create(ACanvasRect.Left, ACanvasRect.Top), TPointF.Create(ACanvasRect.Left, ACanvasRect.Bottom), 1);
end;

procedure TChart.DrawGrid(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF);
var
    i: Integer;
    x, y: Single;
const
    GridLines = 5;
begin
    ACanvas.Stroke.Kind := TBrushKind.Solid;
    ACanvas.Stroke.Color := FGridColor;
    ACanvas.Stroke.Thickness := 1;
    ACanvas.Stroke.Dash := TStrokeDash.Dot;
    for i := 1 to GridLines do
    begin
        x := ACanvasRect.Left + i * ACanvasRect.Width / GridLines;
        ACanvas.DrawLine(TPointF.Create(x, ACanvasRect.Top), TPointF.Create(x, ACanvasRect.Bottom), 1);
    end;
    for i := 0 to GridLines - 1 do
    begin
        y := ACanvasRect.Bottom - i * ACanvasRect.Height / GridLines;
        ACanvas.DrawLine(TPointF.Create(ACanvasRect.Left, y), TPointF.Create(ACanvasRect.Right, y), 1);
    end;
    ACanvas.Stroke.Dash := TStrokeDash.Solid;
end;

procedure TChart.SetSeries(const Value: TChartSeriesCollection);
begin
    FSeries.Assign(Value);
end;

procedure TChart.SetAxisColor(const Value: TAlphaColor);
begin
    if (FAxisColor <> Value) then
    begin
        FAxisColor := Value;
        Repaint;
    end;
end;

procedure TChart.SetGridColor(const Value: TAlphaColor);
begin
    if (FGridColor <> Value) then
    begin
        FGridColor := Value;
        Repaint;
    end;
end;

procedure TChart.SetPadding(const Value: Single);
begin
    if (FPadding <> Value) then
    begin
        FPadding := Value;
        Repaint;
    end;
end;

procedure TChart.Repaint;
begin
    inherited;
end;

{ TTestChartForm }

procedure TTestChartForm.FormCreate(Sender: TObject);
var
    ohlcSeries: TChartOhlcSeries;
    askSeries, bidSeries: TChartAskBidSeries;
    i: Integer;
    ohlcData: TDataSeries<TOhlcItem>;
    askBidData: TDataSeries<TAskBidItem>;
    ohlcDataPoints: array of TDataPoint<TOhlcItem>;
    askBidDataPoints: array of TDataPoint<TAskBidItem>;
    startTime: TDateTime;
    lastClose, o, h, l, c: Double;
    ohlcItem: TOhlcItem;
const
    NUM_POINTS = 50;
begin
    FChart := TChart.Create(Self);
    FChart.Parent := Self;
    FChart.Align := TAlignLayout.Client;

    // 1. Create OHLC Data
    ohlcData := TDataSeries<TOhlcItem>.CreateWriteable(NUM_POINTS);
    askBidData := TDataSeries<TAskBidItem>.CreateWriteable(NUM_POINTS);
    startTime := Now;
    SetLength(ohlcDataPoints, NUM_POINTS);
    SetLength(askBidDataPoints, NUM_POINTS);

    lastClose := 100;
    for i := 0 to NUM_POINTS - 1 do
    begin
        o := lastClose + (Random - 0.5) * 2;
        h := o + Random * 3;
        l := o - Random * 3;
        c := l + Random * (h - l);
        lastClose := c;

        ohlcItem.Open := o;
        ohlcItem.High := h;
        ohlcItem.Low := l;
        ohlcItem.Close := c;
        ohlcDataPoints[i] := TDataPoint<TOhlcItem>.Create(startTime + i, ohlcItem);

        // Derive Ask/Bid data from OHLC close price
        askBidDataPoints[i] :=
            TDataPoint<TAskBidItem>.Create(
                startTime + i,
                TAskBidItem.Create(c, c * 0.995) // Ask = Close, Bid = Close - 0.5% spread
            );
    end;
    ohlcData.Add(ohlcDataPoints);
    askBidData.Add(askBidDataPoints);

    // 2. Create and add OHLC Series
    ohlcSeries := TChartOhlcSeries.Create(FChart.Series);
    ohlcSeries.DataSeries := ohlcData;

    // 3. Create and add Ask/Bid Line Series
    askSeries := TChartAskBidSeries.Create(FChart.Series);
    askSeries.DataSeries := askBidData;
    askSeries.DataSourceField := dsfAsk;
    askSeries.Color := TAlphaColors.Blue;
    askSeries.Thickness := 2;

    bidSeries := TChartAskBidSeries.Create(FChart.Series);
    bidSeries.DataSeries := askBidData;
    bidSeries.DataSourceField := dsfBid;
    bidSeries.Color := TAlphaColors.Orange;
    bidSeries.Thickness := 2;
end;

end.