unit Myc.Fmx.Chart; interface uses System.SysUtils, System.Classes, System.Types, System.Generics.Collections, System.UITypes, System.UIConsts, System.Messaging, System.Math.Vectors, FMX.Types, FMX.Controls, FMX.Graphics, FMX.Forms, Myc.Trade.DataPoint, Myc.Lazy; type TMycChart = class(TStyledControl) public type TSeries = class abstract(TObject) private FOwner: TMycChart; function GetMainSeries: TSeries; protected function GetCount: Int64; virtual; abstract; function GetTotalCount: Int64; virtual; abstract; procedure Update; virtual; abstract; function GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; virtual; // The signature is changed to support viewport painting with an index offset procedure Paint(const Canvas: TCanvas; First, Last: Int64; const XForm, YForm: TFunc); virtual; property MainSeries: TSeries read GetMainSeries; public constructor Create(AOwner: TMycChart); property Count: Int64 read GetCount; property Owner: TMycChart read FOwner; property TotalCount: Int64 read GetTotalCount; end; private FSeriesList: TList; FXAxisSeries: TSeries; FLookback: TWriteable; FIdleSubscrId: TMessageSubscriptionId; FViewStartIndex: Int64; FViewCount: Int64; FIsDragging: Boolean; FDragStartPoint: TPointF; FJumpButtonRect: TRectF; FJumpButtonHot: Boolean; FJumpButtonPressed: Boolean; protected procedure Paint; override; procedure DoIdle; procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override; 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; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; // Sets the master series that defines the time scale (X-axis). This series is not drawn. // The chart will not render any data until the X-axis series is set. function SetXAxisSeries(const DataProvider: IMycDataProvider): TSeries; // Creates an OHLC candlestick/bar series and returns it. // The data provider directly supplies OHLC items, as timestamps are managed by the data series internally. function AddOhlcSeries( const DataProvider: IMycDataProvider; const AUpColor: TAlphaColor = TAlphaColors.Green; const ADownColor: TAlphaColor = TAlphaColors.Red ): TSeries; // Creates a simple line series for double values and returns it function AddDoubleSeries( const DataProvider: IMycDataProvider; const ALineColor: TAlphaColor = TAlphaColors.Cornflowerblue; const ALineWidth: Single = 1.5 ): TSeries; property Lookback: TWriteable read FLookback write FLookback; end; implementation uses System.Math, Myc.FMX.Chart.Series; constructor TMycChart.TSeries.Create(AOwner: TMycChart); begin inherited Create; FOwner := AOwner; end; function TMycChart.TSeries.GetMainSeries: TSeries; begin Result := Owner.FXAxisSeries; end; function TMycChart.TSeries.GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; begin Result := false; end; procedure TMycChart.TSeries.Paint(const Canvas: TCanvas; First, Last: Int64; const XForm, YForm: TFunc); begin // nothing end; { TMycChart } constructor TMycChart.Create(AOwner: TComponent); begin inherited Create(AOwner); FSeriesList := TObjectList.Create(true); FXAxisSeries := nil; FLookback := TWriteable.CreateWriteable(1000); // Load more data for panning FViewStartIndex := 0; FViewCount := 100; // Show 100 items by default FIsDragging := false; FIdleSubscrId := TMessageManager .DefaultManager .SubscribeToMessage(TIdleMessage, procedure(const Sender: TObject; const M: TMessage) begin DoIdle; end); end; destructor TMycChart.Destroy; begin TMessageManager.DefaultManager.Unsubscribe(TIdleMessage, FIdleSubscrId); FXAxisSeries.Free; FSeriesList.Free; inherited; end; function TMycChart.SetXAxisSeries(const DataProvider: IMycDataProvider): TSeries; begin // Free the old one if it exists, and create the new master series FXAxisSeries.Free; var counter := TChartSeriesCounter.Create; DataProvider.Link(counter); FXAxisSeries := TChartSeriesProcessor.Create(Self, counter.Sender); Result := FXAxisSeries; end; function TMycChart.AddDoubleSeries( const DataProvider: IMycDataProvider; const ALineColor: TAlphaColor = TAlphaColors.Cornflowerblue; const ALineWidth: Single = 1.5 ): TSeries; begin Result := TChartLineSeries.Create(Self, DataProvider, ALineColor, ALineWidth); FSeriesList.Add(Result); end; function TMycChart.AddOhlcSeries( const DataProvider: IMycDataProvider; const AUpColor: TAlphaColor = TAlphaColors.Green; const ADownColor: TAlphaColor = TAlphaColors.Red ): TSeries; begin Result := TChartOhlcSeries.Create(Self, DataProvider, AUpColor, ADownColor); FSeriesList.Add(Result); end; procedure TMycChart.DoIdle; begin // An X-axis series is required for any operation if not Assigned(FXAxisSeries) then exit; // First update the master series var prevTotalCount := FXAxisSeries.TotalCount; FXAxisSeries.Update; // Check if the master series itself has changed var newTotalCount := FXAxisSeries.TotalCount; var seriesChanged := prevTotalCount <> newTotalCount; // Repaint if the last bar is visible, so we display live data var seriesRepaint := FViewStartIndex = 0; for var series in FSeriesList do begin var seriesCount := series.TotalCount; // Check if this series may need a repaint (if it lags behind the master series and these lags are currently visible) if FViewStartIndex <= prevTotalCount - seriesCount then seriesRepaint := true; // Update the series series.Update; if seriesCount <> series.TotalCount then seriesChanged := true; end; // Don't move chart, if the last bar isn't visible if FViewStartIndex > 0 then begin var countDelta := newTotalCount - prevTotalCount; if countDelta > 0 then begin // Adjust the start index based on the absolute change in total data points FViewStartIndex := FViewStartIndex + countDelta; // Clamp to beginning of dataset if FViewStartIndex + FViewCount > newTotalCount then FViewStartIndex := newTotalCount - FViewCount; end; end; if seriesRepaint and seriesChanged then Repaint; end; procedure TMycChart.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin // Check for button press first if (Button = TMouseButton.mbLeft) and (FViewStartIndex > 0) and FJumpButtonRect.Contains(PointF(X, Y)) then begin FJumpButtonPressed := true; Repaint; exit; // Prevent chart dragging end; inherited MouseDown(Button, Shift, X, Y); if (Button = TMouseButton.mbLeft) then begin FIsDragging := true; FDragStartPoint := TPointF.Create(X, Y); end; end; procedure TMycChart.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); begin // Check if a button press was active if FJumpButtonPressed then begin FJumpButtonPressed := false; // If mouse is released over the button, trigger the action if (FViewStartIndex > 0) and FJumpButtonRect.Contains(PointF(X, Y)) then begin FViewStartIndex := 0; // Jump to the latest candle end; Repaint; exit; end; inherited MouseUp(Button, Shift, X, Y); if (Button = TMouseButton.mbLeft) then begin FIsDragging := false; end; end; procedure TMycChart.MouseMove(Shift: TShiftState; X, Y: Single); var isHot: Boolean; dx: Single; indexDelta: Int64; mainSeries: TSeries; maxIndex: Int64; begin // Update button hot state if (FViewStartIndex > 0) then begin isHot := FJumpButtonRect.Contains(PointF(X, Y)); if (isHot <> FJumpButtonHot) then begin FJumpButtonHot := isHot; Repaint; end; end else begin // Ensure hot state is off when button is not visible if FJumpButtonHot then begin FJumpButtonHot := false; Repaint; end; end; // Panning logic inherited MouseMove(Shift, X, Y); if FIsDragging then begin dx := X - FDragStartPoint.X; if Abs(dx) < 2 then // Threshold to avoid jitter begin exit; end; // An X-axis series is required for panning if not Assigned(FXAxisSeries) or (FViewCount <= 0) then begin exit; end; indexDelta := Round(dx / (Self.Width / FViewCount)); // To move content left (natural), view must shift to newer data (lower index). // Drag left (dx < 0) -> FViewStartIndex must decrease. // The formula for that is FViewStartIndex := FViewStartIndex + indexDelta; -> StartIndex + (negative) = decrease. FViewStartIndex := FViewStartIndex + indexDelta; // Clamp values mainSeries := FXAxisSeries; maxIndex := mainSeries.Count - FViewCount; if (maxIndex < 0) then maxIndex := 0; if (FViewStartIndex < 0) then FViewStartIndex := 0; if (FViewStartIndex > maxIndex) then FViewStartIndex := maxIndex; FDragStartPoint.X := X; FDragStartPoint.Y := Y; Repaint; end; end; procedure TMycChart.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); var mousePos: TPointF; anchorIndex: Double; zoomFactor: Double; newViewCount: Int64; ratio: Double; mainSeries: TSeries; begin Handled := true; // An X-axis series is required for zooming if not Assigned(FXAxisSeries) then exit; mainSeries := FXAxisSeries; if (mainSeries.Count = 0) or (Width <= 0) then exit; mousePos := ScreenToLocal(Screen.MousePos); // Calculate the anchor index for a right-to-left axis anchorIndex := FViewStartIndex + ((Self.Width - mousePos.X) / Self.Width) * FViewCount; if (WheelDelta > 0) then zoomFactor := 0.8 // Zoom In else zoomFactor := 1.25; // Zoom Out newViewCount := Round(FViewCount * zoomFactor); // Clamp zoom level if (newViewCount < 10) then newViewCount := 10; if (newViewCount > mainSeries.Count) then newViewCount := mainSeries.Count; if (newViewCount = FViewCount) then exit; // Adjust start index to keep anchor point stable if (FViewCount > 0) then ratio := (anchorIndex - FViewStartIndex) / FViewCount else ratio := 0; FViewStartIndex := Round(anchorIndex - (ratio * newViewCount)); FViewCount := newViewCount; // Clamp start index if (FViewStartIndex < 0) then FViewStartIndex := 0; if (FViewStartIndex + FViewCount > mainSeries.Count) then begin FViewStartIndex := mainSeries.Count - FViewCount; end; Repaint; end; procedure TMycChart.Paint; function CalcView(Series: TSeries; MasterCount: Int64; out First: Int64; out Last: Int64): Boolean; begin var seriesTotalCount := series.TotalCount; var offset := MasterCount - seriesTotalCount; var startIdx := FViewStartIndex - offset; First := Max(0, startIdx); Last := Min(series.Count, startIdx + FViewCount) - 1; Result := First <= Last - 1; end; var rect: TRectF; series: TSeries; globalMin, globalMax, seriesMin, seriesMax, padding: Double; rangeInitialized: Boolean; xTransform: TFunc; yTransform: TFunc; isButtonVisible: Boolean; buttonColor: TAlphaColor; path: TPathData; mainSeries: TSeries; masterTotalCount, seriesFirst, seriesLast: Int64; begin inherited; rect := Self.LocalRect; // The chart requires an X-axis series to be set before it can draw anything. if not Assigned(FXAxisSeries) or (FXAxisSeries.Count <= 1) or (FViewCount <= 1) then begin Canvas.Fill.Color := TAlphaColors.Gray; Canvas.FillText(rect, 'No Data', false, 1, [], TTextAlign.Center, TTextAlign.Center); Exit; end; rangeInitialized := false; mainSeries := FXAxisSeries; masterTotalCount := mainSeries.TotalCount; for series in FSeriesList do begin if CalcView(series, masterTotalCount, seriesFirst, seriesLast) then begin if series.GetValueRange(seriesFirst, seriesLast, seriesMin, seriesMax) then begin if not rangeInitialized then begin globalMin := seriesMin; globalMax := seriesMax; rangeInitialized := true; end else begin globalMin := Min(globalMin, seriesMin); globalMax := Max(globalMax, seriesMax); end; end; end; end; if not rangeInitialized then Exit; padding := (globalMax - globalMin) * 0.1; globalMin := globalMin - padding; globalMax := globalMax + padding; if (globalMax - globalMin) = 0 then exit; // Base transform maps an index from the viewport to a screen coordinate yTransform := function(value: Double): Single begin Result := rect.Top + (1 - (value - globalMin) / (globalMax - globalMin)) * rect.Height; end; // --- Draw Series with Offset Compensation --- // The masterTotalCount is already calculated from the range finding loop for series in FSeriesList do begin if CalcView(series, masterTotalCount, seriesFirst, seriesLast) then begin var offset := masterTotalCount - series.TotalCount; xTransform := function(index: Double): Single begin Result := rect.Right - (((index + offset - FViewStartIndex) / (FViewCount - 1)) * rect.Width); end; series.Paint(Self.Canvas, seriesFirst, seriesLast, xTransform, yTransform); end; end; // --- Draw the "jump to latest" button --- isButtonVisible := (FViewStartIndex > 0); if isButtonVisible then begin // Define button position and size FJumpButtonRect := TRectF.Create(Self.Width - 44, Self.Height - 44, Self.Width - 10, Self.Height - 10); // Determine color based on state if FJumpButtonPressed then buttonColor := $FF707070 // Pressed color else if FJumpButtonHot then buttonColor := $FF505050 // Hover color else buttonColor := $FF303030; // Default color // Draw button background Canvas.Fill.Color := buttonColor; Canvas.FillRect(FJumpButtonRect, 4, 4, AllCorners, 0.7); // Draw an icon Canvas.Stroke.Color := TAlphaColors.White; Canvas.Stroke.Thickness := 1.5; path := TPathData.Create; try var cx := FJumpButtonRect.CenterPoint.X; var cy := FJumpButtonRect.CenterPoint.Y; path.MoveTo(PointF(cx - 5, cy - 6)); path.LineTo(PointF(cx, cy)); path.LineTo(PointF(cx - 5, cy + 6)); path.MoveTo(PointF(cx + 2, cy - 6)); path.LineTo(PointF(cx + 7, cy)); path.LineTo(PointF(cx + 2, cy + 6)); Canvas.DrawPath(path, 1); finally path.Free; end; end else begin // Reset button state when not visible FJumpButtonRect := TRectF.Empty; FJumpButtonPressed := false; end; end; end.