Chart data logic separation
This commit is contained in:
Michael Schimmel
@@ -0,0 +1,282 @@
|
||||
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.
|
||||
@@ -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.
|
||||
@@ -66,7 +66,7 @@ type
|
||||
private
|
||||
FProc: TProc;
|
||||
protected
|
||||
function ProcessData(const Value: T): Boolean; override;
|
||||
function ProcessData(const Value: T): Boolean; override; final;
|
||||
public
|
||||
constructor Create(const AProc: TProc);
|
||||
end;
|
||||
@@ -81,6 +81,27 @@ type
|
||||
constructor Create(const Controller: IInterface; const AProc: TProc);
|
||||
end;
|
||||
|
||||
IMycConverter<S, T> = interface(IMycProcessor<S>)
|
||||
function GetSender: IMycDataProvider<T>;
|
||||
property Sender: IMycDataProvider<T> read GetSender;
|
||||
end;
|
||||
|
||||
TMycConverter<S, T> = class abstract(TMycProcessor<S>, IMycConverter<S, T>)
|
||||
private
|
||||
FSender: TMycDataProvider<T>;
|
||||
function GetSender: IMycDataProvider<T>;
|
||||
protected
|
||||
function ProcessData(const Value: S): Boolean; override; abstract;
|
||||
|
||||
// Broadcasts the given data to all linked processors.
|
||||
procedure Broadcast(const Value: T);
|
||||
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
property Sender: IMycDataProvider<T> read GetSender;
|
||||
end;
|
||||
|
||||
// An immutable time-ordered series of data points.
|
||||
// The most recent element has the logical index 0.
|
||||
IDataSeries<T> = interface
|
||||
@@ -508,4 +529,29 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TMycConverter<S, T> }
|
||||
|
||||
constructor TMycConverter<S, T>.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FSender := TMycDataProvider<T>.Create(Self);
|
||||
end;
|
||||
|
||||
destructor TMycConverter<S, T>.Destroy;
|
||||
begin
|
||||
FSender.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TMycConverter<S, T>.Broadcast(const Value: T);
|
||||
begin
|
||||
var cValue := Value;
|
||||
FSender.Notify(function(const Processor: IMycProcessor<T>): Boolean begin Result := Processor.ProcessData(cValue) end);
|
||||
end;
|
||||
|
||||
function TMycConverter<S, T>.GetSender: IMycDataProvider<T>;
|
||||
begin
|
||||
Result := FSender;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user