Chart data logic separation
This commit is contained in:
Michael Schimmel
@@ -0,0 +1,537 @@
|
||||
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<Double, Single>); 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<TSeries>;
|
||||
FXAxisSeries: TSeries;
|
||||
FLookback: TWriteable<Int64>;
|
||||
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<T>(const DataProvider: IMycDataProvider<T>): 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<TOhlcItem>;
|
||||
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<Double>;
|
||||
const ALineColor: TAlphaColor = TAlphaColors.Cornflowerblue;
|
||||
const ALineWidth: Single = 1.5
|
||||
): TSeries;
|
||||
|
||||
property Lookback: TWriteable<Int64> 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<Double, Single>);
|
||||
begin
|
||||
// nothing
|
||||
end;
|
||||
|
||||
{ TMycChart }
|
||||
|
||||
constructor TMycChart.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FSeriesList := TObjectList<TSeries>.Create(true);
|
||||
FXAxisSeries := nil;
|
||||
|
||||
FLookback := TWriteable<Int64>.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<T>(const DataProvider: IMycDataProvider<T>): TSeries;
|
||||
begin
|
||||
// Free the old one if it exists, and create the new master series
|
||||
FXAxisSeries.Free;
|
||||
|
||||
var counter := TChartSeriesCounter<T>.Create;
|
||||
|
||||
DataProvider.Link(counter);
|
||||
|
||||
FXAxisSeries := TChartSeriesProcessor<Int64>.Create(Self, counter.Sender);
|
||||
Result := FXAxisSeries;
|
||||
end;
|
||||
|
||||
function TMycChart.AddDoubleSeries(
|
||||
const DataProvider: IMycDataProvider<Double>;
|
||||
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<TOhlcItem>;
|
||||
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<Double, Single>;
|
||||
yTransform: TFunc<Double, Single>;
|
||||
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.
|
||||
Reference in New Issue
Block a user