unit TestChartControl; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, System.Generics.Collections, System.Math, System.UIConsts, System.TimeSpan, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects, Myc.Signals, Myc.Futures, Myc.Trade.DataPoint, Myc.Signals.FMX; type TPointD = record public X: Double; Y: Double; constructor Create(AX, AY: Double); procedure Offset(DX, DY: Double); end; 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; procedure Offset(DX, DY: Double); procedure ExpandBy(const pt: TPointD); property Width: Double read GetWidth; property Height: Double read GetHeight; end; TRangeD = record A: Double; B: Double; public constructor Create(const AA, AB: Double); end; TChartZoomMode = (czmXY, czmXOnly); TChart = class; // Forward declaration 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; function GetBounds: TFuture; virtual; abstract; function GetYBoundsForXRange(const XRange: TRangeD): TFuture; virtual; abstract; 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; TChartSeriesAdapter = class abstract(TChartSeries) private FDataSeries: TFuture>; protected procedure SetDataSeries(const Value: TFuture>); virtual; function DataToPoint(const DataPoint: TDataPoint): TPointD; virtual; abstract; public constructor Create(Collection: TCollection); override; property DataSeries: TFuture> read FDataSeries write SetDataSeries; end; // A generic series to plot a TDataSeries TChartLineSeries = class(TChartSeriesAdapter) private FBounds: TFuture; protected procedure SetDataSeries(const Value: TFuture>); override; function DataToPoint(const DataPoint: TDataPoint): TPointD; override; public constructor Create(Collection: TCollection); override; function GetBounds: TFuture; override; function GetYBoundsForXRange(const XRange: TRangeD): TFuture; override; procedure Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF); override; end; TChartOhlcSeries = class(TChartSeriesAdapter) private FUpColor: TAlphaColor; FDownColor: TAlphaColor; FCandleWidth: Double; FTimeInterval: TFuture; FBounds: TFuture; protected procedure SetDataSeries(const Value: TFuture>); override; function DataToPoint(const DataPoint: TDataPoint): TPointD; override; public constructor Create(Collection: TCollection); override; function GetBounds: TFuture; override; function GetYBoundsForXRange(const XRange: TRangeD): TFuture; 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; property CandleWidth: Double read FCandleWidth write FCandleWidth; 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; TChart = class(TControl) private FSeries: TChartSeriesCollection; FAxisColor: TAlphaColor; FGridColor: TAlphaColor; FPadding: Single; FDataBounds: TFuture; FYRange: TFuture; FDataView: TRectD; FBoundsValid: Boolean; FIsPanning: Boolean; FPanStartPoint: TPointF; FZoomMode: TChartZoomMode; procedure SetSeries(const Value: TChartSeriesCollection); procedure SetAxisColor(const Value: TAlphaColor); procedure SetGridColor(const Value: TAlphaColor); procedure SetPadding(const Value: Single); procedure RecalcDataBounds; protected procedure Paint; override; procedure DrawAxes(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF); procedure DrawGrid(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF); procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; procedure MouseMove(Shift: TShiftState; X, Y: Single); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override; procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override; procedure DblClick; override; procedure InvalidateDataBounds; procedure InvalidateYRange; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure BeforeDestruction; override; procedure ResetView; 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; property ZoomMode: TChartZoomMode read FZoomMode write FZoomMode; 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; procedure TPointD.Offset(DX, DY: Double); begin X := X + DX; Y := Y + DY; 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; procedure TRectD.ExpandBy(const pt: TPointD); begin if pt.X < Left then Left := pt.X; if pt.X > Right then Right := pt.X; if pt.Y < Top then Top := pt.Y; if pt.Y > Bottom then Bottom := pt.Y; end; procedure TRectD.Offset(DX, DY: Double); begin Left := Left + DX; Right := Right + DX; Top := Top + DY; Bottom := Bottom + DY; 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; 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 } constructor TChartSeriesAdapter.Create(Collection: TCollection); begin inherited Create(Collection); end; procedure TChartSeriesAdapter.SetDataSeries(const Value: TFuture>); begin FDataSeries := Value; if Assigned(Collection) then Changed(False); end; { TChartLineSeries } constructor TChartLineSeries.Create(Collection: TCollection); begin inherited Create(Collection); Self.Color := TAlphaColors.Green; Self.Thickness := 1; end; procedure TChartLineSeries.SetDataSeries(const Value: TFuture>); begin // Future -> Future FBounds := Value.Chain( function(const Data: TDataSeries): TRectD begin if Data.Count = 0 then Exit(TRectD.Create(0, 0, 0, 0)); Result := TRectD.Create(Data[0].Time, Data[0].Data, Data[0].Time, Data[0].Data); for var i := 1 to Data.Count - 1 do Result.ExpandBy(TPointD.Create(Data[i].Time, Data[i].Data)); end ); inherited SetDataSeries(Value); end; function TChartLineSeries.DataToPoint(const DataPoint: TDataPoint): TPointD; begin Result.X := DataPoint.Time; Result.Y := DataPoint.Data; end; function TChartLineSeries.GetBounds: TFuture; begin Result := FBounds; end; function TChartLineSeries.GetYBoundsForXRange(const XRange: TRangeD): TFuture; begin Result := DataSeries.Chain( function(const Data: TDataSeries): TRangeD begin Result.A := Infinity; Result.B := NegInfinity; var n := Data.IndexOf(XRange.A); for var i := n to Data.Count - 1 do begin var dp := Data[i]; var pt := TPointD.Create(dp.Time, dp.Data); // if (pt.X >= XRange.A) and (pt.X <= XRange.B) then // begin // Result.A := System.Math.Min(Result.A, pt.Y); // Result.B := System.Math.Max(Result.B, pt.Y); // end; if pt.X > XRange.B then break; Result.A := System.Math.Min(Result.A, pt.Y); Result.B := System.Math.Max(Result.B, pt.Y); end; if IsInfinite(Result.A) then begin Result.A := 0; Result.B := -1; end; end ); end; procedure TChartLineSeries.Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF); var scaleX, scaleY: Double; transformedPt1, transformedPt2: TPointF; j: Integer; begin if not DataSeries.Done.IsSet then exit; var points := DataSeries.Value; if points.Count < 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; var dp1 := points[0]; var dp2 := dp1; for j := 1 to points.Count - 1 do begin dp2 := points[j]; transformedPt1.X := ACanvasRect.Left + (dp1.Time - ADataRect.Left) * scaleX; transformedPt1.Y := ACanvasRect.Bottom - (dp1.Data - ADataRect.Top) * scaleY; transformedPt2.X := ACanvasRect.Left + (dp2.Time - ADataRect.Left) * scaleX; transformedPt2.Y := ACanvasRect.Bottom - (dp2.Data - ADataRect.Top) * scaleY; ACanvas.DrawLine(transformedPt1, transformedPt2, 1); dp1 := dp2; end; end; { TChartOhlcSeries } constructor TChartOhlcSeries.Create(Collection: TCollection); begin inherited Create(Collection); FUpColor := TAlphaColors.Green; FDownColor := TAlphaColors.Red; FCandleWidth := 0.8; FTimeInterval := TFuture.Construct(1.0); end; procedure TChartOhlcSeries.SetDataSeries(const Value: TFuture>); begin FTimeInterval := Value.Chain( function(const DataSeries: TDataSeries): Double var i: Int64; diff: Double; begin Result := 1.0; if DataSeries.Count < 2 then Exit; Result := MaxDouble; for i := 0 to DataSeries.Count - 2 do begin diff := Abs(DataSeries[i].Time - DataSeries[i + 1].Time); if (diff > 1E-9) and (diff < Result) then Result := diff; end; if (Result = MaxDouble) then Result := 1.0; end ); FBounds := Value.Chain( function(const DataSeries: TDataSeries): TRectD var i: Int64; begin if (DataSeries.Count = 0) then Exit(TRectD.Create(0, 0, 0, 0)); Result := TRectD.Create(DataSeries[0].Time, DataSeries[0].Data.High, DataSeries[0].Time, DataSeries[0].Data.Low); for i := 0 to DataSeries.Count - 1 do begin Result.ExpandBy(TPointD.Create(DataSeries[i].Time, DataSeries[i].Data.High)); Result.ExpandBy(TPointD.Create(DataSeries[i].Time, DataSeries[i].Data.Low)); end; end ); inherited SetDataSeries(Value); end; function TChartOhlcSeries.DataToPoint(const DataPoint: TDataPoint): TPointD; begin Result.X := DataPoint.Time; Result.Y := DataPoint.Data.Close; end; function TChartOhlcSeries.GetBounds: TFuture; begin Result := FBounds; end; function TChartOhlcSeries.GetYBoundsForXRange(const XRange: TRangeD): TFuture; begin Result := DataSeries.Chain( function(const Data: TDataSeries): TRangeD var i: Int64; dataPoint: TDataPoint; begin Result.A := Infinity; Result.B := NegInfinity; var n := Data.IndexOf(XRange.A); if n >= 0 then for i := 1 to Data.Count - 2 do begin dataPoint := Data[i]; var t := Double(dataPoint.Time); var t2 := Double(Data[i + 1].Time); if ((t >= XRange.A) and (t <= XRange.B)) or ((t2 >= XRange.A) and (t2 <= XRange.B)) then begin Result.A := System.Math.Min(Result.A, dataPoint.Data.Low); Result.B := System.Math.Max(Result.B, dataPoint.Data.High); end; end; if IsInfinite(Result.A) then begin Result.A := 0; Result.B := -1; end; end ); end; procedure TChartOhlcSeries.Draw(const ACanvas: TCanvas; const ADataRect: TRectD; const ACanvasRect: TRectF); var scaleX, scaleY: Double; i: Int64; dataPoint: TDataPoint; x_center, pixelCandleWidth, pixelCandleIntervalWidth: Single; y_high, y_low, y_open, y_close: Single; body: TRectF; data: TDataSeries; timeInterval: Double; begin if (not DataSeries.Done.IsSet) or (not FTimeInterval.Done.IsSet) then exit; data := DataSeries.Value; timeInterval := FTimeInterval.Value; if (data.Count = 0) or (ADataRect.Width <= 0) or (ADataRect.Height <= 0) then Exit; scaleX := ACanvasRect.Width / ADataRect.Width; scaleY := ACanvasRect.Height / ADataRect.Height; pixelCandleIntervalWidth := timeInterval * scaleX; pixelCandleWidth := System.Math.Max(1.0, FCandleWidth * pixelCandleIntervalWidth); for i := data.Count - 1 downto 0 do begin dataPoint := data[i]; if ((dataPoint.Time + timeInterval) < ADataRect.Left) or ((dataPoint.Time - timeInterval) > ADataRect.Right) then continue; 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 - pixelCandleWidth / 2, y_open, x_center + pixelCandleWidth / 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.InvalidateDataBounds; end; { TChart } constructor TChart.Create(AOwner: TComponent); begin inherited Create(AOwner); FSeries := TChartSeriesCollection.Create(Self); FAxisColor := TAlphaColors.Black; FGridColor := TAlphaColors.Lightgray; FPadding := 30; FIsPanning := False; FBoundsValid := False; FZoomMode := TChartZoomMode.czmXOnly; // Initialize futures with default empty values FDataBounds := TFuture.Construct(TRectD.Create(0, 0, 0, 0)); FDataView := TRectD.Create(0, 0, 0, 0); end; destructor TChart.Destroy; begin FSeries.Free; inherited Destroy; end; procedure TChart.BeforeDestruction; begin FYRange.WaitFor; FDataBounds.WaitFor; inherited; end; procedure TChart.InvalidateDataBounds; begin if FBoundsValid then InvalidateYRange; FBoundsValid := False; Repaint; end; procedure TChart.ResetView; begin if not FBoundsValid then RecalcDataBounds; // The view is reset to the full data bounds. FDataView := FDataBounds.WaitFor; InvalidateYRange; Repaint; end; procedure TChart.DblClick; begin inherited; ResetView; end; procedure TChart.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin inherited; if Button = TMouseButton.mbLeft then begin FIsPanning := True; FPanStartPoint := TPointF.Create(X, Y); Cursor := crHandPoint; end; end; procedure TChart.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin inherited; if FIsPanning and (Button = TMouseButton.mbLeft) then begin FIsPanning := False; Cursor := crDefault; end; end; procedure TChart.MouseMove(Shift: TShiftState; X, Y: Single); var canvasRect: TRectF; currentPoint, delta: TPointF; dataPerPixelX, dataPerPixelY: Double; dataShift: TPointD; begin inherited; if not FIsPanning then Exit; canvasRect := Self.LocalRect; canvasRect.Inflate(-FPadding, -FPadding); if (canvasRect.Width < 1) or (canvasRect.Height < 1) or (FDataView.Width <= 0) or (FDataView.Height <= 0) then Exit; currentPoint := TPointF.Create(X, Y); delta := TPointF.Create(currentPoint.X - FPanStartPoint.X, currentPoint.Y - FPanStartPoint.Y); if (delta.X = 0) and (delta.Y = 0) then Exit; dataPerPixelX := FDataView.Width / canvasRect.Width; dataPerPixelY := FDataView.Height / canvasRect.Height; dataShift.X := delta.X * dataPerPixelX; dataShift.Y := -delta.Y * dataPerPixelY; FDataView.Offset(-dataShift.X, -dataShift.Y); FPanStartPoint := currentPoint; InvalidateYRange; Repaint; end; procedure TChart.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); var zoomFactor: Double; canvasRect: TRectF; mouseScreenPos: TPointF; focalPoint: TPointD; newWidth, newHeight: Double; leftRatio, topRatio: Double; begin inherited; if WheelDelta = 0 then Exit; canvasRect := Self.LocalRect; canvasRect.Inflate(-FPadding, -FPadding); if (canvasRect.Width < 1) or (canvasRect.Height < 1) or (FDataView.Width <= 0) then Exit; if WheelDelta > 0 then zoomFactor := 1 / 1.25 else zoomFactor := 1.25; mouseScreenPos := Self.ScreenToLocal(Screen.MousePos); if not PtInRect(canvasRect, mouseScreenPos) then Exit; leftRatio := (mouseScreenPos.X - canvasRect.Left) / canvasRect.Width; focalPoint.X := FDataView.Left + FDataView.Width * leftRatio; newWidth := FDataView.Width * zoomFactor; FDataView.Left := focalPoint.X - newWidth * leftRatio; FDataView.Right := FDataView.Left + newWidth; case FZoomMode of czmXY: begin if (FDataView.Height <= 0) then Exit; topRatio := (canvasRect.Bottom - mouseScreenPos.Y) / canvasRect.Height; focalPoint.Y := FDataView.Top + FDataView.Height * topRatio; newHeight := FDataView.Height * zoomFactor; FDataView.Top := focalPoint.Y - newHeight * topRatio; FDataView.Bottom := FDataView.Top + newHeight; end; czmXOnly: begin // The scaling is done, now we chain the auto-scaling for the Y-axis. // We create a new future for the view and then call AutoScaleY. if FYRange.Done.IsSet then if FYRange.Value.A <= FYRange.Value.B then begin FDataView.Top := FYRange.Value.A; FDataView.Bottom := FYRange.Value.B; end; InvalidateYRange; Repaint; Handled := True; Exit; // Exit because AutoScaleY will trigger its own repaint. end; end; // For czmXY, we update the view future directly. Repaint; Handled := True; end; procedure TChart.Paint; var canvasRect: TRectF; series: TCollectionItem; begin inherited; Canvas.Fill.Color := TAlphaColors.White; Canvas.FillRect(LocalRect, 1); if not FBoundsValid then begin RecalcDataBounds; ResetView; end; if FSeries.Count = 0 then Exit; if (FDataView.Width <= 0) or (FDataView.Height <= 0) then Exit; canvasRect := Self.LocalRect; canvasRect.Inflate(-FPadding, -FPadding); if (canvasRect.Width < 1) or (canvasRect.Height < 1) then Exit; DrawGrid(Canvas, FDataView, canvasRect); DrawAxes(Canvas, FDataView, canvasRect); for series in FSeries do begin (series as TChartSeries).Draw(Canvas, FDataView, canvasRect); end; end; procedure TChart.RecalcDataBounds; var series: TCollectionItem; boundFutures: TList>; begin boundFutures := TList>.Create; try for series in FSeries do boundFutures.Add((series as TChartSeries).GetBounds); FDataBounds := TFuture .FromArray(boundFutures.ToArray) .Chain( function(const Rects: TArray): TRectD var minPt, maxPt: TPointD; begin if Length(Rects) = 0 then Exit(TRectD.Create(0, 0, 0, 0)); minPt := TPointD.Create(Infinity, Infinity); maxPt := TPointD.Create(NegInfinity, NegInfinity); for var rect in Rects do begin minPt.X := System.Math.Min(minPt.X, rect.Left); minPt.Y := System.Math.Min(minPt.Y, rect.Top); maxPt.X := System.Math.Max(maxPt.X, rect.Right); maxPt.Y := System.Math.Max(maxPt.Y, rect.Bottom); end; if IsInfinite(minPt.X) then Exit(TRectD.Create(0, 0, 0, 0)); if (minPt.X = maxPt.X) then begin maxPt.X := minPt.X + 1; end; if (minPt.Y = maxPt.Y) then begin maxPt.Y := minPt.Y + 1; minPt.Y := minPt.Y - 1; end; Result := TRectD.Create(minPt.X, minPt.Y, maxPt.X, maxPt.Y); end); finally boundFutures.Free; end; FBoundsValid := True; 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.InvalidateYRange; var Arr: TArray>; begin SetLength(Arr, FSeries.Count); for var i := 0 to High(Arr) do Arr[i] := (FSeries[i] as TChartSeries).GetYBoundsForXRange(TRangeD.Create(FDataView.Left, FDataView.Right)); var yBounds := TFuture.FromArray(Arr); FYRange := yBounds.Chain( function(const Ranges: TArray): TRangeD var yRange: Double; begin Result.A := Infinity; Result.B := NegInfinity; for var range in Ranges do if range.A <= range.B then begin Result.A := System.Math.Min(Result.A, range.A); Result.B := System.Math.Max(Result.B, range.B); end; if IsInfinite(Result.A) then begin // No data in view, use previous view's Y-range or default Result.A := 0; Result.B := -1; exit; end; yRange := Result.B - Result.A; if yRange = 0 then yRange := Abs(Result.A * 0.1); Result.A := Result.A - yRange * 0.05; Result.B := Result.B + yRange * 0.05; end ); end; procedure TChart.SetSeries(const Value: TChartSeriesCollection); begin FSeries.Assign(Value); InvalidateDataBounds; 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; { TTestChartForm } procedure TTestChartForm.FormCreate(Sender: TObject); var askSeries, bidSeries: TChartLineSeries; ohlc: TChartOhlcSeries; askBidSeries: TFuture>; askData, bidData: TFuture>; begin FChart := TChart.Create(Self); FChart.Parent := Self; FChart.Align := TAlignLayout.Client; askBidSeries := TFuture>.Construct( function: TDataSeries var askBidDataPointList: TArray>; lastPrice: Double; currentTime: TDateTime; i: Integer; const cnt = 200000; begin SetLength(askBidDataPointList, cnt); lastPrice := 100.0; currentTime := Now; for i := 0 to cnt - 1 do begin lastPrice := lastPrice + (Random - 0.495) * 0.1; currentTime := currentTime + TTimeSpan.FromMilliseconds(500 + (Random(500) - 250)); askBidDataPointList[i] := TDataPoint.Create(currentTime, TAskBidItem.Create(lastPrice, lastPrice * 0.9998)); end; Result := TDataSeries.CreateDataSeries(cnt, askBidDataPointList); end ); askData := askBidSeries.Chain>( function(const AskBid: TDataSeries): TDataSeries begin Result := AskBid.Convert(function(const Val: TDataPoint): Double begin Result := Val.Data.Ask end); end ); bidData := askBidSeries.Chain>( function(const AskBid: TDataSeries): TDataSeries begin Result := AskBid.Convert(function(const Val: TDataPoint): Double begin Result := Val.Data.Bid end); end ); askSeries := TChartLineSeries.Create(FChart.Series); askSeries.DataSeries := askData; askSeries.Color := TAlphaColors.Blue; askSeries.Thickness := 1; bidSeries := TChartLineSeries.Create(FChart.Series); bidSeries.DataSeries := bidData; bidSeries.Color := TAlphaColors.Red; bidSeries.Thickness := 1; ohlc := TChartOhlcSeries.Create(FChart.Series); ohlc.DataSeries := askData.Chain>( function(const Data: TDataSeries): TDataSeries begin Result := Data.ToOhlc(TTimeSpan.FromMinutes(15)); end ); ohlc.Color := TAlphaColors.Black; ohlc.Thickness := 1; end; constructor TRangeD.Create(const AA, AB: Double); begin A := AA; B := AB; end; end.