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

Chart now solid

Browse Source
This commit is contained in:
Michael Schimmel
2025-07-12 21:19:11 +02:00
parent 45ff69fd92
commit a06640665a
5 changed files with 264 additions and 213 deletions
Download Patch File Download Diff File Expand all files Collapse all files
AuraTrader/FirstStrategy.pas
+4 -37
View File
@@ -24,7 +24,7 @@ type
protected
// Broadcasts the given data to all linked processors.
procedure Broadcast(const Value: T);
procedure Update; override;
public
constructor Create;
destructor Destroy; override;
@@ -42,33 +42,21 @@ type
constructor Create(const AFunc: TConvertFunc);
end;
ITicksToTimeframe = interface(IMycConverter<TArray<TDataPoint<TAskBidItem>>, TDataPoint<TOhlcItem>>)
function GetCurrentBar: TDataPoint<TOhlcItem>;
function GetStateText: TWriteable<String>;
function GetTimeframe: TTimeframe;
property CurrentBar: TDataPoint<TOhlcItem> read GetCurrentBar;
property StateText: TWriteable<String> read GetStateText;
property Timeframe: TTimeframe read GetTimeframe;
end;
TTicksToTimeframe = class(TMycConverter<TArray<TDataPoint<TAskBidItem>>, TDataPoint<TOhlcItem>>, ITicksToTimeframe)
TTicksToTimeframe = class(TMycConverter<TArray<TDataPoint<TAskBidItem>>, TDataPoint<TOhlcItem>>)
private
FTimeframe: TTimeframe;
FStateText: TWriteable<String>;
// Stores the currently aggregating OHLC data.
FCurrentBar: TDataPoint<TOhlcItem>;
function GetBarStartTime(const TimeStamp: TDateTime; const Timeframe: TTimeframe): TDateTime;
function GetCurrentBar: TDataPoint<TOhlcItem>;
function GetStateText: TWriteable<String>;
function GetTimeframe: TTimeframe;
public
constructor Create(const ATimeframe: TTimeframe; const AStateText: TWriteable<String>);
constructor Create(const ATimeframe: TTimeframe);
// Process new data. This is called concurrently and must not have side effects out of the scope of this class!
function ProcessData(const Values: TArray<TDataPoint<TAskBidItem>>): Boolean; override;
property CurrentBar: TDataPoint<TOhlcItem> read GetCurrentBar;
property StateText: TWriteable<String> read GetStateText;
property Timeframe: TTimeframe read GetTimeframe;
end;
@@ -99,10 +87,9 @@ uses
{ TTicksToTimeframe }
constructor TTicksToTimeframe.Create(const ATimeframe: TTimeframe; const AStateText: TWriteable<String>);
constructor TTicksToTimeframe.Create(const ATimeframe: TTimeframe);
begin
inherited Create;
FStateText := AStateText;
FTimeframe := ATimeframe;
end;
@@ -124,11 +111,6 @@ begin
Result := FCurrentBar;
end;
function TTicksToTimeframe.GetStateText: TWriteable<String>;
begin
Result := FStateText;
end;
function TTicksToTimeframe.GetTimeframe: TTimeframe;
begin
Result := FTimeframe;
@@ -178,10 +160,6 @@ begin
FCurrentBar.Data := currentBar;
end;
end;
with FCurrentBar do
FStateText.Value :=
Format('Cuur Bar: O:%.5f H:%.5f L:%.5f C:%.5f V:%.0f', [Data.Open, Data.High, Data.Low, Data.Close, Data.Volume]);
end;
{ THullMovingAverage }
@@ -302,15 +280,4 @@ begin
Result := FSender;
end;
procedure TMycConverter<S, T>.Update;
begin
FSender.Notify(
function(const Processor: IMycProcessor<T>): Boolean
begin
Processor.Update;
Result := true
end
);
end;
end.
AuraTrader/MainForm.pas
+12 -13
View File
@@ -156,12 +156,6 @@ begin
if Symbol = '' then
exit;
var stateText := TWriteable<String>.CreateWriteable.Protect;
var stateLabel := TLabel.Create(Self);
AlignControl(stateLabel);
stateLabel.Text := 'Initializing...';
var chart := TMycChart.Create(Self);
AlignControl(chart);
chart.Height := Layout.ChildrenRect.Width * 9 / 16;
@@ -169,7 +163,7 @@ begin
/////
var OhlcPoint: ITicksToTimeframe := TTicksToTimeframe.Create(H1, stateText);
var OhlcPoint: IMycConverter<TArray<TDataPoint<TAskBidItem>>, TDataPoint<TOhlcItem>> := TTicksToTimeframe.Create(M1);
var Ohlc: IMycConverter<TDataPoint<TOhlcItem>, TOhlcItem> :=
TMycGenericConverter<TDataPoint<TOhlcItem>, TOhlcItem>
@@ -182,18 +176,23 @@ begin
Ohlc.Sender.Link(Closes);
var Hull: IMycConverter<Double, Double> := THullMovingAverage.Create(250);
for var i := 0 to 200 do
begin
var Hull: IMycConverter<Double, Double> := THullMovingAverage.Create(20 + (20 * i));
Closes.Sender.Link(Hull);
chart.AddDoubleSeries(Hull.Sender, Random(Cardinal.MaxValue));
end;
Closes.Sender.Link(Hull);
chart.AddDoubleSeries(Hull.Sender);
// var Hull: IMycConverter<Double, Double> := THullMovingAverage.Create(250);
//
// Closes.Sender.Link(Hull);
//
// chart.AddDoubleSeries(Hull.Sender);
var done := ExecuteStrategy(Symbol, OhlcPoint);
/////
stateLabel.ProcessSignal(stateText.Changed, done, procedure begin stateLabel.Text := stateText.Value; end);
FProcessDone := TState.All([FProcessDone, done]);
chart.AddOhlcSeries(OhlcPoint.Sender);
AuraTrader/Myc.Fmx.Chart.pas
+145 -100
View File
@@ -31,9 +31,10 @@ type
function GetMainSeries: TSeries;
protected
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;
// The signature is changed to support viewport painting
// The signature is changed to support viewport painting with an index offset
procedure Paint(
const ACanvas: TCanvas;
StartIndex, Count: Int64;
@@ -44,6 +45,7 @@ type
constructor Create(AOwner: TMycChart);
property Count: Int64 read GetCount;
property Owner: TMycChart read FOwner;
property TotalCount: Int64 read GetTotalCount;
end;
private
@@ -68,20 +70,20 @@ type
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
// Creates an OHLC candlestick/bar series
procedure AddOhlcSeries(
// Creates an OHLC candlestick/bar series and returns it
function AddOhlcSeries(
const DataProvider: IMycDataProvider<TDataPoint<TOhlcItem>>;
const AUpColor: TAlphaColor = TAlphaColors.Green;
const ADownColor: TAlphaColor = TAlphaColors.Red;
const AStyle: TCandleStyle = csCandleStick
);
): TSeries;
// Creates a simple line series for double values
procedure AddDoubleSeries(
// 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;
@@ -103,7 +105,6 @@ type
FData: TWriteable<TMycDataArray<T>>;
protected
function ProcessData(const Value: T): Boolean; override;
procedure Update; override;
public
constructor Create(const ALookback: TWriteable<Int64>);
function GetData(var Data: TMycDataArray<T>): Boolean;
@@ -121,6 +122,7 @@ type
FReceiverTag: TTag;
protected
function GetCount: Int64; override;
function GetTotalCount: Int64; override;
function Update: Boolean; override;
public
@@ -205,29 +207,25 @@ begin
inherited;
end;
procedure TMycChart.AddDoubleSeries(
function TMycChart.AddDoubleSeries(
const DataProvider: IMycDataProvider<Double>;
const ALineColor: TAlphaColor = TAlphaColors.Cornflowerblue;
const ALineWidth: Single = 1.5
);
var
series: TChartLineSeries;
): TSeries;
begin
series := TChartLineSeries.Create(Self, DataProvider, ALineColor, ALineWidth);
FSeriesList.Add(series);
Result := TChartLineSeries.Create(Self, DataProvider, ALineColor, ALineWidth);
FSeriesList.Add(Result);
end;
procedure TMycChart.AddOhlcSeries(
function TMycChart.AddOhlcSeries(
const DataProvider: IMycDataProvider<TDataPoint<TOhlcItem>>;
const AUpColor: TAlphaColor = TAlphaColors.Green;
const ADownColor: TAlphaColor = TAlphaColors.Red;
const AStyle: TCandleStyle = csCandleStick
);
var
series: TChartOhlcSeries;
): TSeries;
begin
series := TChartOhlcSeries.Create(Self, DataProvider, AUpColor, ADownColor, AStyle);
FSeriesList.Add(series);
Result := TChartOhlcSeries.Create(Self, DataProvider, AUpColor, ADownColor, AStyle);
FSeriesList.Add(Result);
end;
procedure TMycChart.DoIdle;
@@ -235,22 +233,18 @@ var
doRepaint: Boolean;
mainSeries: TSeries;
isLiveView: Boolean;
prevCount, newCount, newCandles: Int64;
prevTotalCount, newTotalCount, countDelta: Int64;
begin
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;
prevTotalCount := mainSeries.TotalCount;
// Check all series for updates
doRepaint := false;
@@ -262,20 +256,20 @@ begin
end;
end;
if doRepaint then
if doRepaint and (not isLiveView) then
begin
newCount := mainSeries.Count;
newCandles := newCount - prevCount;
newTotalCount := mainSeries.TotalCount;
countDelta := newTotalCount - prevTotalCount;
// Adjust viewport only if user was not watching the live data
if (not isLiveView) and (newCandles > 0) then
if (countDelta > 0) then
begin
FViewStartIndex := FViewStartIndex + newCandles;
// Adjust the start index based on the absolute change in total data points
FViewStartIndex := FViewStartIndex + countDelta;
end;
// If the view was live, it implicitly stays at StartIndex = 0, showing the new data.
Repaint;
end;
if doRepaint then
Repaint;
end;
procedure TMycChart.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
@@ -385,7 +379,9 @@ begin
if (FViewStartIndex > maxIndex) then
FViewStartIndex := maxIndex;
FDragStartPoint := TPointF.Create(X, Y);
// Optimized point update
FDragStartPoint.X := X;
FDragStartPoint.Y := Y;
Repaint;
end;
end;
@@ -452,6 +448,24 @@ begin
end;
procedure TMycChart.Paint;
function CalcView(Series: TSeries; MasterCount: Int64; out First: Int64; out Count: 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;
Result := effectiveStart <= effectiveEnd - 1;
if Result then
begin
First := effectiveStart;
Count := effectiveEnd - effectiveStart + 1;
end;
end;
var
rect: TRectF;
series: TSeries;
@@ -462,6 +476,8 @@ var
isButtonVisible: Boolean;
buttonColor: TAlphaColor;
path: TPathData;
mainSeries: TSeries;
masterTotalCount, seriesStart, seriesCount: Int64;
begin
inherited;
rect := Self.LocalRect;
@@ -474,22 +490,26 @@ begin
end;
rangeInitialized := false;
mainSeries := FSeriesList[0];
// Determine value range for the visible viewport only
masterTotalCount := mainSeries.TotalCount;
for series in FSeriesList do
begin
if series.GetValueRange(FViewStartIndex, FViewCount, seriesMin, seriesMax) then
if CalcView(series, masterTotalCount, seriesStart, seriesCount) then
begin
if not rangeInitialized then
if series.GetValueRange(seriesStart, seriesCount, seriesMin, seriesMax) then
begin
globalMin := seriesMin;
globalMax := seriesMax;
rangeInitialized := true;
end
else
begin
globalMin := Min(globalMin, seriesMin);
globalMax := Max(globalMax, seriesMax);
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;
@@ -504,29 +524,29 @@ begin
if (globalMax - globalMin) = 0 then
exit;
// 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;
// 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
series.Paint(Self.Canvas, FViewStartIndex, FViewCount, xTransform, yTransform);
if CalcView(series, masterTotalCount, seriesStart, seriesCount) 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, seriesStart, seriesCount, xTransform, yTransform);
end;
end;
// --- Draw the "jump to latest" button ---
isButtonVisible := (FViewStartIndex > 0);
FJumpButtonHot := FJumpButtonHot and isButtonVisible;
if isButtonVisible then
begin
@@ -545,7 +565,7 @@ begin
Canvas.Fill.Color := buttonColor;
Canvas.FillRect(FJumpButtonRect, 4, 4, AllCorners, 0.7);
// Draw an icon (e.g., a "fast forward" double arrow)
// Draw an icon
Canvas.Stroke.Color := TAlphaColors.White;
Canvas.Stroke.Thickness := 1.5;
@@ -553,11 +573,9 @@ begin
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));
@@ -574,6 +592,30 @@ begin
end;
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>.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;
FCurrData := FCurrData.Add(Value, FLookback.Value);
FData.Value := FCurrData;
end;
{ TChartSeriesProcessor<T> }
constructor TChartSeriesProcessor<T>.Create(AOwner: TMycChart; const ADataProvider: IMycDataProvider<T>);
@@ -598,6 +640,11 @@ begin
Result := FData.Count;
end;
function TChartSeriesProcessor<T>.GetTotalCount: Int64;
begin
Result := FData.TotalCount;
end;
function TChartSeriesProcessor<T>.Update: Boolean;
begin
Result := FReceiver.GetData(FData);
@@ -621,17 +668,30 @@ end;
function TChartOhlcSeries.GetValueRange(StartIndex, Count: Int64; out MinValue, MaxValue: Double): Boolean;
var
i: Int64;
lastIndex: Int64;
seriesCount: Int64;
effectiveStart, effectiveEnd: Int64;
begin
Result := GetCount > 0;
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;
lastIndex := Min(GetCount - 1, StartIndex + Count - 1);
for i := StartIndex to lastIndex do
for i := effectiveStart to effectiveEnd do
begin
var dp := Data.Items[i];
MinValue := Min(MinValue, dp.Data.Low);
@@ -704,16 +764,29 @@ end;
function TChartLineSeries.GetValueRange(StartIndex, Count: Int64; out MinValue, MaxValue: Double): Boolean;
var
i: Int64;
lastIndex: Int64;
seriesCount: Int64;
effectiveStart, effectiveEnd: Int64;
begin
Result := GetCount > 0;
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;
lastIndex := Min(Data.Count - 1, StartIndex + Count - 1);
for i := StartIndex to lastIndex do
for i := effectiveStart to effectiveEnd do
begin
var v := Data.Items[i];
if not IsNaN(v) then
@@ -764,32 +837,4 @@ begin
end;
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>.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;
FCurrData := FCurrData.Add(Value, FLookback.Value);
end;
procedure TChartSeriesReceiver<T>.Update;
begin
FData.Value := FCurrData;
end;
end.