diff --git a/AuraTrader/AuraTrader.dproj b/AuraTrader/AuraTrader.dproj
index 7305040..ecdfe00 100644
--- a/AuraTrader/AuraTrader.dproj
+++ b/AuraTrader/AuraTrader.dproj
@@ -4,7 +4,7 @@
20.3
FMX
True
- Debug
+ Release
Win64
AuraTrader
3
diff --git a/AuraTrader/MainForm.pas b/AuraTrader/MainForm.pas
index 031f5a6..a310bb4 100644
--- a/AuraTrader/MainForm.pas
+++ b/AuraTrader/MainForm.pas
@@ -165,7 +165,7 @@ begin
var chart := TMycChart.Create(Self);
AlignControl( chart );
chart.Height := Layout.ChildrenRect.Width*9/16;
- chart.Lookback.Value := 1000;
+ chart.Lookback.Value := 50000;
/////
diff --git a/AuraTrader/Myc.Fmx.Chart.pas b/AuraTrader/Myc.Fmx.Chart.pas
index af922cf..f24f163 100644
--- a/AuraTrader/Myc.Fmx.Chart.pas
+++ b/AuraTrader/Myc.Fmx.Chart.pas
@@ -14,6 +14,7 @@ uses
FMX.Types,
FMX.Controls,
FMX.Graphics,
+ FMX.Forms,
Myc.Trade.DataPoint,
Myc.Signals,
Myc.Lazy;
@@ -22,32 +23,41 @@ type
TCandleStyle = (csCandleStick, csHiLoBar);
TMycChart = class(TStyledControl)
- type
- TSeries = class abstract(TObject)
- private
- FOwner: TMycChart;
- function GetMainSeries: TSeries;
- protected
- function GetCount: Int64; virtual; abstract;
- function GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; virtual; abstract;
- function Update: Boolean; virtual; abstract;
- procedure Paint(const ACanvas: TCanvas; Lookback: Int64; const AXForm, AYForm: TFunc); virtual; abstract;
+ public type
+ TSeries = class abstract(TObject)
+ private
+ FOwner: TMycChart;
+ function GetMainSeries: TSeries;
+ protected
+ function GetCount: Int64; virtual; abstract;
+ function GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; virtual; abstract;
+ function Update: Boolean; virtual; abstract;
+ // The signature is changed to support viewport painting
+ procedure Paint(const ACanvas: TCanvas; StartIndex, Count: Int64; const AXForm, AYForm: TFunc); 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;
-
- public
- constructor Create(AOwner: TMycChart);
- property Count: Int64 read GetCount;
- property Owner: TMycChart read FOwner;
- end;
-
- private
- FSeriesList: TList;
- FLookback: TWriteable;
- FIdleSubscrId: TMessageSubscriptionId;
- protected
+private
+ FSeriesList: TList;
+ 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;
@@ -120,8 +130,8 @@ type
FDownColor: TAlphaColor;
FStyle: TCandleStyle;
protected
- function GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; override;
- procedure Paint(const ACanvas: TCanvas; Lookback: Int64; const AXForm, AYForm: TFunc); override;
+ function GetValueRange(StartIndex, Count: Int64; out MinValue, MaxValue: Double): Boolean; override;
+ procedure Paint(const ACanvas: TCanvas; StartIndex, Count: Int64; const AXForm, AYForm: TFunc); override;
public
constructor Create(
AOwner: TMycChart;
@@ -137,8 +147,8 @@ type
FLineColor: TAlphaColor;
FLineWidth: Single;
protected
- function GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; override;
- procedure Paint(const ACanvas: TCanvas; Lookback: Int64; const AXForm, AYForm: TFunc); override;
+ function GetValueRange(StartIndex, Count: Int64; out MinValue, MaxValue: Double): Boolean; override;
+ procedure Paint(const ACanvas: TCanvas; StartIndex, Count: Int64; const AXForm, AYForm: TFunc); override;
public
constructor Create(
AOwner: TMycChart;
@@ -159,7 +169,7 @@ end;
function TMycChart.TSeries.GetMainSeries: TSeries;
begin
Result := nil;
- if Owner.FSeriesList.Count > 0 then
+ if (Owner.FSeriesList.Count > 0) then
Result := Owner.FSeriesList[0];
end;
@@ -170,7 +180,10 @@ begin
inherited Create(AOwner);
FSeriesList := TObjectList.Create(true);
- FLookback := TWriteable.CreateWriteable( 100 );
+ FLookback := TWriteable.CreateWriteable( 1000 ); // Load more data for panning
+ FViewStartIndex := 0;
+ FViewCount := 100; // Show 100 items by default
+ FIsDragging := false;
FIdleSubscrId :=
TMessageManager
@@ -212,13 +225,219 @@ begin
end;
procedure TMycChart.DoIdle;
+var
+ doRepaint: Boolean;
+ mainSeries: TSeries;
+ isLiveView: Boolean;
+ prevCount, newCount, newCandles: Int64;
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
+ begin
if series.Update then
+ begin
doRepaint := true;
+ end;
+ end;
+
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;
+ 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;
procedure TMycChart.Paint;
@@ -229,12 +448,14 @@ var
rangeInitialized: Boolean;
xTransform: TFunc;
yTransform: TFunc;
+ isButtonVisible: Boolean;
+ buttonColor: TAlphaColor;
+ path: TPathData;
begin
inherited;
rect := Self.LocalRect;
- var lookback := FLookback.Value;
- if (FSeriesList.Count = 0) or (lookback <= 1) then
+ if (FSeriesList.Count = 0) or (FViewCount <= 1) then
begin
Canvas.Fill.Color := TAlphaColors.Gray;
Canvas.FillText(rect, 'No Data', false, 1, [], TTextAlign.Center, TTextAlign.Center);
@@ -243,9 +464,10 @@ begin
rangeInitialized := false;
+ // Determine value range for the visible viewport only
for series in FSeriesList do
begin
- if series.GetValueRange(0, lookback, seriesMin, seriesMax) then
+ if series.GetValueRange(FViewStartIndex, FViewCount, seriesMin, seriesMax) then
begin
if not rangeInitialized then
begin
@@ -271,18 +493,75 @@ begin
if (globalMax - globalMin) = 0 then
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 :=
- function(value: Double): Single begin Result := rect.Top + (1 - (value - globalMin) / (globalMax - globalMin)) * rect.Height; end;
-
- // var T :=
- // TMatrix.CreateTranslation(rect.Left, rect.Top + rect.Height*globalMax / (globalMax - globalMin)) *
- // TMatrix.CreateScaling(rect.Width / (FLookback - 1), -rect.Height / (globalMax - globalMin));
+ function(value: Double): Single
+ begin
+ Result := rect.Top + (1 - (value - globalMin) / (globalMax - globalMin)) * rect.Height;
+ end;
for series in FSeriesList do
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;
@@ -330,43 +609,47 @@ begin
FStyle := AStyle;
end;
-function TChartOhlcSeries.GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean;
+function TChartOhlcSeries.GetValueRange(StartIndex, Count: Int64; out MinValue, MaxValue: Double): Boolean;
var
i: Int64;
+ lastIndex: Int64;
begin
Result := GetCount > 0;
if not Result then
Exit;
- Min := MaxDouble;
- Max := -MaxDouble;
- for i := StartIndex to System.Math.Min(GetCount - 1, StartIndex + Count - 1) do
+ MinValue := MaxDouble;
+ MaxValue := -MaxDouble;
+ lastIndex := Min(GetCount - 1, StartIndex + Count - 1);
+
+ for i := StartIndex to lastIndex do
begin
var dp := Data.Items[i];
- Min := System.Math.Min(Min, dp.Data.Low);
- Max := System.Math.Max(Max, dp.Data.High);
+ MinValue := Min(MinValue, dp.Data.Low);
+ MaxValue := Max(MaxValue, dp.Data.High);
end;
- Result := (Min <> MaxDouble);
+ Result := (MinValue <> MaxDouble);
end;
-procedure TChartOhlcSeries.Paint(const ACanvas: TCanvas; Lookback: Int64; const AXForm, AYForm: TFunc);
+procedure TChartOhlcSeries.Paint(const ACanvas: TCanvas; StartIndex, Count: Int64; const AXForm, AYForm: TFunc);
var
- i, displayCount: Int64;
+ i: Int64;
+ lastIndex: Int64;
x, candleWidth: Single;
yOpen, yHigh, yLow, yClose: Single;
item: TDataPoint;
isUp: boolean;
begin
- displayCount := System.Math.Min(Data.Count, Lookback);
- if displayCount <= 0 then
+ if (Count <= 0) then
Exit;
- if displayCount > 1 then
- candleWidth := Max(2, 0.8 * Abs((AXForm(1) - AXForm(0))))
+ if (Count > 1) then
+ candleWidth := Max(2, 0.8 * Abs((AXForm(StartIndex + 1) - AXForm(StartIndex))))
else
candleWidth := 10;
- for i := 0 to displayCount - 1 do
+ lastIndex := Min(Data.Count - 1, StartIndex + Count - 1);
+ for i := StartIndex to lastIndex do
begin
item := Data.Items[i];
x := AXForm(i);
@@ -384,7 +667,7 @@ begin
ACanvas.DrawLine(TPointF.Create(x, yHigh), TPointF.Create(x, yLow), 1);
- if FStyle = csCandleStick then
+ if (FStyle = csCandleStick) then
begin
ACanvas.Fill.Color := ACanvas.Stroke.Color;
if isUp then
@@ -409,55 +692,67 @@ begin
FLineWidth := ALineWidth;
end;
-function TChartLineSeries.GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean;
+function TChartLineSeries.GetValueRange(StartIndex, Count: Int64; out MinValue, MaxValue: Double): Boolean;
var
i: Int64;
+ lastIndex: Int64;
begin
Result := GetCount > 0;
if not Result then
Exit;
- Min := MaxDouble;
- Max := -MaxDouble;
- for i := StartIndex to System.Math.Min(Data.Count - 1, StartIndex + Count - 1) do
+ MinValue := MaxDouble;
+ MaxValue := -MaxDouble;
+ lastIndex := Min(Data.Count - 1, StartIndex + Count - 1);
+ for i := StartIndex to lastIndex do
begin
var v := Data.Items[i];
if not IsNaN(v) then
begin
- Min := System.Math.Min(Min, v);
- Max := System.Math.Max(Max, v);
+ MinValue := Min(MinValue, v);
+ MaxValue := Max(MaxValue, v);
end;
end;
- Result := (Min <> MaxDouble);
+ Result := (MinValue <> MaxDouble);
end;
-procedure TChartLineSeries.Paint(const ACanvas: TCanvas; Lookback: Int64; const AXForm, AYForm: TFunc);
+procedure TChartLineSeries.Paint(const ACanvas: TCanvas; StartIndex, Count: Int64; const AXForm, AYForm: TFunc);
+var
+ points: TPathData;
+ i, n: Int64;
+ lastIndex: Int64;
begin
- if not Assigned(MainSeries) or (Data.Count = 0) or (MainSeries.Count = 0) then
+ if (Data.Count = 0) or (Count < 2) then
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 displayCount < 2 then
- Exit;
-
- // Skip warmup data
- var n := 0;
- while IsNaN(Data[n]) do
- begin
- inc(n);
- if n >= displaycount - 2 then
+ if (n > lastIndex) then
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;
-
- 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;
{ TChartSeriesReceiver }