Chart Panning+Zooming

This commit is contained in:
Michael Schimmel
2025-07-12 16:58:34 +02:00
parent 4727db1a01
commit 1b0f93c633
3 changed files with 380 additions and 85 deletions
+1 -1
View File
@@ -4,7 +4,7 @@
<ProjectVersion>20.3</ProjectVersion> <ProjectVersion>20.3</ProjectVersion>
<FrameworkType>FMX</FrameworkType> <FrameworkType>FMX</FrameworkType>
<Base>True</Base> <Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config> <Config Condition="'$(Config)'==''">Release</Config>
<Platform Condition="'$(Platform)'==''">Win64</Platform> <Platform Condition="'$(Platform)'==''">Win64</Platform>
<ProjectName Condition="'$(ProjectName)'==''">AuraTrader</ProjectName> <ProjectName Condition="'$(ProjectName)'==''">AuraTrader</ProjectName>
<TargetedPlatforms>3</TargetedPlatforms> <TargetedPlatforms>3</TargetedPlatforms>
+1 -1
View File
@@ -165,7 +165,7 @@ begin
var chart := TMycChart.Create(Self); var chart := TMycChart.Create(Self);
AlignControl( chart ); AlignControl( chart );
chart.Height := Layout.ChildrenRect.Width*9/16; chart.Height := Layout.ChildrenRect.Width*9/16;
chart.Lookback.Value := 1000; chart.Lookback.Value := 50000;
///// /////
+378 -83
View File
@@ -14,6 +14,7 @@ uses
FMX.Types, FMX.Types,
FMX.Controls, FMX.Controls,
FMX.Graphics, FMX.Graphics,
FMX.Forms,
Myc.Trade.DataPoint, Myc.Trade.DataPoint,
Myc.Signals, Myc.Signals,
Myc.Lazy; Myc.Lazy;
@@ -22,32 +23,41 @@ type
TCandleStyle = (csCandleStick, csHiLoBar); TCandleStyle = (csCandleStick, csHiLoBar);
TMycChart = class(TStyledControl) TMycChart = class(TStyledControl)
type public type
TSeries = class abstract(TObject) TSeries = class abstract(TObject)
private private
FOwner: TMycChart; FOwner: TMycChart;
function GetMainSeries: TSeries; function GetMainSeries: TSeries;
protected protected
function GetCount: Int64; virtual; abstract; function GetCount: Int64; virtual; abstract;
function GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; virtual; abstract; function GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; virtual; abstract;
function Update: Boolean; virtual; abstract; function Update: Boolean; virtual; abstract;
procedure Paint(const ACanvas: TCanvas; Lookback: Int64; const AXForm, AYForm: TFunc<Double, Single>); virtual; abstract; // The signature is changed to support viewport painting
procedure Paint(const ACanvas: TCanvas; StartIndex, Count: Int64; const AXForm, AYForm: TFunc<Double, Single>); virtual; abstract;
property MainSeries: TSeries read GetMainSeries;
public
constructor Create(AOwner: TMycChart);
property Count: Int64 read GetCount;
property Owner: TMycChart read FOwner;
end;
property MainSeries: TSeries read GetMainSeries; private
FSeriesList: TList<TSeries>;
public FLookback: TWriteable<Int64>;
constructor Create(AOwner: TMycChart); FIdleSubscrId: TMessageSubscriptionId;
property Count: Int64 read GetCount; FViewStartIndex: Int64;
property Owner: TMycChart read FOwner; FViewCount: Int64;
end; FIsDragging: Boolean;
FDragStartPoint: TPointF;
private FJumpButtonRect: TRectF;
FSeriesList: TList<TSeries>; FJumpButtonHot: Boolean;
FLookback: TWriteable<Int64>; FJumpButtonPressed: Boolean; protected
FIdleSubscrId: TMessageSubscriptionId;
protected
procedure Paint; override; procedure Paint; override;
procedure DoIdle; 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 public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy; override; destructor Destroy; override;
@@ -120,8 +130,8 @@ type
FDownColor: TAlphaColor; FDownColor: TAlphaColor;
FStyle: TCandleStyle; FStyle: TCandleStyle;
protected protected
function GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; override; function GetValueRange(StartIndex, Count: Int64; out MinValue, MaxValue: Double): Boolean; override;
procedure Paint(const ACanvas: TCanvas; Lookback: Int64; const AXForm, AYForm: TFunc<Double, Single>); override; procedure Paint(const ACanvas: TCanvas; StartIndex, Count: Int64; const AXForm, AYForm: TFunc<Double, Single>); override;
public public
constructor Create( constructor Create(
AOwner: TMycChart; AOwner: TMycChart;
@@ -137,8 +147,8 @@ type
FLineColor: TAlphaColor; FLineColor: TAlphaColor;
FLineWidth: Single; FLineWidth: Single;
protected protected
function GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; override; function GetValueRange(StartIndex, Count: Int64; out MinValue, MaxValue: Double): Boolean; override;
procedure Paint(const ACanvas: TCanvas; Lookback: Int64; const AXForm, AYForm: TFunc<Double, Single>); override; procedure Paint(const ACanvas: TCanvas; StartIndex, Count: Int64; const AXForm, AYForm: TFunc<Double, Single>); override;
public public
constructor Create( constructor Create(
AOwner: TMycChart; AOwner: TMycChart;
@@ -159,7 +169,7 @@ end;
function TMycChart.TSeries.GetMainSeries: TSeries; function TMycChart.TSeries.GetMainSeries: TSeries;
begin begin
Result := nil; Result := nil;
if Owner.FSeriesList.Count > 0 then if (Owner.FSeriesList.Count > 0) then
Result := Owner.FSeriesList[0]; Result := Owner.FSeriesList[0];
end; end;
@@ -170,7 +180,10 @@ begin
inherited Create(AOwner); inherited Create(AOwner);
FSeriesList := TObjectList<TSeries>.Create(true); FSeriesList := TObjectList<TSeries>.Create(true);
FLookback := TWriteable<Int64>.CreateWriteable( 100 ); FLookback := TWriteable<Int64>.CreateWriteable( 1000 ); // Load more data for panning
FViewStartIndex := 0;
FViewCount := 100; // Show 100 items by default
FIsDragging := false;
FIdleSubscrId := FIdleSubscrId :=
TMessageManager TMessageManager
@@ -212,13 +225,219 @@ begin
end; end;
procedure TMycChart.DoIdle; procedure TMycChart.DoIdle;
var
doRepaint: Boolean;
mainSeries: TSeries;
isLiveView: Boolean;
prevCount, newCount, newCandles: Int64;
begin begin
var doRepaint := false; if (FSeriesList.Count = 0) then
begin
exit;
end;
mainSeries := FSeriesList[0];
if (mainSeries = nil) then
begin
exit;
end;
// Remember state before update
isLiveView := (FViewStartIndex = 0);
prevCount := mainSeries.Count;
// Check all series for updates
doRepaint := false;
for var series in FSeriesList do for var series in FSeriesList do
begin
if series.Update then if series.Update then
begin
doRepaint := true; doRepaint := true;
end;
end;
if doRepaint then if doRepaint then
begin
newCount := mainSeries.Count;
newCandles := newCount - prevCount;
// Adjust viewport only if user was not watching the live data
if (not isLiveView) and (newCandles > 0) then
begin
FViewStartIndex := FViewStartIndex + newCandles;
end;
// If the view was live, it implicitly stays at StartIndex = 0, showing the new data.
Repaint; Repaint;
end;
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;
if (FSeriesList.Count = 0) 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 := FSeriesList[0];
maxIndex := 0;
if (mainSeries <> nil) then
begin
maxIndex := mainSeries.Count - FViewCount;
end;
if (maxIndex < 0) then
begin
maxIndex := 0;
end;
if (FViewStartIndex < 0) then FViewStartIndex := 0;
if (FViewStartIndex > maxIndex) then FViewStartIndex := maxIndex;
FDragStartPoint := TPointF.Create(X, 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;
if (FSeriesList.Count = 0) then
begin
exit;
end;
mainSeries := FSeriesList[0];
if (mainSeries = nil) or (mainSeries.Count = 0) or (Self.Width <= 0) then
begin
exit;
end;
mousePos := Self.ScreenToLocal(Screen.MousePos);
// Correctly 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; end;
procedure TMycChart.Paint; procedure TMycChart.Paint;
@@ -229,12 +448,14 @@ var
rangeInitialized: Boolean; rangeInitialized: Boolean;
xTransform: TFunc<Double, Single>; xTransform: TFunc<Double, Single>;
yTransform: TFunc<Double, Single>; yTransform: TFunc<Double, Single>;
isButtonVisible: Boolean;
buttonColor: TAlphaColor;
path: TPathData;
begin begin
inherited; inherited;
rect := Self.LocalRect; rect := Self.LocalRect;
var lookback := FLookback.Value;
if (FSeriesList.Count = 0) or (lookback <= 1) then if (FSeriesList.Count = 0) or (FViewCount <= 1) then
begin begin
Canvas.Fill.Color := TAlphaColors.Gray; Canvas.Fill.Color := TAlphaColors.Gray;
Canvas.FillText(rect, 'No Data', false, 1, [], TTextAlign.Center, TTextAlign.Center); Canvas.FillText(rect, 'No Data', false, 1, [], TTextAlign.Center, TTextAlign.Center);
@@ -243,9 +464,10 @@ begin
rangeInitialized := false; rangeInitialized := false;
// Determine value range for the visible viewport only
for series in FSeriesList do for series in FSeriesList do
begin begin
if series.GetValueRange(0, lookback, seriesMin, seriesMax) then if series.GetValueRange(FViewStartIndex, FViewCount, seriesMin, seriesMax) then
begin begin
if not rangeInitialized then if not rangeInitialized then
begin begin
@@ -271,18 +493,75 @@ begin
if (globalMax - globalMin) = 0 then if (globalMax - globalMin) = 0 then
exit; exit;
xTransform := function(index: Double): Single begin Result := rect.Right - (index / (lookback - 1)) * rect.Width; end; // Transform maps an index from the viewport to a screen coordinate
xTransform := function(index: Double): Single
begin
if (FViewCount <= 1) then
begin
Result := rect.Left + rect.Width / 2;
exit;
end;
Result := rect.Right - (((index - FViewStartIndex) / (FViewCount - 1)) * rect.Width);
end;
yTransform := yTransform :=
function(value: Double): Single begin Result := rect.Top + (1 - (value - globalMin) / (globalMax - globalMin)) * rect.Height; end; function(value: Double): Single
begin
// var T := Result := rect.Top + (1 - (value - globalMin) / (globalMax - globalMin)) * rect.Height;
// TMatrix.CreateTranslation(rect.Left, rect.Top + rect.Height*globalMax / (globalMax - globalMin)) * end;
// TMatrix.CreateScaling(rect.Width / (FLookback - 1), -rect.Height / (globalMax - globalMin));
for series in FSeriesList do for series in FSeriesList do
begin begin
series.Paint(Self.Canvas, lookback, xTransform, yTransform); series.Paint(Self.Canvas, FViewStartIndex, FViewCount, xTransform, yTransform);
end;
// --- Draw the "jump to latest" button ---
isButtonVisible := (FViewStartIndex > 0);
FJumpButtonHot := FJumpButtonHot and isButtonVisible;
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 (e.g., a "fast forward" double arrow)
Canvas.Stroke.Color := TAlphaColors.White;
Canvas.Stroke.Thickness := 1.5;
path := TPathData.Create;
try
var cx := FJumpButtonRect.CenterPoint.X;
var cy := FJumpButtonRect.CenterPoint.Y;
// First arrow
path.MoveTo(PointF(cx - 5, cy - 6));
path.LineTo(PointF(cx, cy));
path.LineTo(PointF(cx - 5, cy + 6));
// Second arrow
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; end;
@@ -330,43 +609,47 @@ begin
FStyle := AStyle; FStyle := AStyle;
end; end;
function TChartOhlcSeries.GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; function TChartOhlcSeries.GetValueRange(StartIndex, Count: Int64; out MinValue, MaxValue: Double): Boolean;
var var
i: Int64; i: Int64;
lastIndex: Int64;
begin begin
Result := GetCount > 0; Result := GetCount > 0;
if not Result then if not Result then
Exit; Exit;
Min := MaxDouble; MinValue := MaxDouble;
Max := -MaxDouble; MaxValue := -MaxDouble;
for i := StartIndex to System.Math.Min(GetCount - 1, StartIndex + Count - 1) do lastIndex := Min(GetCount - 1, StartIndex + Count - 1);
for i := StartIndex to lastIndex do
begin begin
var dp := Data.Items[i]; var dp := Data.Items[i];
Min := System.Math.Min(Min, dp.Data.Low); MinValue := Min(MinValue, dp.Data.Low);
Max := System.Math.Max(Max, dp.Data.High); MaxValue := Max(MaxValue, dp.Data.High);
end; end;
Result := (Min <> MaxDouble); Result := (MinValue <> MaxDouble);
end; end;
procedure TChartOhlcSeries.Paint(const ACanvas: TCanvas; Lookback: Int64; const AXForm, AYForm: TFunc<Double, Single>); procedure TChartOhlcSeries.Paint(const ACanvas: TCanvas; StartIndex, Count: Int64; const AXForm, AYForm: TFunc<Double, Single>);
var var
i, displayCount: Int64; i: Int64;
lastIndex: Int64;
x, candleWidth: Single; x, candleWidth: Single;
yOpen, yHigh, yLow, yClose: Single; yOpen, yHigh, yLow, yClose: Single;
item: TDataPoint<TOhlcItem>; item: TDataPoint<TOhlcItem>;
isUp: boolean; isUp: boolean;
begin begin
displayCount := System.Math.Min(Data.Count, Lookback); if (Count <= 0) then
if displayCount <= 0 then
Exit; Exit;
if displayCount > 1 then if (Count > 1) then
candleWidth := Max(2, 0.8 * Abs((AXForm(1) - AXForm(0)))) candleWidth := Max(2, 0.8 * Abs((AXForm(StartIndex + 1) - AXForm(StartIndex))))
else else
candleWidth := 10; candleWidth := 10;
for i := 0 to displayCount - 1 do lastIndex := Min(Data.Count - 1, StartIndex + Count - 1);
for i := StartIndex to lastIndex do
begin begin
item := Data.Items[i]; item := Data.Items[i];
x := AXForm(i); x := AXForm(i);
@@ -384,7 +667,7 @@ begin
ACanvas.DrawLine(TPointF.Create(x, yHigh), TPointF.Create(x, yLow), 1); ACanvas.DrawLine(TPointF.Create(x, yHigh), TPointF.Create(x, yLow), 1);
if FStyle = csCandleStick then if (FStyle = csCandleStick) then
begin begin
ACanvas.Fill.Color := ACanvas.Stroke.Color; ACanvas.Fill.Color := ACanvas.Stroke.Color;
if isUp then if isUp then
@@ -409,55 +692,67 @@ begin
FLineWidth := ALineWidth; FLineWidth := ALineWidth;
end; end;
function TChartLineSeries.GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; function TChartLineSeries.GetValueRange(StartIndex, Count: Int64; out MinValue, MaxValue: Double): Boolean;
var var
i: Int64; i: Int64;
lastIndex: Int64;
begin begin
Result := GetCount > 0; Result := GetCount > 0;
if not Result then if not Result then
Exit; Exit;
Min := MaxDouble; MinValue := MaxDouble;
Max := -MaxDouble; MaxValue := -MaxDouble;
for i := StartIndex to System.Math.Min(Data.Count - 1, StartIndex + Count - 1) do lastIndex := Min(Data.Count - 1, StartIndex + Count - 1);
for i := StartIndex to lastIndex do
begin begin
var v := Data.Items[i]; var v := Data.Items[i];
if not IsNaN(v) then if not IsNaN(v) then
begin begin
Min := System.Math.Min(Min, v); MinValue := Min(MinValue, v);
Max := System.Math.Max(Max, v); MaxValue := Max(MaxValue, v);
end; end;
end; end;
Result := (Min <> MaxDouble); Result := (MinValue <> MaxDouble);
end; end;
procedure TChartLineSeries.Paint(const ACanvas: TCanvas; Lookback: Int64; const AXForm, AYForm: TFunc<Double, Single>); procedure TChartLineSeries.Paint(const ACanvas: TCanvas; StartIndex, Count: Int64; const AXForm, AYForm: TFunc<Double, Single>);
var
points: TPathData;
i, n: Int64;
lastIndex: Int64;
begin begin
if not Assigned(MainSeries) or (Data.Count = 0) or (MainSeries.Count = 0) then if (Data.Count = 0) or (Count < 2) then
Exit; Exit;
var points := TPathData.Create; lastIndex := Min(Data.Count - 1, StartIndex + Count - 1);
points := TPathData.Create;
try
// Skip warmup data
n := StartIndex;
while (n <= lastIndex) and (IsNaN(Data[n])) do
begin
inc(n);
end;
var displayCount := System.Math.Min(Data.Count, Lookback); if (n > lastIndex) then
if displayCount < 2 then
Exit;
// Skip warmup data
var n := 0;
while IsNaN(Data[n]) do
begin
inc(n);
if n >= displaycount - 2 then
exit; exit;
points.MoveTo(TPointF.Create(AXForm(n), AYForm(Data[n])));
for i := n + 1 to lastIndex do
begin
if not IsNaN(Data[i]) then
begin
points.LineTo(TPointF.Create(AXForm(i), AYForm(Data[i])));
end;
end;
ACanvas.Stroke.Color := FLineColor;
ACanvas.Stroke.Thickness := FLineWidth;
ACanvas.DrawPath(points, 1);
finally
points.Free;
end; end;
points.MoveTo(TPointF.Create(AXForm(n), AYForm(Data[n])));
for var i := n to displayCount - 1 do
points.LineTo(TPointF.Create(AXForm(i), AYForm(Data[i])));
ACanvas.Stroke.Color := FLineColor;
ACanvas.Stroke.Thickness := FLineWidth;
ACanvas.DrawPath(points, 1);
end; end;
{ TChartSeriesReceiver<T> } { TChartSeriesReceiver<T> }