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

Streamlining main app

Browse Source 
Bugfix in Chart -> StrokeJoint set to Bevel
This commit is contained in:
Michael Schimmel
2025-07-14 19:52:40 +02:00
parent 6f0b927a05
commit d9a82365d3
8 changed files with 317 additions and 737 deletions
Download Patch File Download Diff File Expand all files Collapse all files
AuraTrader/AuraTrader.dproj
+1 -1
View File
@@ -4,7 +4,7 @@
<ProjectVersion>20.3</ProjectVersion>
<FrameworkType>FMX</FrameworkType>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Release</Config>
<Config Condition="'$(Config)'==''">Debug</Config>
<Platform Condition="'$(Platform)'==''">Win64</Platform>
<ProjectName Condition="'$(ProjectName)'==''">AuraTrader</ProjectName>
<TargetedPlatforms>3</TargetedPlatforms>
AuraTrader/FirstStrategy.pas
-4
View File
@@ -42,17 +42,13 @@ type
TTicksToBars = class(TMycConverter<TDataPoint<TAskBidItem>, TDataPoint<TOhlcItem>>)
private
FTimeframe: TTimeframe;
// Stores the currently aggregating OHLC data.
FCurrentBar: TDataPoint<TOhlcItem>;
function GetBarStartTime(const TimeStamp: TDateTime; const Timeframe: TTimeframe): TDateTime;
function GetCurrentBar: TDataPoint<TOhlcItem>;
function GetTimeframe: TTimeframe;
public
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 Value: TDataPoint<TAskBidItem>): TState; override;
property CurrentBar: TDataPoint<TOhlcItem> read GetCurrentBar;
property Timeframe: TTimeframe read GetTimeframe;
end;
AuraTrader/MainForm.fmx
+47 -39
View File
@@ -3,7 +3,7 @@ object Form1: TForm1
Top = 0
Caption = 'Form1'
ClientHeight = 840
ClientWidth = 796
ClientWidth = 1017
FormFactor.Width = 320
FormFactor.Height = 480
FormFactor.Devices = [Desktop]
@@ -12,7 +12,7 @@ object Form1: TForm1
DesignerMasterStyle = 0
object MainPanel: TPanel
Align = Client
Size.Width = 796.000000000000000000
Size.Width = 1017.000000000000000000
Size.Height = 712.000000000000000000
Size.PlatformDefault = False
TabOrder = 2
@@ -27,30 +27,30 @@ object Form1: TForm1
end
object WorkspacePanel: TPanel
Align = Client
Size.Width = 619.000000000000000000
Size.Width = 840.000000000000000000
Size.Height = 712.000000000000000000
Size.PlatformDefault = False
TabOrder = 3
object TabControl: TTabControl
Align = Client
Size.Width = 619.000000000000000000
Size.Height = 672.000000000000000000
Size.Width = 840.000000000000000000
Size.Height = 678.000000000000000000
Size.PlatformDefault = False
TabIndex = 0
TabOrder = 10
TabPosition = PlatformDefault
end
object ToolBar: TToolBar
Size.Width = 619.000000000000000000
Size.Height = 40.000000000000000000
Size.Width = 840.000000000000000000
Size.Height = 34.000000000000000000
Size.PlatformDefault = False
TabOrder = 3
object AddWorkspaceButton: TSpeedButton
Action = AddWorkspaceAction
Align = FitLeft
ImageIndex = -1
Size.Width = 145.454589843750000000
Size.Height = 40.000000000000000000
Size.Width = 123.636383056640600000
Size.Height = 34.000000000000000000
Size.PlatformDefault = False
Text = 'Add'
TextSettings.Trimming = None
@@ -59,9 +59,9 @@ object Form1: TForm1
Action = TestAction
Align = FitLeft
ImageIndex = -1
Position.X = 145.454589843750000000
Size.Width = 145.454544067382800000
Size.Height = 40.000000000000000000
Position.X = 123.636383056640600000
Size.Width = 123.636322021484400000
Size.Height = 34.000000000000000000
Size.PlatformDefault = False
TextSettings.Trimming = None
object TestPopup: TPopup
@@ -88,10 +88,9 @@ object Form1: TForm1
Size.Width = 47.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 5
TabOrder = 4
Text = 'Load'
TextSettings.Trimming = None
OnClick = LoadButtonClick
end
object RandomButton: TButton
Anchors = [akTop, akRight]
@@ -99,45 +98,54 @@ object Form1: TForm1
TabOrder = 2
Text = 'Random'
TextSettings.Trimming = None
OnClick = RandomButtonClick
end
object StopButton: TButton
Anchors = [akTop, akRight]
Position.Y = 63.000000000000000000
TabOrder = 8
Text = 'StopButton'
TextSettings.Trimming = None
OnClick = StopButtonClick
end
object ChartButton: TButton
Anchors = [akTop, akRight]
Position.Y = 85.000000000000000000
TabOrder = 7
Position.Y = 63.000000000000000000
TabOrder = 6
Text = 'ChartButton'
TextSettings.Trimming = None
OnClick = ChartButtonClick
end
object SymbolsComboBox: TComboBox
Anchors = [akTop, akRight]
Position.Y = 107.000000000000000000
Size.Width = 177.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 4
end
end
end
end
object StrategyButton: TSpeedButton
Align = FitLeft
Position.X = 290.909118652343800000
Size.Width = 145.454467773437500000
Size.Height = 40.000000000000000000
Position.X = 247.272705078125000000
Size.Width = 123.250000000000000000
Size.Height = 34.000000000000000000
Size.PlatformDefault = False
Text = 'Strategy'
TextSettings.Trimming = None
OnClick = StrategyButtonClick
end
object SymbolsComboBox: TComboBox
Align = FitLeft
Margins.Top = 4.000000000000000000
Margins.Bottom = 4.000000000000000000
Position.X = 370.522735595703100000
Position.Y = 4.000000000000000000
Size.Width = 141.192199707031300000
Size.Height = 26.000000000000000000
Size.PlatformDefault = False
TabOrder = 3
end
object StopButton: TButton
Align = FitLeft
Margins.Left = 8.000000000000000000
Margins.Top = 4.000000000000000000
Margins.Right = 8.000000000000000000
Margins.Bottom = 4.000000000000000000
Position.X = 519.714965820312500000
Position.Y = 4.000000000000000000
Size.Width = 111.404327392578100000
Size.Height = 26.000000000000000000
Size.PlatformDefault = False
TabOrder = 7
Text = 'StopButton'
TextSettings.Trimming = None
OnClick = StopButtonClick
end
end
end
object ObjectsPanel: TPanel
@@ -191,11 +199,11 @@ object Form1: TForm1
DataDetectorTypes = []
Align = Bottom
Position.Y = 712.000000000000000000
Size.Width = 796.000000000000000000
Size.Width = 1017.000000000000000000
Size.Height = 128.000000000000000000
Size.PlatformDefault = False
TabOrder = 1
Viewport.Width = 792.000000000000000000
Viewport.Width = 1013.000000000000000000
Viewport.Height = 124.000000000000000000
end
object ActionList: TActionList
AuraTrader/MainForm.pas
+214 -356
View File
@@ -75,32 +75,18 @@ type
TestPopup: TPopup;
FlowLayout: TFlowLayout;
StrategyButton: TSpeedButton;
procedure RandomButtonClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure LoadButtonClick(Sender: TObject);
procedure ChartButtonClick(Sender: TObject);
procedure StopButtonClick(Sender: TObject);
procedure LayoutResized(Sender: TObject);
procedure TreeViewDblClick(Sender: TObject);
procedure AddWorkspaceActionExecute(Sender: TObject);
procedure TestActionExecute(Sender: TObject);
procedure StrategyButtonClick(Sender: TObject);
private
const
cnt = 20;
type
TRndItem = record
Stream: IDataStream<TAuraAskBidFileItem>;
Data: TMutable<TDataSeries<TAuraAskBidFileItem>>;
Labl: TLabel;
end;
private
FOnEvent: TNotifyEvent;
{ Private declarations }
FServer: IDataServer<TAuraAskBidFileItem>;
FSymbols: TFuture<TArray<String>>;
FRandom: TList<TRndItem>;
FTerminate: TEvent;
FProcessDone: TState;
FApplication: IAuraApplication;
@@ -148,6 +134,184 @@ begin
FTerminate.Notify;
end;
procedure TForm1.TreeViewDblClick(Sender: TObject);
begin
var sel := TreeView.Selected as TTreeViewItem;
var parent := sel.ParentItem;
if parent = nil then
exit;
if parent = FModulesItem then
begin
if (TabControl.ActiveTab <> nil) and (TabControl.ActiveTab.Tag <> 0) then
begin
var ws := IAuraWorkspace(TabControl.ActiveTab.Tag);
var module := FApplication.Modules[sel.TagString];
if (ws <> nil) and (module <> nil) then
module.SetupWorkspace(ws);
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FApplication := TMycAuraApplication.Create;
FModulesItem := TTreeViewItem.Create(Self);
FModulesItem.Text := 'Modules';
const modName = 'Test_Module';
FApplication.RegisterModule(modName, TTestModule.Create('Test-Module', 1));
TreeView.AddObject(FModulesItem);
FModulesItem.ProcessSignal(
FApplication.ModuleNames.Changed,
procedure
begin
FModulesItem.BeginUpdate;
try
while FModulesItem.Count > 0 do
FModulesItem[0].Free;
var mods := FApplication.ModuleNames.Value;
for var i := 0 to High(mods) do
begin
var ModItem := TTreeViewItem.Create(Self);
ModItem.Text := mods[i];
ModItem.DragMode := TDragMode.dmAutomatic;
ModItem.Text := 'Module-' + mods[i];
ModItem.TagString := mods[i];
FModulesItem.AddObject(ModItem);
end;
FModulesItem.ExpandAll;
finally
FModulesItem.EndUpdate;
end;
end
);
FTerminate := TEvent.CreateEvent;
// Create an instance of the TAuraTABFileServer. The server can be reused for multiple stream creations. [364]
FServer := TAuraTABFileServer.Create('\\COFFEE\TickData\Pepperstone');
SymbolsComboBox.Enabled := false;
ChartButton.Enabled := false;
LoadButton.Enabled := false;
FSymbols := FServer.EnumerateSymbols;
SymbolsComboBox.ProcessSignal(
FSymbols.Done.Signal,
procedure
begin
SymbolsComboBox.BeginUpdate;
try
SymbolsComboBox.Items.Clear;
SymbolsComboBox.Items.AddStrings(FSymbols.WaitFor);
if SymbolsComboBox.Items.Count > 0 then
begin
if SymbolsComboBox.ItemIndex < 0 then
SymbolsComboBox.ItemIndex := SymbolsComboBox.Items.IndexOf('GER40');
SymbolsComboBox.Enabled := true;
ChartButton.Enabled := true;
LoadButton.Enabled := true;
end;
finally
SymbolsComboBox.EndUpdate;
end;
end
);
NewWorkspace;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FSymbols.WaitFor;
FTerminate.Notify;
TaskManager.WaitFor(FProcessDone);
end;
procedure TForm1.TestActionExecute(Sender: TObject);
begin
TestPopup.IsOpen := TestAction.Checked;
end;
procedure TForm1.AddWorkspaceActionExecute(Sender: TObject);
begin
NewWorkspace;
end;
procedure TForm1.AlignControl(Control: TControl);
begin
var Layout := CurrLayout<TVertScrollBox>;
if Layout = nil then
exit;
Control.Parent := Layout;
Control.Width := Layout.Width;
Control.Position.Y := Layout.ChildrenRect.Bottom + 1;
Control.Anchors := [TAnchorKind.akLeft, TAnchorKind.akRight];
Control.Align := TAlignLayout.Top;
end;
function TForm1.CurrLayout<T>: T;
begin
if TabControl.ActiveTab = nil then
exit(nil);
var Res: T := nil;
TabControl.ActiveTab.EnumControls(
function(Control: TControl): TEnumControlsResult
begin
Result := TEnumControlsResult.Continue;
if Control is T then
begin
Res := Control as T;
Result := TEnumControlsResult.Stop;
end;
end
);
Result := Res;
end;
function TForm1.ExecuteStrategy(const Symbol: String; const Processor: IMycProcessor<TArray<TDataPoint<TAskBidItem>>>): TState;
var
dataProvider: IMycConverter<TArray<TDataPoint<TAuraAskBidFileItem>>, TArray<TDataPoint<TAskBidItem>>>;
begin
var terminated := TFlag.CreateObserver(FTerminate.Signal).State;
dataProvider :=
TMycGenericConverter<TArray<TDataPoint<TAuraAskBidFileItem>>, TArray<TDataPoint<TAskBidItem>>>.Create(
function(const Values: TArray<TDataPoint<TAuraAskBidFileItem>>): TArray<TDataPoint<TAskBidItem>>
begin
SetLength(Result, Length(Values));
for var i := 0 to High(Result) do
begin
Result[i].Time := Values[i].Time;
Result[i].Data.Ask := Values[i].Data.Ask;
Result[i].Data.Bid := Values[i].Data.Bid;
end;
end
);
dataProvider.Sender.Link(Processor);
Result := FServer.ProcessData(Symbol, terminated, dataProvider);
end;
function TForm1.SelectedSymbol: String;
begin
Result := '';
if RandomBox.IsChecked then
Result := FSymbols.WaitFor[Random(Length(FSymbols.WaitFor))]
else if SymbolsComboBox.ItemIndex >= 0 then
Result := FSymbols.WaitFor[SymbolsComboBox.ItemIndex];
end;
procedure TForm1.StrategyButtonClick(Sender: TObject);
begin
var Layout := CurrLayout<TVertScrollBox>;
@@ -179,7 +343,7 @@ begin
OhlcPoint.Sender.Link(TimeStamps);
chart.SetXAxisSeries(timeframe, Timestamps.Sender);
var Panel := chart.Panels[0];
var Panel := chart.AddPanel;
var Ohlc: IMycConverter<TDataPoint<TOhlcItem>, TOhlcItem> :=
TMycGenericConverter<TDataPoint<TOhlcItem>, TOhlcItem>
@@ -275,351 +439,45 @@ begin
Stoch.Sender.Link(StochD);
Panel.AddDoubleSeries(StochD.Sender, TAlphaColors.Red);
var done := ExecuteStrategy(Symbol, ticker);
/////
var tickChart := TMycChart.Create(Self);
tickChart.Height := Layout.ChildrenRect.Width * 9 / 16;
AlignControl(tickChart);
tickChart.Lookback.Value := 1000000;
var TickTime: IMycConverter<TDataPoint<TAskBidItem>, TDateTime> :=
TMycGenericConverter<TDataPoint<TAskBidItem>, TDateTime>
.Create(function(const Tick: TDataPoint<TAskBidItem>): TDateTime begin Result := Tick.Time; end);
var TickAsk: IMycConverter<TDataPoint<TAskBidItem>, Double> :=
TMycGenericConverter<TDataPoint<TAskBidItem>, Double>
.Create(function(const Tick: TDataPoint<TAskBidItem>): Double begin Result := Tick.Data.Ask; end);
var TickBid: IMycConverter<TDataPoint<TAskBidItem>, Double> :=
TMycGenericConverter<TDataPoint<TAskBidItem>, Double>
.Create(function(const Tick: TDataPoint<TAskBidItem>): Double begin Result := Tick.Data.Bid; end);
var TickSpread: IMycConverter<TDataPoint<TAskBidItem>, Double> :=
TMycGenericConverter<TDataPoint<TAskBidItem>, Double>
.Create(function(const Tick: TDataPoint<TAskBidItem>): Double begin Result := Tick.Data.Bid-Tick.Data.Ask; end);
ticker.Sender.Link( TickTime );
ticker.Sender.Link( TickAsk );
ticker.Sender.Link( TickBid );
ticker.Sender.Link( TickSpread );
tickChart.SetXAxisSeries( TTimeframe.S, TickTime.Sender );
panel := tickChart.AddPanel;
panel.AddDoubleSeries(TickAsk.Sender, TAlphaColors.Blue);
panel.AddDoubleSeries(TickBid.Sender, TAlphaColors.Red);
panel := tickChart.AddPanel;
panel.AddDoubleSeries(TickSpread.Sender);
/////
var done := ExecuteStrategy(Symbol, ticker);
FProcessDone := TState.All([FProcessDone, done]);
end;
procedure TForm1.TreeViewDblClick(Sender: TObject);
begin
var sel := TreeView.Selected as TTreeViewItem;
var parent := sel.ParentItem;
if parent = nil then
exit;
if parent = FModulesItem then
begin
if (TabControl.ActiveTab <> nil) and (TabControl.ActiveTab.Tag <> 0) then
begin
var ws := IAuraWorkspace(TabControl.ActiveTab.Tag);
var module := FApplication.Modules[sel.TagString];
if (ws <> nil) and (module <> nil) then
module.SetupWorkspace(ws);
end;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FApplication := TMycAuraApplication.Create;
FModulesItem := TTreeViewItem.Create(Self);
FModulesItem.Text := 'Modules';
const modName = 'Test_Module';
FApplication.RegisterModule(modName, TTestModule.Create('Test-Module', 1));
TreeView.AddObject(FModulesItem);
FModulesItem.ProcessSignal(
FApplication.ModuleNames.Changed,
procedure
begin
FModulesItem.BeginUpdate;
try
while FModulesItem.Count > 0 do
FModulesItem[0].Free;
var mods := FApplication.ModuleNames.Value;
for var i := 0 to High(mods) do
begin
var ModItem := TTreeViewItem.Create(Self);
ModItem.Text := mods[i];
ModItem.DragMode := TDragMode.dmAutomatic;
ModItem.Text := 'Module-' + mods[i];
ModItem.TagString := mods[i];
FModulesItem.AddObject(ModItem);
end;
FModulesItem.ExpandAll;
finally
FModulesItem.EndUpdate;
end;
end
);
FTerminate := TEvent.CreateEvent;
FRandom := TList<TRndItem>.Create;
// Create an instance of the TAuraTABFileServer. The server can be reused for multiple stream creations. [364]
FServer := TAuraTABFileServer.Create('\\COFFEE\TickData\Pepperstone');
SymbolsComboBox.Enabled := false;
ChartButton.Enabled := false;
LoadButton.Enabled := false;
FSymbols := FServer.EnumerateSymbols;
SymbolsComboBox.ProcessSignal(
FSymbols.Done.Signal,
procedure
begin
SymbolsComboBox.BeginUpdate;
try
SymbolsComboBox.Items.Clear;
SymbolsComboBox.Items.AddStrings(FSymbols.WaitFor);
if SymbolsComboBox.Items.Count > 0 then
begin
if SymbolsComboBox.ItemIndex < 0 then
SymbolsComboBox.ItemIndex := SymbolsComboBox.Items.IndexOf('GER40');
SymbolsComboBox.Enabled := true;
ChartButton.Enabled := true;
LoadButton.Enabled := true;
end;
finally
SymbolsComboBox.EndUpdate;
end;
end
);
NewWorkspace;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FSymbols.WaitFor;
FTerminate.Notify;
TaskManager.WaitFor(FProcessDone);
FRandom.Free;
end;
procedure TForm1.LayoutResized(Sender: TObject);
begin
LogMemo.Lines.Add('resize');
end;
procedure TForm1.LoadButtonClick(Sender: TObject);
begin
if SymbolsComboBox.ItemIndex < 0 then
exit;
var Layout := CurrLayout<TVertScrollBox>;
if Layout = nil then
exit;
var Stream := FServer.CreateStream(FSymbols.WaitFor[SymbolsComboBox.ItemIndex]);
var Data := TDataStreamProvider.Create<TAuraAskBidFileItem>(30000, 10000, Stream);
var path := TPath.Create(Self);
path.Parent := Layout;
path.Align := TAlignLayout.None;
path.ProcessSignal(
Data.Changed,
procedure
begin
var Prices := Data.Value;
if Prices.Count > 0 then
begin
path.BeginUpdate;
try
path.Data.Clear;
path.Data.MoveTo(PointF(path.Width - 1, Prices[0].Data.Ask));
for var i := 1 to Prices.Count - 1 do
path.Data.LineTo(PointF(path.Width - i - 1, Prices[i].Data.Ask));
finally
path.EndUpdate;
end;
end;
end
);
end;
procedure TForm1.RandomButtonClick(Sender: TObject);
begin
var Layout := CurrLayout<TVertScrollBox>;
if Layout = nil then
exit;
var rnd: TRndItem;
rnd.Stream := FServer.CreateStream(FSymbols.WaitFor[Random(Length(FSymbols.WaitFor))]);
rnd.Data := TDataStreamProvider.Create<TAuraAskBidFileItem>(3000, 1000, rnd.Stream);
rnd.Labl := TLabel.Create(Self);
rnd.Labl.Parent := Layout;
rnd.Labl.Align := TAlignLayout.None;
rnd.Labl.WordWrap := false;
rnd.Labl.Width := 300;
rnd.Labl.Text := rnd.Stream.Symbol + ' loading...';
FRandom.Add(rnd);
var Proc :=
procedure(idx: Integer)
begin
FRandom[idx]
.Labl
.ProcessSignal(
FRandom[idx].Data.Changed,
procedure
begin
var data := FRandom[idx].Data.Value;
if data.Count > 0 then
begin
var dp := data[0];
FRandom[idx].Labl.Text :=
FRandom[idx].Stream.Symbol
+ ' '
+ dp.Time.ToString
+ ' '
+ data.TotalCount.ToString
+ ' '
+ dp.Data.Ask.ToString;
end;
end);
end;
Proc(FRandom.Count - 1);
end;
procedure TForm1.TestActionExecute(Sender: TObject);
begin
TestPopup.IsOpen := TestAction.Checked;
end;
procedure TForm1.AddWorkspaceActionExecute(Sender: TObject);
begin
NewWorkspace;
end;
procedure TForm1.AlignControl(Control: TControl);
begin
var Layout := CurrLayout<TVertScrollBox>;
if Layout = nil then
exit;
Control.Parent := Layout;
Control.Width := Layout.Width;
Control.Position.Y := Layout.ChildrenRect.Bottom + 1;
Control.Anchors := [TAnchorKind.akLeft, TAnchorKind.akRight];
Control.Align := TAlignLayout.Top;
end;
procedure TForm1.ChartButtonClick(Sender: TObject);
begin
var Layout := CurrLayout<TVertScrollBox>;
if Layout = nil then
exit;
var Symbol := SelectedSymbol;
if Symbol = '' then
exit;
var currPathData := TWriteable<IObjectRef<TPathData>>.CreateWriteable.Protect;
var currLog := TWriteable<String>.CreateWriteable.Protect;
const width = 300;
var terminated := TFlag.CreateObserver(FTerminate.Signal).State;
var done :=
TaskManager.RunTask(
nil,
function: TState
begin
var Prices := TDataSeries<TAuraAskBidFileItem>.CreateDataSeries(width);
Result :=
FServer.ProcessData(
Symbol,
terminated,
TMycGenericProcessor<TArray<TDataPoint<TAuraAskBidFileItem>>>.Create(
function(const Values: TArray<TDataPoint<TAuraAskBidFileItem>>): TState
begin
Result := TState.Null;
Prices := Prices.Add(Values);
currLog.Value := Prices.TotalCount.ToString;
var PathData := TPathData.Create;
if Prices.Count > 0 then
begin
var n := Prices.Count;
PathData.MoveTo(PointF(n - 1, Prices[0].Data.Ask));
for var i := 1 to n - 1 do
PathData.LineTo(PointF(n - i - 1, Prices[i].Data.Ask));
for var i := n - 1 downto 0 do
PathData.LineTo(PointF(n - i - 1, Prices[i].Data.Bid));
end;
PathData.ClosePath;
currPathData.Value := TObjectRef<TPathData>.Create(PathData);
end
)
);
end
);
FProcessDone := TState.All([FProcessDone, done]);
var path := TPath.Create(Self);
path.Parent := Layout;
path.Align := TAlignLayout.None;
path.ProcessSignal(
currPathData.Changed,
procedure(out IsDone: Boolean)
begin
if currPathData.Value <> nil then
path.Data.Assign(currPathData.Value.Obj);
IsDone := done.IsSet;
end
);
end;
function TForm1.CurrLayout<T>: T;
begin
if TabControl.ActiveTab = nil then
exit(nil);
var Res: T := nil;
TabControl.ActiveTab.EnumControls(
function(Control: TControl): TEnumControlsResult
begin
Result := TEnumControlsResult.Continue;
if Control is T then
begin
Res := Control as T;
Result := TEnumControlsResult.Stop;
end;
end
);
Result := Res;
end;
function TForm1.ExecuteStrategy(const Symbol: String; const Processor: IMycProcessor<TArray<TDataPoint<TAskBidItem>>>): TState;
var
dataProvider: IMycConverter<TArray<TDataPoint<TAuraAskBidFileItem>>, TArray<TDataPoint<TAskBidItem>>>;
begin
var terminated := TFlag.CreateObserver(FTerminate.Signal).State;
dataProvider :=
TMycGenericConverter<TArray<TDataPoint<TAuraAskBidFileItem>>, TArray<TDataPoint<TAskBidItem>>>.Create(
function(const Values: TArray<TDataPoint<TAuraAskBidFileItem>>): TArray<TDataPoint<TAskBidItem>>
begin
SetLength(Result, Length(Values));
for var i := 0 to High(Result) do
begin
Result[i].Time := Values[i].Time;
Result[i].Data.Ask := Values[i].Data.Ask;
Result[i].Data.Bid := Values[i].Data.Bid;
end;
end
);
dataProvider.Sender.Link(Processor);
Result := FServer.ProcessData(Symbol, terminated, dataProvider);
end;
function TForm1.SelectedSymbol: String;
begin
Result := '';
if RandomBox.IsChecked then
Result := FSymbols.WaitFor[Random(Length(FSymbols.WaitFor))]
else if SymbolsComboBox.ItemIndex >= 0 then
Result := FSymbols.WaitFor[SymbolsComboBox.ItemIndex];
end;
end.
Src/Myc.Fmx.Chart.Series.pas
+30 -17
View File
@@ -65,7 +65,8 @@ type
function GetSeries: TMycChart.TSeries; override;
function GetValueRange(First, Last: Int64; out MinValue, MaxValue: Double): Boolean; override; abstract;
procedure Update; override;
procedure Paint(const Canvas: TCanvas; First, Last: Int64; const XForm, YForm: TFunc<Double, Single>); override; abstract;
procedure Paint(const Canvas: TCanvas; First, Last: Int64; const XForm: TFunc<Int64, Single>; const YForm: TFunc<Double, Single>);
override; abstract;
public
constructor Create(AParent: TMycChart.TPanel; const ADataProvider: IMycDataProvider<T>);
destructor Destroy; override;
@@ -78,7 +79,7 @@ type
FDownColor: TMutable<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;
procedure Paint(const Canvas: TCanvas; First, Last: Int64; const XForm: TFunc<Int64, Single>; const YForm: TFunc<Double, Single>); override;
public
constructor Create(
AParent: TMycChart.TPanel;
@@ -94,7 +95,7 @@ type
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;
procedure Paint(const Canvas: TCanvas; First, Last: Int64; const XForm: TFunc<Int64, Single>; const YForm: TFunc<Double, Single>); override;
public
constructor Create(
AParent: TMycChart.TPanel;
@@ -227,30 +228,41 @@ begin
MaxValue := Max(MaxValue, v);
end;
end;
Result := (MinValue <> MaxDouble);
Result := (MinValue < MaxValue);
end;
procedure TChartLineLayer.Paint(const Canvas: TCanvas; First, Last: Int64; const XForm, YForm: TFunc<Double, Single>);
procedure TChartLineLayer.Paint(const Canvas: TCanvas; First, Last: Int64; const XForm: TFunc<Int64, Single>; const YForm: TFunc<Double,
Single>);
var
points: TPathData;
i, n: Int64;
n: Int64;
begin
points := TPathData.Create;
try
// Skip warmup data
n := First;
while (n <= Last) and (IsNaN(FSeries.Data[n])) do
inc(n);
if (n > Last) then
exit;
while n < Last do
begin
// Skip warmup/gap data
while (n <= Last) and (IsNaN(FSeries.Data[n])) do
inc(n);
points.MoveTo(TPointF.Create(XForm(n), YForm(FSeries.Data[n])));
for i := n + 1 to Last do
if not IsNaN(FSeries.Data[i]) then
points.LineTo(TPointF.Create(XForm(i), YForm(FSeries.Data[i])));
if n < Last then
begin
points.MoveTo(TPointF.Create(XForm(n), YForm(FSeries.Data[n])));
inc( n );
while n <= Last do
begin
if IsNaN(FSeries.Data[n]) then
break;
points.LineTo(TPointF.Create(XForm(n), YForm(FSeries.Data[n])));
inc( n );
end;
end;
end;
Canvas.Stroke.Color := FLineColor;
Canvas.Stroke.Thickness := FLineWidth;
Canvas.Stroke.Thickness := 3; //FLineWidth;
Canvas.Stroke.Join := TStrokeJoin.Bevel;
Canvas.DrawPath(points, 1);
finally
points.Free;
@@ -289,7 +301,8 @@ begin
Result := (MinValue <> MaxDouble);
end;
procedure TChartOhlcLayer.Paint(const Canvas: TCanvas; First, Last: Int64; const XForm, YForm: TFunc<Double, Single>);
procedure TChartOhlcLayer.Paint(const Canvas: TCanvas; First, Last: Int64; const XForm: TFunc<Int64, Single>; const YForm: TFunc<Double,
Single>);
var
i: Int64;
x, candleWidth: Single;
Src/Myc.Fmx.Chart.pas
+24 -24
View File
@@ -54,7 +54,8 @@ type
protected
function GetOwner: TMycChart; override; final;
function GetValueRange(First, Last: Int64; out Min, Max: Double): Boolean; virtual; abstract;
procedure Paint(const Canvas: TCanvas; First, Last: Int64; const XForm, YForm: TFunc<Double, Single>); virtual; abstract;
procedure Paint(const Canvas: TCanvas; First, Last: Int64; const XForm: TFunc<Int64, Single>; const YForm: TFunc<Double, Single>); virtual;
abstract;
public
constructor Create(AParent: TPanel);
end;
@@ -100,7 +101,7 @@ type
procedure Update(MasterTotalCount: Int64; ViewStartIndex: Int64; out SeriesChanged, SeriesRepaint: Boolean);
public
constructor Create(AOwner: TMycChart);
constructor Create(AOwner: TMycChart; AWeight: Single);
destructor Destroy; override;
function AddOhlcSeries(
@@ -206,9 +207,6 @@ begin
TMessageManager
.DefaultManager
.SubscribeToMessage(TIdleMessage, procedure(const Sender: TObject; const M: TMessage) begin DoIdle; end);
// Create the default panel.
AddPanel.Weight := 1.0;
end;
destructor TMycChart.Destroy;
@@ -222,7 +220,7 @@ end;
function TMycChart.AddPanel: TPanel;
begin
Result := TPanel.Create(Self);
Result := TPanel.Create(Self, IfThen(FPanelList.Count=0, 1, 0.2));
FPanelList.Add(Result);
Repaint;
end;
@@ -305,7 +303,8 @@ var
buttonColor: TAlphaColor;
path: TPathData;
masterTotalCount: Int64;
panelHeight, totalWeight, currentY: Single;
panelHeight, totalWeight: Double;
currentY: Single;
begin
inherited;
rect := Self.LocalRect;
@@ -330,7 +329,7 @@ begin
for var i := 0 to PanelCount - 1 do
begin
var panel := Panels[i];
panelHeight := (panel.Weight / totalWeight) * rect.Height;
panelHeight := panel.Weight * rect.Height / totalWeight;
panelRect := TRectF.Create(rect.Left, currentY, rect.Right, currentY + panelHeight);
// Draw panel content
@@ -468,7 +467,6 @@ end;
procedure TMycChart.MouseMove(Shift: TShiftState; X, Y: Single);
var
dx, dy: Single;
indexDelta: Int64;
maxIndex: Int64;
begin
@@ -481,8 +479,8 @@ begin
// --- Panel Resizing Logic ---
if FIsResizing then
begin
dy := Y - FDragStartPoint.Point.Y;
if Abs(dx) < 2 then // Threshold to avoid jitter
var dy := FMousePos.Point.Y - FDragStartPoint.Point.Y;
if Abs(dy) < 2 then // Threshold to avoid jitter
exit;
var panel1 := Panels[FResizePanelIndex];
@@ -529,8 +527,7 @@ begin
// --- Chart Panning Logic ---
if FIsDragging then
begin
dx := X - FDragStartPoint.Point.X;
if Abs(dx) < 2 then // Threshold to avoid jitter
if Abs(FMousePos.Point.X - FDragStartPoint.Point.X) < 2 then // Threshold to avoid jitter
exit;
if not Assigned(FXAxisSeries) or (FViewCount <= 0) then
@@ -653,12 +650,12 @@ end;
{ TMycChart.TPanel }
constructor TMycChart.TPanel.Create(AOwner: TMycChart);
constructor TMycChart.TPanel.Create(AOwner: TMycChart; AWeight: Single);
begin
inherited Create;
FOwner := AOwner;
FSeriesList := TObjectList<TMycChart.TDataLayer>.Create(true);
FWeight := 0.2;
FWeight := AWeight;
end;
destructor TMycChart.TPanel.Destroy;
@@ -690,10 +687,11 @@ end;
procedure TMycChart.TPanel.Paint(const Canvas: TCanvas; const Viewport: TRectF; MasterTotalCount, ViewStartIndex, ViewCount: Int64);
var
localMin, localMax, seriesMin, seriesMax, padding: Double;
localMin, localMax, seriesMin, seriesMax: Double;
rangeInitialized: Boolean;
seriesFirst, seriesLast: Int64;
xTransform, yTransform: TFunc<Double, Single>;
xTransform: TFunc<Int64, Single>;
yTransform: TFunc<Double, Single>;
function CalcView(Series: TMycChart.TSeries; out First, Last: Int64): Boolean;
var
@@ -710,6 +708,8 @@ var
begin
rangeInitialized := false;
localMin := 0;
localMax := 0;
// 1. Calculate value range (Y-Axis) for this panel only
for var series in FSeriesList do
@@ -736,18 +736,18 @@ begin
if not rangeInitialized then
Exit; // Nothing to draw in this panel
padding := (localMax - localMin) * 0.1;
localMin := localMin - padding;
localMax := localMax + padding;
if (localMax - localMin) = 0 then
localMax := localMin + 1; // Avoid division by zero
// 2. Create transforms for this panel
const padding = 2;
var top: Double := Viewport.Top + padding;
var height: Double := Viewport.Height-(2*padding);
var range: Double := localMax - localMin;
yTransform :=
function(value: Double): Single
begin
Result := Viewport.Top + (1 - (value - localMin) / (localMax - localMin)) * Viewport.Height;
Result := top + (1 - (value - localMin) / range) * height;
end;
// 3. Paint all layers in this panel
@@ -757,7 +757,7 @@ begin
begin
var offset := MasterTotalCount - series.Series.TotalCount;
xTransform :=
function(index: Double): Single
function(index: Int64): Single
begin
Result := Viewport.Right - (((index + offset - ViewStartIndex) / (ViewCount - 1)) * Viewport.Width);
end;
@@ -885,7 +885,7 @@ begin
Canvas.Stroke.Kind := TBrushKind.Solid;
Canvas.Stroke.Color := TAlphaColors.Gray;
Canvas.Stroke.Thickness := 1;
Canvas.FillRect(captionRect, 2, 2, AllCorners, 1.0);
Canvas.FillRect(captionRect, 2, 2, AllCorners, 0.7);
Canvas.DrawRect(captionRect, 2, 2, AllCorners, 1.0);
// Draw the text
Src/Myc.Trade.DataProvider.pas
-59
View File
@@ -8,65 +8,6 @@ uses
Myc.Trade.DataPoint,
Myc.Trade.DataStream;
type
TDataStreamProvider<T> = class(TInterfacedObject, TMutable<TDataSeries<T>>.IMutable)
private
FStream: IDataStream<T>;
FDataSeries: TDataSeries<T>;
FNewDataAvailable: TFlag;
FChunk: TArray<TDataPoint<T>>;
FLookback: Int64;
function GetChanged: TSignal;
function GetValue: TDataSeries<T>;
public
constructor Create(ALookback, AMaxChunkSize: Int64; const AStream: IDataStream<T>);
destructor Destroy; override;
end;
TDataStreamProvider = record
class function Create<T>(Lookback, MaxChunkSize: Int64; const Stream: IDataStream<T>): TMutable<TDataSeries<T>>; static;
end;
implementation
{ TDataStreamProvider<T> }
constructor TDataStreamProvider<T>.Create(ALookback, AMaxChunkSize: Int64; const AStream: IDataStream<T>);
begin
inherited Create;
FLookback := ALookback;
SetLength(FChunk, AMaxChunkSize);
FStream := AStream;
FNewDataAvailable := TFlag.CreateObserver(FStream.HasData);
FDataSeries := TDataSeries<T>.CreateDataSeries(ALookback);
end;
destructor TDataStreamProvider<T>.Destroy;
begin
inherited;
end;
function TDataStreamProvider<T>.GetChanged: TSignal;
begin
Result := FStream.HasData;
end;
function TDataStreamProvider<T>.GetValue: TDataSeries<T>;
begin
if FNewDataAvailable.Reset then
begin
var cnt := FStream.GetChunk(FChunk);
if cnt > 0 then
FDataSeries := FDataSeries.Add(FChunk, 0, cnt);
end;
Result := FDataSeries;
end;
{ TDataStreamProvider }
class function TDataStreamProvider.Create<T>(Lookback, MaxChunkSize: Int64; const Stream: IDataStream<T>): TMutable<TDataSeries<T>>;
begin
Result := TDataStreamProvider<T>.Create(Lookback, MaxChunkSize, Stream);
end;
end.
Src/Myc.Trade.DataStream.pas
+1 -237
View File
@@ -1,20 +1,5 @@
unit Myc.Trade.DataStream;
(*
Myc.Trade.DataStream
Provides a data server for loading time-series data and streaming it.
This unit contains the core components for handling historical data:
- TFileRecord: A generic record for a single time-stamped data entry.
- IDataServer/TAuraDataServer: A server component responsible for loading and caching
series of data files from disk. Each server instance manages its own cache,
but all instances share a central load gate.
- IDataStream/TDataStream: An interface representing a stream of data points that
can be consumed sequentially.
- TAuraFileStream: A concrete implementation of IDataStream that is fed by an
IDataServer instance.
*)
interface
uses
@@ -30,34 +15,9 @@ uses
Myc.Core.FileCache;
type
// Represents a generic data stream capable of providing sequential data chunks.
// IsHistory:
// - true, if this stream is a history stream. Once HasData becomes false, it reached it's end and will not provide more data.
// - false, we expect more Data to come. This stream has no end.
// HasData: set, if a call to GetChunk will return new data.
IDataStream<T> = interface
['{A6E246A2-E84E-49AB-A63E-333E561E488C}']
function GetHasData: TSignal;
function GetChunk(var Data: array of TDataPoint<T>): Integer;
function GetSymbol: String;
function IsHistory: Boolean;
property HasData: TSignal read GetHasData;
property Symbol: String read GetSymbol;
end;
// Abstract base class for IDataStream implementations.
TDataStream<T> = class(TInterfacedObject, IDataStream<T>)
protected
function GetSymbol: String; virtual; abstract;
function GetHasData: TSignal; virtual; abstract;
function GetChunk(var Data: array of TDataPoint<T>): Integer; virtual; abstract;
function IsHistory: Boolean; virtual; abstract;
end;
// Interface for an instantiable data server.
IDataServer<T: record> = interface
['{1F8E5A9D-E92A-44C1-9F3F-C4B82A6E94B3}']
function CreateStream(const Symbol: String): IDataStream<T>;
procedure ClearCache;
function ProcessData(const Symbol: String; const Terminated: TState; const Processor: IMycProcessor<TArray<TDataPoint<T>>>): TState;
function EnumerateSymbols: TFuture<TArray<String>>;
@@ -120,7 +80,6 @@ type
constructor Create(const APath: String);
destructor Destroy; override;
procedure AfterConstruction; override;
function CreateStream(const Symbol: String): IDataStream<T>; virtual; abstract;
procedure ClearCache;
procedure UpdateSymbols;
// Scans a directory to find the oldest file for a specific symbol.
@@ -136,37 +95,6 @@ type
property Path: String read GetPath;
end;
// Implements a data stream that reads from Aura-specific historical data files.
TAuraFileStream<T: record> = class(TDataStream<T>, IDataStream<T>)
private
type
TDataStream = record
FileInfo: TAuraDataFile;
Data: TFuture<TArray<TArray<TDataPoint<T>>>>;
end;
private
FDataServer: TAuraDataServer<T>;
FSymbol: String;
FHasData: TEvent;
FNextReady: TFlag;
FCurrent: TFuture<TDataStream>;
FNext: TFuture<TDataStream>;
FCurrChunkInFile: Int64;
FCurrPosInFile: Int64;
FLastTimeStamp: TDateTime;
procedure PreloadNext;
protected
function GetSymbol: String; override;
function GetHasData: TSignal; override;
function GetChunk(var Data: array of TDataPoint<T>): Integer; override;
function IsHistory: Boolean; override;
public
constructor Create(ADataServer: TAuraDataServer<T>; const ASymbol: String);
destructor Destroy; override;
procedure AfterConstruction; override;
procedure BeforeDestruction; override;
end;
// Aura tick data file Ask-Bid
TAuraAskBidFileItem = packed record
@@ -180,7 +108,6 @@ type
class function ReadCompressedData(const InputStream: TStream): TArray<TArray<TDataPoint<TAuraAskBidFileItem>>>; override;
class function ReadUncompressedData(const InputStream: TStream): TArray<TArray<TDataPoint<TAuraAskBidFileItem>>>; override;
public
function CreateStream(const Symbol: String): IDataStream<TAuraAskBidFileItem>; override;
function LoadDataSeries(const InitialFile: TAuraDataFile): TFuture<TArray<TDataPoint<TAuraAskBidFileItem>>>;
function ParseFileName(const FileName: string): TAuraDataFile; override;
end;
@@ -195,7 +122,7 @@ uses
const
// The number of records per data chunk when loading files.
ChunkSize = 8192;
ChunkSize = 512;
{ TAuraDataFile }
@@ -463,169 +390,6 @@ begin
);
end;
{ TAuraFileStream<T> }
constructor TAuraFileStream<T>.Create(ADataServer: TAuraDataServer<T>; const ASymbol: String);
begin
inherited Create;
Assert(Assigned(ADataServer));
FDataServer := ADataServer;
FSymbol := ASymbol;
FNextReady := TFlag.CreateFlag;
FHasData := TEvent.CreateRouter(FNextReady.State.Signal);
end;
destructor TAuraFileStream<T>.Destroy;
begin
inherited;
end;
procedure TAuraFileStream<T>.AfterConstruction;
var
firstFile: TFuture<TAuraDataFile>;
begin
inherited;
// We need the path from the server instance to find the file.
firstFile := FDataServer.FindFirstFile(FSymbol);
FCurrent :=
firstFile.Chain<TDataStream>(
function(const FileInfo: TAuraDataFile): TDataStream
begin
if FileInfo.IsValid then
begin
Result.FileInfo := FileInfo;
Result.Data := FDataServer.LoadDataFile(FileInfo);
Result.Data.Done.Signal.Subscribe(FNextReady);
end;
end
);
FLastTimeStamp := 0;
FCurrChunkInFile := 0;
FCurrPosInFile := 0;
PreloadNext;
end;
procedure TAuraFileStream<T>.BeforeDestruction;
begin
FCurrent.WaitFor;
FCurrent.Value.Data.WaitFor;
FNext.WaitFor;
FNext.Value.Data.WaitFor;
inherited;
end;
function TAuraFileStream<T>.GetChunk(var Data: array of TDataPoint<T>): Integer;
var
item: TDataPoint<T>;
fileChunks: TArray<TArray<TDataPoint<T>>>;
currentChunk: TArray<TDataPoint<T>>;
label
loop;
begin
Result := 0;
loop:
if not FCurrent.Done.IsSet then
exit;
if not FCurrent.Value.Data.Done.IsSet then
exit;
if not FCurrent.Value.FileInfo.IsValid then
exit;
fileChunks := FCurrent.Value.Data.Value;
if (fileChunks = nil) or (FCurrChunkInFile >= Length(fileChunks)) then
begin
// Finished with current file, move to next
FCurrChunkInFile := 0;
FCurrPosInFile := 0;
FCurrent := FNext;
PreloadNext;
goto loop;
end;
var maxLen := Length(Data);
while (Result < maxLen) do
begin
// Check if we need to advance to the next chunk
if (FCurrChunkInFile < Length(fileChunks)) and (FCurrPosInFile >= Length(fileChunks[FCurrChunkInFile])) then
begin
Inc(FCurrChunkInFile);
FCurrPosInFile := 0;
end;
// Exit loop if all chunks are processed for the current file
if FCurrChunkInFile >= Length(fileChunks) then
break;
currentChunk := fileChunks[FCurrChunkInFile];
item := currentChunk[FCurrPosInFile];
if FLastTimeStamp < item.Time then
begin
FLastTimeStamp := item.Time;
Data[Result].Create(FLastTimeStamp, item.Data);
Inc(Result);
end;
Inc(FCurrPosInFile);
end;
// Notify if there is potentially more data
if (FCurrChunkInFile < Length(fileChunks)) or FNextReady.Reset then
begin
FHasData.Notify;
end;
end;
function TAuraFileStream<T>.GetHasData: TSignal;
begin
Result := FHasData.Signal;
end;
function TAuraFileStream<T>.GetSymbol: String;
begin
Result := FSymbol;
end;
function TAuraFileStream<T>.IsHistory: Boolean;
begin
Result := True;
end;
procedure TAuraFileStream<T>.PreloadNext;
begin
FNextReady.Reset;
FNext :=
FCurrent.Chain<TDataStream>(
function(const Prev: TDataStream): TDataStream
var
nextFileInfo: TAuraDataFile;
begin
if Prev.FileInfo.IsValid then
begin
nextFileInfo := Prev.FileInfo.GetNextFile;
if nextFileInfo.IsValid then
begin
Result.FileInfo := nextFileInfo;
Result.Data := FDataServer.LoadDataFile(nextFileInfo);
Result.Data.Done.Signal.Subscribe(FNextReady);
end;
end;
end
);
end;
{ TAuraTABFileServer }
function TAuraTABFileServer.CreateStream(const Symbol: String): IDataStream<TAuraAskBidFileItem>;
begin
Result := TAuraFileStream<TAuraAskBidFileItem>.Create(Self, Symbol);
end;
function TAuraTABFileServer.LoadDataSeries(const InitialFile: TAuraDataFile): TFuture<TArray<TDataPoint<TAuraAskBidFileItem>>>;
var
loadedState: TState;