Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

Fix chart left data range fail

Browse Source
This commit is contained in:
Michael Schimmel
2025-07-12 22:20:23 +02:00
parent a06640665a
commit 956c47ba36
2 changed files with 85 additions and 181 deletions
Download Patch File Download Diff File Expand all files Collapse all files
AuraTrader/MainForm.pas
+3 -3
View File
@@ -176,11 +176,11 @@ begin
Ohlc.Sender.Link(Closes);
for var i := 0 to 200 do
for var i := 0 to 3 do
begin
var Hull: IMycConverter<Double, Double> := THullMovingAverage.Create(20 + (20 * i));
var Hull: IMycConverter<Double, Double> := THullMovingAverage.Create(50 + (50 * i));
Closes.Sender.Link(Hull);
chart.AddDoubleSeries(Hull.Sender, Random(Cardinal.MaxValue));
chart.AddDoubleSeries(Hull.Sender, TAlphaColor(Random(Integer.MaxValue - 1)));
end;
// var Hull: IMycConverter<Double, Double> := THullMovingAverage.Create(250);
AuraTrader/Myc.Fmx.Chart.pas
+82 -178
View File
@@ -20,8 +20,6 @@ uses
Myc.Lazy;
type
TCandleStyle = (csCandleStick, csHiLoBar);
TMycChart = class(TStyledControl)
public
type
@@ -33,13 +31,9 @@ type
function GetCount: Int64; virtual; abstract;
function GetTotalCount: Int64; virtual; abstract;
function GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; virtual; abstract;
function Update: Boolean; virtual; abstract;
procedure Update; virtual; abstract;
// The signature is changed to support viewport painting with an index offset
procedure Paint(
const ACanvas: TCanvas;
StartIndex, Count: Int64;
const AXForm, AYForm: TFunc<Double, Single>
); virtual; abstract;
procedure Paint(const Canvas: TCanvas; First, Last: Int64; const XForm, YForm: TFunc<Double, Single>); virtual; abstract;
property MainSeries: TSeries read GetMainSeries;
public
constructor Create(AOwner: TMycChart);
@@ -74,8 +68,7 @@ type
function AddOhlcSeries(
const DataProvider: IMycDataProvider<TDataPoint<TOhlcItem>>;
const AUpColor: TAlphaColor = TAlphaColors.Green;
const ADownColor: TAlphaColor = TAlphaColors.Red;
const AStyle: TCandleStyle = csCandleStick
const ADownColor: TAlphaColor = TAlphaColors.Red
): TSeries;
// Creates a simple line series for double values and returns it
@@ -107,7 +100,6 @@ type
function ProcessData(const Value: T): Boolean; override;
public
constructor Create(const ALookback: TWriteable<Int64>);
function GetData(var Data: TMycDataArray<T>): Boolean;
property Data: TWriteable<TMycDataArray<T>> read FData;
end;
@@ -123,7 +115,7 @@ type
protected
function GetCount: Int64; override;
function GetTotalCount: Int64; override;
function Update: Boolean; override;
procedure Update; override;
public
constructor Create(AOwner: TMycChart; const ADataProvider: IMycDataProvider<T>);
@@ -136,16 +128,14 @@ type
private
FUpColor: TAlphaColor;
FDownColor: TAlphaColor;
FStyle: TCandleStyle;
protected
function GetValueRange(StartIndex, Count: Int64; out MinValue, MaxValue: Double): Boolean; override;
procedure Paint(const ACanvas: TCanvas; StartIndex, Count: Int64; const AXForm, AYForm: TFunc<Double, Single>); override;
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<TDataPoint<TOhlcItem>>;
const AUpColor, ADownColor: TAlphaColor;
AStyle: TCandleStyle
const AUpColor, ADownColor: TAlphaColor
);
end;
@@ -155,8 +145,8 @@ type
FLineColor: TAlphaColor;
FLineWidth: Single;
protected
function GetValueRange(StartIndex, Count: Int64; out MinValue, MaxValue: Double): Boolean; override;
procedure Paint(const ACanvas: TCanvas; StartIndex, Count: Int64; const AXForm, AYForm: TFunc<Double, Single>); override;
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;
@@ -220,55 +210,53 @@ end;
function TMycChart.AddOhlcSeries(
const DataProvider: IMycDataProvider<TDataPoint<TOhlcItem>>;
const AUpColor: TAlphaColor = TAlphaColors.Green;
const ADownColor: TAlphaColor = TAlphaColors.Red;
const AStyle: TCandleStyle = csCandleStick
const ADownColor: TAlphaColor = TAlphaColors.Red
): TSeries;
begin
Result := TChartOhlcSeries.Create(Self, DataProvider, AUpColor, ADownColor, AStyle);
Result := TChartOhlcSeries.Create(Self, DataProvider, AUpColor, ADownColor);
FSeriesList.Add(Result);
end;
procedure TMycChart.DoIdle;
var
doRepaint: Boolean;
mainSeries: TSeries;
isLiveView: Boolean;
prevTotalCount, newTotalCount, countDelta: Int64;
begin
if (FSeriesList.Count = 0) then
exit;
mainSeries := FSeriesList[0];
if (mainSeries = nil) then
exit;
var prevTotalCount := FSeriesList[0].TotalCount;
// Remember state before update
isLiveView := (FViewStartIndex = 0);
prevTotalCount := mainSeries.TotalCount;
// Check all series for updates
doRepaint := false;
var seriesRepaint := false;
var seriesChanged := false;
for var series in FSeriesList do
begin
if series.Update then
begin
doRepaint := true;
end;
var seriesCount := series.TotalCount;
// Check if this series may need a repaint
if FViewStartIndex <= prevTotalCount - seriesCount then
seriesRepaint := true;
// Update the series
series.Update;
if seriesCount <> series.TotalCount then
seriesChanged := true;
end;
if doRepaint and (not isLiveView) then
// Don't move with live data, if the last bar isn't visible
if FViewStartIndex > 0 then
begin
newTotalCount := mainSeries.TotalCount;
countDelta := newTotalCount - prevTotalCount;
var newTotalCount := FSeriesList[0].TotalCount;
var countDelta := newTotalCount - prevTotalCount;
if (countDelta > 0) then
if countDelta > 0 then
begin
// Adjust the start index based on the absolute change in total data points
FViewStartIndex := FViewStartIndex + countDelta;
if FViewStartIndex + FViewCount > newTotalCount then
FViewStartIndex := newTotalCount - FViewCount;
end;
end;
if doRepaint then
if seriesRepaint and seriesChanged then
Repaint;
end;
@@ -342,6 +330,7 @@ begin
// Panning logic
inherited MouseMove(Shift, X, Y);
if FIsDragging then
begin
dx := X - FDragStartPoint.X;
@@ -364,24 +353,18 @@ begin
// Clamp values
mainSeries := FSeriesList[0];
maxIndex := 0;
if (mainSeries <> nil) then
begin
maxIndex := mainSeries.Count - FViewCount;
end;
maxIndex := mainSeries.Count - FViewCount;
if (maxIndex < 0) then
begin
maxIndex := 0;
end;
if (FViewStartIndex < 0) then
FViewStartIndex := 0;
if (FViewStartIndex > maxIndex) then
FViewStartIndex := maxIndex;
// Optimized point update
FDragStartPoint.X := X;
FDragStartPoint.Y := Y;
Repaint;
end;
end;
@@ -398,18 +381,14 @@ 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
if (mainSeries.Count = 0) or (Width <= 0) then
exit;
end;
mousePos := Self.ScreenToLocal(Screen.MousePos);
mousePos := ScreenToLocal(Screen.MousePos);
// Correctly calculate the anchor index for a right-to-left axis
// Calculate the anchor index for a right-to-left axis
anchorIndex := FViewStartIndex + ((Self.Width - mousePos.X) / Self.Width) * FViewCount;
if (WheelDelta > 0) then
@@ -449,21 +428,16 @@ end;
procedure TMycChart.Paint;
function CalcView(Series: TSeries; MasterCount: Int64; out First: Int64; out Count: Int64): Boolean;
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;
var effectiveStart := Max(0, startIdx);
var effectiveEnd := Min(series.Count, startIdx + FViewCount) - 1;
First := Max(0, startIdx);
Last := Min(series.Count, startIdx + FViewCount) - 1;
Result := effectiveStart <= effectiveEnd - 1;
if Result then
begin
First := effectiveStart;
Count := effectiveEnd - effectiveStart + 1;
end;
Result := First <= Last - 1;
end;
var
@@ -477,7 +451,7 @@ var
buttonColor: TAlphaColor;
path: TPathData;
mainSeries: TSeries;
masterTotalCount, seriesStart, seriesCount: Int64;
masterTotalCount, seriesFirst, seriesLast: Int64;
begin
inherited;
rect := Self.LocalRect;
@@ -495,9 +469,9 @@ begin
masterTotalCount := mainSeries.TotalCount;
for series in FSeriesList do
begin
if CalcView(series, masterTotalCount, seriesStart, seriesCount) then
if CalcView(series, masterTotalCount, seriesFirst, seriesLast) then
begin
if series.GetValueRange(seriesStart, seriesCount, seriesMin, seriesMax) then
if series.GetValueRange(seriesFirst, seriesLast, seriesMin, seriesMax) then
begin
if not rangeInitialized then
begin
@@ -532,7 +506,7 @@ begin
// The masterTotalCount is already calculated from the range finding loop
for series in FSeriesList do
begin
if CalcView(series, masterTotalCount, seriesStart, seriesCount) then
if CalcView(series, masterTotalCount, seriesFirst, seriesLast) then
begin
var offset := masterTotalCount - series.TotalCount;
xTransform :=
@@ -541,7 +515,7 @@ begin
Result := rect.Right - (((index + offset - FViewStartIndex) / (FViewCount - 1)) * rect.Width);
end;
series.Paint(Self.Canvas, seriesStart, seriesCount, xTransform, yTransform);
series.Paint(Self.Canvas, seriesFirst, seriesLast, xTransform, yTransform);
end;
end;
@@ -602,13 +576,6 @@ begin
FData := TWriteable<TMycDataArray<T>>.CreateWriteable(FCurrData).Protect;
end;
function TChartSeriesReceiver<T>.GetData(var Data: TMycDataArray<T>): Boolean;
begin
var prevTotalCount := Data.TotalCount;
Data := FData.Value;
Result := prevTotalCount <> Data.TotalCount;
end;
function TChartSeriesReceiver<T>.ProcessData(const Value: T): Boolean;
begin
Result := true;
@@ -645,9 +612,9 @@ begin
Result := FData.TotalCount;
end;
function TChartSeriesProcessor<T>.Update: Boolean;
procedure TChartSeriesProcessor<T>.Update;
begin
Result := FReceiver.GetData(FData);
FData := FReceiver.Data.Value;
end;
{ TChartOhlcSeries }
@@ -655,43 +622,22 @@ end;
constructor TChartOhlcSeries.Create(
AOwner: TMycChart;
const ADataProvider: IMycDataProvider<TDataPoint<TOhlcItem>>;
const AUpColor, ADownColor: TAlphaColor;
AStyle: TCandleStyle
const AUpColor, ADownColor: TAlphaColor
);
begin
inherited Create(AOwner, ADataProvider);
FUpColor := AUpColor;
FDownColor := ADownColor;
FStyle := AStyle;
end;
function TChartOhlcSeries.GetValueRange(StartIndex, Count: Int64; out MinValue, MaxValue: Double): Boolean;
function TChartOhlcSeries.GetValueRange(First, Last: Int64; out MinValue, MaxValue: Double): Boolean;
var
i: Int64;
seriesCount: Int64;
effectiveStart, effectiveEnd: Int64;
begin
seriesCount := GetCount;
// Ensure the request is valid and there's data to check
Result := (seriesCount > 0) and (Count > 0);
if not Result then
Exit;
// Calculate the effective range that is actually available within this series's data
effectiveStart := Max(0, StartIndex);
effectiveEnd := Min(seriesCount - 1, StartIndex + Count - 1);
// If the entire requested range is outside our available data, there's nothing to do.
if (effectiveStart > effectiveEnd) then
begin
Result := false;
Exit;
end;
MinValue := MaxDouble;
MaxValue := -MaxDouble;
for i := effectiveStart to effectiveEnd do
for i := First to Last do
begin
var dp := Data.Items[i];
MinValue := Min(MinValue, dp.Data.Low);
@@ -700,50 +646,39 @@ begin
Result := (MinValue <> MaxDouble);
end;
procedure TChartOhlcSeries.Paint(const ACanvas: TCanvas; StartIndex, Count: Int64; const AXForm, AYForm: TFunc<Double, Single>);
procedure TChartOhlcSeries.Paint(const Canvas: TCanvas; First, Last: Int64; const XForm, YForm: TFunc<Double, Single>);
var
i: Int64;
lastIndex: Int64;
x, candleWidth: Single;
yOpen, yHigh, yLow, yClose: Single;
item: TDataPoint<TOhlcItem>;
isUp: boolean;
begin
if (Count <= 0) then
Exit;
candleWidth := Max(2, 0.8 * Abs((XForm(First + 1) - XForm(First))));
if (Count > 1) then
candleWidth := Max(2, 0.8 * Abs((AXForm(StartIndex + 1) - AXForm(StartIndex))))
else
candleWidth := 10;
lastIndex := Min(Data.Count - 1, StartIndex + Count - 1);
for i := StartIndex to lastIndex do
for i := First to Last do
begin
item := Data.Items[i];
x := AXForm(i);
yOpen := AYForm(item.Data.Open);
yClose := AYForm(item.Data.Close);
yHigh := AYForm(item.Data.High);
yLow := AYForm(item.Data.Low);
x := XForm(i);
yOpen := YForm(item.Data.Open);
yClose := YForm(item.Data.Close);
yHigh := YForm(item.Data.High);
yLow := YForm(item.Data.Low);
isUp := item.Data.Close >= item.Data.Open;
if isUp then
ACanvas.Stroke.Color := FUpColor
Canvas.Stroke.Color := FUpColor
else
ACanvas.Stroke.Color := FDownColor;
ACanvas.Stroke.Thickness := 1.0;
Canvas.Stroke.Color := FDownColor;
Canvas.Stroke.Thickness := 1.0;
ACanvas.DrawLine(TPointF.Create(x, yHigh), TPointF.Create(x, yLow), 1);
Canvas.DrawLine(TPointF.Create(x, yHigh), TPointF.Create(x, yLow), 1);
if (FStyle = csCandleStick) then
begin
ACanvas.Fill.Color := ACanvas.Stroke.Color;
if isUp then
ACanvas.FillRect(TRectF.Create(x - candleWidth / 2, yClose, x + candleWidth / 2, yOpen), 0, 0, AllCorners, 1)
else
ACanvas.FillRect(TRectF.Create(x - candleWidth / 2, yOpen, x + candleWidth / 2, yClose), 0, 0, AllCorners, 1);
end;
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;
@@ -761,32 +696,13 @@ begin
FLineWidth := ALineWidth;
end;
function TChartLineSeries.GetValueRange(StartIndex, Count: Int64; out MinValue, MaxValue: Double): Boolean;
function TChartLineSeries.GetValueRange(First, Last: Int64; out MinValue, MaxValue: Double): Boolean;
var
i: Int64;
seriesCount: Int64;
effectiveStart, effectiveEnd: Int64;
begin
seriesCount := GetCount;
// Ensure the request is valid and there's data to check
Result := (seriesCount > 0) and (Count > 0);
if not Result then
Exit;
// Calculate the effective range that is actually available within this series's data
effectiveStart := Max(0, StartIndex);
effectiveEnd := Min(seriesCount - 1, StartIndex + Count - 1);
// If the entire requested range is outside our available data, there's nothing to do.
if (effectiveStart > effectiveEnd) then
begin
Result := false;
Exit;
end;
MinValue := MaxDouble;
MaxValue := -MaxDouble;
for i := effectiveStart to effectiveEnd do
for i := First to Last do
begin
var v := Data.Items[i];
if not IsNaN(v) then
@@ -798,40 +714,28 @@ begin
Result := (MinValue <> MaxDouble);
end;
procedure TChartLineSeries.Paint(const ACanvas: TCanvas; StartIndex, Count: Int64; const AXForm, AYForm: TFunc<Double, Single>);
procedure TChartLineSeries.Paint(const Canvas: TCanvas; First, Last: Int64; const XForm, YForm: TFunc<Double, Single>);
var
points: TPathData;
i, n: Int64;
lastIndex: Int64;
begin
if (Data.Count = 0) or (Count < 2) then
Exit;
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
n := First;
while (n <= Last) and (IsNaN(Data[n])) do
inc(n);
end;
if (n > lastIndex) then
if (n > Last) then
exit;
points.MoveTo(TPointF.Create(AXForm(n), AYForm(Data[n])));
for i := n + 1 to lastIndex do
begin
points.MoveTo(TPointF.Create(XForm(n), YForm(Data[n])));
for i := n + 1 to Last do
if not IsNaN(Data[i]) then
begin
points.LineTo(TPointF.Create(AXForm(i), AYForm(Data[i])));
end;
end;
points.LineTo(TPointF.Create(XForm(i), YForm(Data[i])));
ACanvas.Stroke.Color := FLineColor;
ACanvas.Stroke.Thickness := FLineWidth;
ACanvas.DrawPath(points, 1);
Canvas.Stroke.Color := FLineColor;
Canvas.Stroke.Thickness := FLineWidth;
Canvas.DrawPath(points, 1);
finally
points.Free;
end;