Implementing first "strategy" for proof of concept
This commit is contained in:
Michael Schimmel
@@ -10,13 +10,15 @@ uses
|
||||
Myc.Aura.Module in '..\Src\Myc.Aura.Module.pas',
|
||||
Myc.Aura.Parameter in '..\Src\Myc.Aura.Parameter.pas',
|
||||
TestModule in 'TestModule.pas',
|
||||
TestChartControl in 'TestChartControl.pas' {TestChartForm};
|
||||
DynamicFMXControl in 'DynamicFMXControl.pas',
|
||||
FirstStrategy in 'FirstStrategy.pas',
|
||||
Myc.Fmx.Chart in 'Myc.Fmx.Chart.pas',
|
||||
Myc.Trade.DataArray in '..\Src\Myc.Trade.DataArray.pas';
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.CreateForm(TTestChartForm, TestChartForm);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
@@ -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>
|
||||
@@ -138,10 +138,10 @@
|
||||
<DCCReference Include="..\Src\Myc.Aura.Module.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Aura.Parameter.pas"/>
|
||||
<DCCReference Include="TestModule.pas"/>
|
||||
<DCCReference Include="TestChartControl.pas">
|
||||
<Form>TestChartForm</Form>
|
||||
<FormType>fmx</FormType>
|
||||
</DCCReference>
|
||||
<DCCReference Include="DynamicFMXControl.pas"/>
|
||||
<DCCReference Include="FirstStrategy.pas"/>
|
||||
<DCCReference Include="Myc.Fmx.Chart.pas"/>
|
||||
<DCCReference Include="..\Src\Myc.Trade.DataArray.pas"/>
|
||||
<BuildConfiguration Include="Base">
|
||||
<Key>Base</Key>
|
||||
</BuildConfiguration>
|
||||
|
||||
@@ -0,0 +1,379 @@
|
||||
unit DynamicFMXControl;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils, System.Types, System.UITypes, System.Classes,
|
||||
FMX.Controls, FMX.Graphics, FMX.Forms, FMX.StdCtrls, FMX.Types;
|
||||
|
||||
type
|
||||
// Dezidierte Event-Typen für virtuelle Methoden von TControl
|
||||
TControlPaintEvent = reference to procedure;
|
||||
TControlMouseEvent = reference to procedure(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
TControlMouseMoveEvent = reference to procedure(Shift: TShiftState; X, Y: Single);
|
||||
TControlMouseWheelEvent = reference to procedure(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
|
||||
TControlKeyEvent = reference to procedure(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
|
||||
TControlDragEvent = reference to procedure(const Data: TDragObject; const Point: TPointF);
|
||||
TControlDragOverEvent = reference to procedure(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation);
|
||||
TControlNotifyEvent = reference to procedure;
|
||||
TControlCanFocusEvent = reference to function: Boolean;
|
||||
TControlShowContextMenuEvent = reference to function(const ScreenPosition: TPointF): Boolean;
|
||||
TControlSetHintEvent = reference to procedure(const AHint: string);
|
||||
TControlGetHintStringEvent = reference to function: string;
|
||||
TControlHasHintEvent = reference to function: Boolean;
|
||||
TControlCanShowHintEvent = reference to function: Boolean;
|
||||
TControlGetDefaultSizeEvent = reference to function: TSizeF;
|
||||
TControlSetVisibleEvent = reference to procedure(const Value: Boolean);
|
||||
TControlSetEnabledEvent = reference to procedure(const Value: Boolean);
|
||||
TControlDoAbsoluteChangedEvent = reference to procedure;
|
||||
|
||||
TDynamicControl = class(TControl)
|
||||
private
|
||||
// Private Felder für die Event-Handler
|
||||
FPaintEvent: TControlPaintEvent;
|
||||
FMouseDownEvent: TControlMouseEvent;
|
||||
FMouseUpEvent: TControlMouseEvent;
|
||||
FMouseMoveEvent: TControlMouseMoveEvent;
|
||||
FMouseWheelEvent: TControlMouseWheelEvent;
|
||||
FKeyDownEvent: TControlKeyEvent;
|
||||
FKeyUpEvent: TControlKeyEvent;
|
||||
FClickEvent: TControlNotifyEvent;
|
||||
FDblClickEvent: TControlNotifyEvent;
|
||||
FDragEnterEvent: TControlDragEvent;
|
||||
FDragOverEvent: TControlDragOverEvent;
|
||||
FDragDropEvent: TControlDragEvent;
|
||||
FDragLeaveEvent: TControlNotifyEvent;
|
||||
FDragEndEvent: TControlNotifyEvent;
|
||||
FEnterEvent: TControlNotifyEvent;
|
||||
FExitEvent: TControlNotifyEvent;
|
||||
FMouseEnterEvent: TControlNotifyEvent;
|
||||
FMouseLeaveEvent: TControlNotifyEvent;
|
||||
FResizeEvent: TControlNotifyEvent;
|
||||
FResizedEvent: TControlNotifyEvent;
|
||||
FCanFocusEvent: TControlCanFocusEvent;
|
||||
FShowContextMenuEvent: TControlShowContextMenuEvent;
|
||||
FSetHintEvent: TControlSetHintEvent;
|
||||
FGetHintStringEvent: TControlGetHintStringEvent;
|
||||
FHasHintEvent: TControlHasHintEvent;
|
||||
FCanShowHintEvent: TControlCanShowHintEvent;
|
||||
FGetDefaultSizeEvent: TControlGetDefaultSizeEvent;
|
||||
FRecalculateAbsoluteMatricesEvent: TControlNotifyEvent;
|
||||
FSetVisibleEvent: TControlSetVisibleEvent;
|
||||
FSetEnabledEvent: TControlSetEnabledEvent;
|
||||
FDoAbsoluteChangedEvent: TControlDoAbsoluteChangedEvent;
|
||||
|
||||
protected
|
||||
// Überschriebene virtuelle Methoden, die die Events auslösen
|
||||
procedure Paint; override;
|
||||
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
|
||||
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
|
||||
procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
|
||||
procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
|
||||
procedure Click; override;
|
||||
procedure DblClick; override;
|
||||
procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
|
||||
procedure KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
|
||||
procedure DragEnter(const Data: TDragObject; const Point: TPointF); override;
|
||||
procedure DragOver(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation); override;
|
||||
procedure DragDrop(const Data: TDragObject; const Point: TPointF); override;
|
||||
procedure DragLeave; override;
|
||||
procedure DragEnd; override;
|
||||
procedure DoEnter; override;
|
||||
procedure DoExit; override;
|
||||
procedure DoMouseEnter; override;
|
||||
procedure DoMouseLeave; override;
|
||||
procedure Resize; override;
|
||||
procedure DoResized; override;
|
||||
function GetCanFocus: Boolean; override;
|
||||
function ShowContextMenu(const ScreenPosition: TPointF): Boolean; override;
|
||||
procedure SetHint(const AHint: string); override;
|
||||
function GetHintString: string; override;
|
||||
function HasHint: Boolean; override;
|
||||
function CanShowHint: Boolean; override;
|
||||
function GetDefaultSize: TSizeF; override;
|
||||
procedure RecalculateAbsoluteMatrices; override;
|
||||
procedure SetVisible(const Value: Boolean); override;
|
||||
procedure SetEnabled(const Value: Boolean); override;
|
||||
procedure DoAbsoluteChanged; override;
|
||||
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
|
||||
// Public Properties, die die Events exponieren
|
||||
property OnPaint: TControlPaintEvent read FPaintEvent write FPaintEvent;
|
||||
property OnMouseDown: TControlMouseEvent read FMouseDownEvent write FMouseDownEvent;
|
||||
property OnMouseUp: TControlMouseEvent read FMouseUpEvent write FMouseUpEvent;
|
||||
property OnMouseMove: TControlMouseMoveEvent read FMouseMoveEvent write FMouseMoveEvent;
|
||||
property OnMouseWheel: TControlMouseWheelEvent read FMouseWheelEvent write FMouseWheelEvent;
|
||||
property OnClick: TControlNotifyEvent read FClickEvent write FClickEvent;
|
||||
property OnDblClick: TControlNotifyEvent read FDblClickEvent write FDblClickEvent;
|
||||
property OnKeyDown: TControlKeyEvent read FKeyDownEvent write FKeyDownEvent;
|
||||
property OnKeyUp: TControlKeyEvent read FKeyUpEvent write FKeyUpEvent;
|
||||
property OnDragEnter: TControlDragEvent read FDragEnterEvent write FDragEnterEvent;
|
||||
property OnDragOver: TControlDragOverEvent read FDragOverEvent write FDragOverEvent;
|
||||
property OnDragDrop: TControlDragEvent read FDragDropEvent write FDragDropEvent;
|
||||
property OnDragLeave: TControlNotifyEvent read FDragLeaveEvent write FDragLeaveEvent;
|
||||
property OnDragEnd: TControlNotifyEvent read FDragEndEvent write FDragEndEvent;
|
||||
property OnEnter: TControlNotifyEvent read FEnterEvent write FEnterEvent;
|
||||
property OnExit: TControlNotifyEvent read FExitEvent write FExitEvent;
|
||||
property OnMouseEnter: TControlNotifyEvent read FMouseEnterEvent write FMouseEnterEvent;
|
||||
property OnMouseLeave: TControlNotifyEvent read FMouseLeaveEvent write FMouseLeaveEvent;
|
||||
property OnResize: TControlNotifyEvent read FResizeEvent write FResizeEvent;
|
||||
property OnResized: TControlNotifyEvent read FResizedEvent write FResizedEvent;
|
||||
property OnCanFocus: TControlCanFocusEvent read FCanFocusEvent write FCanFocusEvent;
|
||||
property OnShowContextMenu: TControlShowContextMenuEvent read FShowContextMenuEvent write FShowContextMenuEvent;
|
||||
property OnSetHint: TControlSetHintEvent read FSetHintEvent write FSetHintEvent;
|
||||
property OnGetHintString: TControlGetHintStringEvent read FGetHintStringEvent write FGetHintStringEvent;
|
||||
property OnHasHint: TControlHasHintEvent read FHasHintEvent write FHasHintEvent;
|
||||
property OnCanShowHint: TControlCanShowHintEvent read FCanShowHintEvent write FCanShowHintEvent;
|
||||
property OnGetDefaultSize: TControlGetDefaultSizeEvent read FGetDefaultSizeEvent write FGetDefaultSizeEvent;
|
||||
property OnRecalculateAbsoluteMatrices: TControlNotifyEvent read FRecalculateAbsoluteMatricesEvent write FRecalculateAbsoluteMatricesEvent;
|
||||
property OnSetVisible: TControlSetVisibleEvent read FSetVisibleEvent write FSetVisibleEvent;
|
||||
property OnSetEnabled: TControlSetEnabledEvent read FSetEnabledEvent write FSetEnabledEvent;
|
||||
property OnDoAbsoluteChanged: TControlDoAbsoluteChangedEvent read FDoAbsoluteChangedEvent write FDoAbsoluteChangedEvent;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TDynamicControl }
|
||||
|
||||
constructor TDynamicControl.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
Width := 150;
|
||||
Height := 100;
|
||||
HitTest := True;
|
||||
end;
|
||||
|
||||
function TDynamicControl.CanShowHint: Boolean;
|
||||
begin
|
||||
if Assigned(FCanShowHintEvent) then
|
||||
Result := FCanShowHintEvent
|
||||
else
|
||||
Result := inherited CanShowHint;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.Click;
|
||||
begin
|
||||
inherited Click;
|
||||
if Assigned(FClickEvent) then
|
||||
FClickEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DblClick;
|
||||
begin
|
||||
inherited DblClick;
|
||||
if Assigned(FDblClickEvent) then
|
||||
FDblClickEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DoAbsoluteChanged;
|
||||
begin
|
||||
inherited DoAbsoluteChanged;
|
||||
if Assigned(FDoAbsoluteChangedEvent) then
|
||||
FDoAbsoluteChangedEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DragDrop(const Data: TDragObject; const Point: TPointF);
|
||||
begin
|
||||
inherited DragDrop(Data, Point);
|
||||
if Assigned(FDragDropEvent) then
|
||||
FDragDropEvent(Data, Point);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DragEnd;
|
||||
begin
|
||||
inherited DragEnd;
|
||||
if Assigned(FDragEndEvent) then
|
||||
FDragEndEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DragEnter(const Data: TDragObject; const Point: TPointF);
|
||||
begin
|
||||
inherited DragEnter(Data, Point);
|
||||
if Assigned(FDragEnterEvent) then
|
||||
FDragEnterEvent(Data, Point);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DragLeave;
|
||||
begin
|
||||
inherited DragLeave;
|
||||
if Assigned(FDragLeaveEvent) then
|
||||
FDragLeaveEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DragOver(const Data: TDragObject; const Point: TPointF; var Operation: TDragOperation);
|
||||
begin
|
||||
inherited DragOver(Data, Point, Operation);
|
||||
if Assigned(FDragOverEvent) then
|
||||
FDragOverEvent(Data, Point, Operation);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DoEnter;
|
||||
begin
|
||||
inherited DoEnter;
|
||||
if Assigned(FEnterEvent) then
|
||||
FEnterEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DoExit;
|
||||
begin
|
||||
inherited DoExit;
|
||||
if Assigned(FExitEvent) then
|
||||
FExitEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DoMouseEnter;
|
||||
begin
|
||||
inherited DoMouseEnter;
|
||||
if Assigned(FMouseEnterEvent) then
|
||||
FMouseEnterEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DoMouseLeave;
|
||||
begin
|
||||
inherited DoMouseLeave;
|
||||
if Assigned(FMouseLeaveEvent) then
|
||||
FMouseLeaveEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.DoResized;
|
||||
begin
|
||||
inherited DoResized;
|
||||
if Assigned(FResizedEvent) then
|
||||
FResizedEvent;
|
||||
end;
|
||||
|
||||
function TDynamicControl.GetCanFocus: Boolean;
|
||||
begin
|
||||
if Assigned(FCanFocusEvent) then
|
||||
Result := FCanFocusEvent
|
||||
else
|
||||
Result := inherited GetCanFocus;
|
||||
end;
|
||||
|
||||
function TDynamicControl.GetDefaultSize: TSizeF;
|
||||
begin
|
||||
if Assigned(FGetDefaultSizeEvent) then
|
||||
Result := FGetDefaultSizeEvent
|
||||
else
|
||||
Result := inherited GetDefaultSize;
|
||||
end;
|
||||
|
||||
function TDynamicControl.GetHintString: string;
|
||||
begin
|
||||
if Assigned(FGetHintStringEvent) then
|
||||
Result := FGetHintStringEvent
|
||||
else
|
||||
Result := inherited GetHintString;
|
||||
end;
|
||||
|
||||
function TDynamicControl.HasHint: Boolean;
|
||||
begin
|
||||
if Assigned(FHasHintEvent) then
|
||||
Result := FHasHintEvent
|
||||
else
|
||||
Result := inherited HasHint;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
|
||||
begin
|
||||
inherited KeyDown(Key, KeyChar, Shift);
|
||||
if Assigned(FKeyDownEvent) then
|
||||
FKeyDownEvent(Key, KeyChar, Shift);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
|
||||
begin
|
||||
inherited KeyUp(Key, KeyChar, Shift);
|
||||
if Assigned(FKeyUpEvent) then
|
||||
FKeyUpEvent(Key, KeyChar, Shift);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited MouseDown(Button, Shift, X, Y);
|
||||
if Assigned(FMouseDownEvent) then
|
||||
FMouseDownEvent(Button, Shift, X, Y);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.MouseMove(Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited MouseMove(Shift, X, Y);
|
||||
if Assigned(FMouseMoveEvent) then
|
||||
FMouseMoveEvent(Shift, X, Y);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
|
||||
begin
|
||||
inherited MouseUp(Button, Shift, X, Y);
|
||||
if Assigned(FMouseUpEvent) then
|
||||
FMouseUpEvent(Button, Shift, X, Y);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
|
||||
begin
|
||||
inherited MouseWheel(Shift, WheelDelta, Handled);
|
||||
if Assigned(FMouseWheelEvent) then
|
||||
FMouseWheelEvent(Shift, WheelDelta, Handled);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.Paint;
|
||||
begin
|
||||
inherited Paint;
|
||||
if Assigned(FPaintEvent) then
|
||||
FPaintEvent
|
||||
else
|
||||
begin
|
||||
Canvas.Fill.Color := TAlphaColors.LightSteelBlue;
|
||||
Canvas.FillRect(LocalRect, 0, 0, [], 1);
|
||||
Canvas.Stroke.Color := TAlphaColors.Gray;
|
||||
Canvas.Stroke.Thickness := 1;
|
||||
Canvas.DrawRect(LocalRect, 0, 0, [], 1);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.RecalculateAbsoluteMatrices;
|
||||
begin
|
||||
inherited RecalculateAbsoluteMatrices;
|
||||
if Assigned(FRecalculateAbsoluteMatricesEvent) then
|
||||
FRecalculateAbsoluteMatricesEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.Resize;
|
||||
begin
|
||||
inherited Resize;
|
||||
if Assigned(FResizeEvent) then
|
||||
FResizeEvent;
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.SetEnabled(const Value: Boolean);
|
||||
begin
|
||||
inherited SetEnabled(Value);
|
||||
if Assigned(FSetEnabledEvent) then
|
||||
FSetEnabledEvent(Value);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.SetHint(const AHint: string);
|
||||
begin
|
||||
inherited SetHint(AHint);
|
||||
if Assigned(FSetHintEvent) then
|
||||
FSetHintEvent(AHint);
|
||||
end;
|
||||
|
||||
procedure TDynamicControl.SetVisible(const Value: Boolean);
|
||||
begin
|
||||
inherited SetVisible(Value);
|
||||
if Assigned(FSetVisibleEvent) then
|
||||
FSetVisibleEvent(Value);
|
||||
end;
|
||||
|
||||
function TDynamicControl.ShowContextMenu(const ScreenPosition: TPointF): Boolean;
|
||||
begin
|
||||
if Assigned(FShowContextMenuEvent) then
|
||||
Result := FShowContextMenuEvent(ScreenPosition)
|
||||
else
|
||||
Result := inherited ShowContextMenu(ScreenPosition);
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -0,0 +1,457 @@
|
||||
unit FirstStrategy;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.Generics.Collections,
|
||||
Myc.Signals,
|
||||
Myc.Lazy,
|
||||
Myc.Trade.DataPoint,
|
||||
Myc.Trade.DataArray,
|
||||
Myc.Core.Notifier;
|
||||
|
||||
type
|
||||
TTimeframe = (M1, M5, H1, D);
|
||||
|
||||
TTag = Pointer;
|
||||
|
||||
IMycBroadcast<T> = interface
|
||||
function Link(const Strategy: IMycProcessor<T>): TTag;
|
||||
procedure Unlink(Tag: TTag);
|
||||
end;
|
||||
|
||||
// A contained object that broadcasts Values to linked strategies
|
||||
TMycBroadcast<T> = class(TContainedObject, IMycBroadcast<T>)
|
||||
private
|
||||
FLinkedStrategies: TMycNotifyList<IMycProcessor<T>>;
|
||||
protected
|
||||
// Link a strategy
|
||||
function Link(const Strategy: IMycProcessor<T>): TTag;
|
||||
// Unlink a linked strategy
|
||||
procedure Unlink(Tag: TTag);
|
||||
// Broadcasts the given data points to all linked strategies.
|
||||
procedure Broadcast(const Value: T);
|
||||
public
|
||||
constructor Create(const Controller: IInterface);
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
IMycConverter<S, T> = interface(IMycProcessor<S>)
|
||||
function GetObservers: IMycBroadcast<T>;
|
||||
property Observers: IMycBroadcast<T> read GetObservers;
|
||||
end;
|
||||
|
||||
TMycConverter<S, T> = class abstract(TInterfacedObject, IMycProcessor<S>, IMycConverter<S, T>)
|
||||
private
|
||||
FObservers: TMycBroadcast<T>;
|
||||
protected
|
||||
procedure Broadcast(const Value: T);
|
||||
function GetObservers: IMycBroadcast<T>;
|
||||
procedure ProcessData(const Value: S); virtual; abstract;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
TMycGenericConverter<S, T> = class(TMycConverter<S, T>)
|
||||
type
|
||||
TConvertFunc = reference to function(const Value: S): T;
|
||||
private
|
||||
FFunc: TConvertFunc;
|
||||
protected
|
||||
procedure ProcessData(const Value: S); override;
|
||||
public
|
||||
constructor Create(const AFunc: TConvertFunc);
|
||||
end;
|
||||
|
||||
// Series
|
||||
|
||||
IMycSeriesConverter<S, T> = interface(IMycConverter<TArray<S>, T>)
|
||||
function GetLookback: Integer;
|
||||
property Lookback: Integer read GetLookback;
|
||||
end;
|
||||
|
||||
// Indicator
|
||||
|
||||
IMycIndicator<S, T> = interface(IMycSeriesConverter<S, TArray<T>>)
|
||||
end;
|
||||
|
||||
TMycIndicator<S, T> = class abstract(TMycConverter<TArray<S>, TArray<T>>, IMycIndicator<S, T>)
|
||||
protected
|
||||
function GetLookback: Integer; virtual; abstract;
|
||||
procedure ProcessData(const Value: TArray<S>); override; abstract;
|
||||
public
|
||||
property Lookback: Integer read GetLookback;
|
||||
end;
|
||||
|
||||
TMycGenericIndicator<S, T> = class(TMycIndicator<S, T>)
|
||||
type
|
||||
TConvertFunc = reference to function(const Value: S): T;
|
||||
private
|
||||
FLookback: Integer;
|
||||
FFunc: TConvertFunc;
|
||||
protected
|
||||
function GetLookback: Integer; override;
|
||||
procedure ProcessData(const Value: TArray<S>); override;
|
||||
public
|
||||
constructor Create(ALookback: Integer; const AFunc: TConvertFunc);
|
||||
end;
|
||||
|
||||
ITicksToTimeframe = interface(IMycConverter<TArray<TDataPoint<TAskBidItem>>, TArray<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>>, TArray<TDataPoint<TOhlcItem>>>, ITicksToTimeframe)
|
||||
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>);
|
||||
|
||||
// Process new data. This is called concurrently and must not have side effects out of the scope of this class!
|
||||
procedure ProcessData(const Values: TArray<TDataPoint<TAskBidItem>>); override;
|
||||
|
||||
property CurrentBar: TDataPoint<TOhlcItem> read GetCurrentBar;
|
||||
property StateText: TWriteable<String> read GetStateText;
|
||||
property Timeframe: TTimeframe read GetTimeframe;
|
||||
end;
|
||||
|
||||
// Implements the Hull Moving Average indicator.
|
||||
THullMovingAverage = class(TMycIndicator<Double, Double>)
|
||||
private
|
||||
FPeriod: Integer;
|
||||
FPeriodHalf: Integer;
|
||||
FPeriodSqrt: Integer;
|
||||
// Source data for HMA calculation
|
||||
FSourceData: TMycDataArray<Double>;
|
||||
// Intermediate data series for HMA calculation (2*WMA(n/2) - WMA(n))
|
||||
FDiffSeries: TMycDataArray<Double>;
|
||||
// Calculates the Weighted Moving Average for the most recent data.
|
||||
function CalculateWMA(const Series: TMycDataArray<Double>; const Period: Integer): Double;
|
||||
protected
|
||||
procedure ProcessData(const Values: TArray<Double>); override;
|
||||
function GetLookback: Integer; override;
|
||||
public
|
||||
constructor Create(const APeriod: Integer);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.DateUtils,
|
||||
System.Math;
|
||||
|
||||
{ TMycBroadcast<T> }
|
||||
|
||||
constructor TMycBroadcast<T>.Create(const Controller: IInterface);
|
||||
begin
|
||||
inherited Create(Controller);
|
||||
end;
|
||||
|
||||
destructor TMycBroadcast<T>.Destroy;
|
||||
begin
|
||||
FLinkedStrategies.Finalize;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TMycBroadcast<T>.Broadcast(const Value: T);
|
||||
begin
|
||||
var cValue := Value;
|
||||
|
||||
FLinkedStrategies.Lock;
|
||||
try
|
||||
FLinkedStrategies.Notify(
|
||||
function(const Processor: IMycProcessor<T>): Boolean
|
||||
begin
|
||||
Processor.ProcessData(cValue);
|
||||
Result := true;
|
||||
end
|
||||
);
|
||||
finally
|
||||
FLinkedStrategies.Release;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TMycBroadcast<T>.Link(const Strategy: IMycProcessor<T>): TTag;
|
||||
begin
|
||||
// Add the strategy to the notification list
|
||||
FLinkedStrategies.Lock;
|
||||
try
|
||||
Result := FLinkedStrategies.Advise(Strategy);
|
||||
finally
|
||||
FLinkedStrategies.Release;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMycBroadcast<T>.Unlink(Tag: TTag);
|
||||
begin
|
||||
FLinkedStrategies.Lock;
|
||||
try
|
||||
FLinkedStrategies.Unadvise(Tag);
|
||||
finally
|
||||
FLinkedStrategies.Release;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TTicksToTimeframe }
|
||||
|
||||
constructor TTicksToTimeframe.Create(const ATimeframe: TTimeframe; const AStateText: TWriteable<String>);
|
||||
begin
|
||||
inherited Create;
|
||||
FStateText := AStateText;
|
||||
FTimeframe := ATimeframe;
|
||||
end;
|
||||
|
||||
function TTicksToTimeframe.GetBarStartTime(const TimeStamp: TDateTime; const Timeframe: TTimeframe): TDateTime;
|
||||
begin
|
||||
// Align the time grid to UTC 0:00 using functions from System.DateUtils
|
||||
case Timeframe of
|
||||
M1: Result := RecodeSecond(RecodeMilliSecond(TimeStamp, 0), 0);
|
||||
M5: Result := RecodeMinute(RecodeSecond(RecodeMilliSecond(TimeStamp, 0), 0), MinuteOf(TimeStamp) - MinuteOf(TimeStamp) mod 5);
|
||||
H1: Result := RecodeMinute(RecodeSecond(RecodeMilliSecond(TimeStamp, 0), 0), 0);
|
||||
D: Result := StartOfTheDay(TimeStamp);
|
||||
else
|
||||
Result := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTicksToTimeframe.GetCurrentBar: TDataPoint<TOhlcItem>;
|
||||
begin
|
||||
Result := FCurrentBar;
|
||||
end;
|
||||
|
||||
function TTicksToTimeframe.GetStateText: TWriteable<String>;
|
||||
begin
|
||||
Result := FStateText;
|
||||
end;
|
||||
|
||||
function TTicksToTimeframe.GetTimeframe: TTimeframe;
|
||||
begin
|
||||
Result := FTimeframe;
|
||||
end;
|
||||
|
||||
procedure TTicksToTimeframe.ProcessData(const Values: TArray<TDataPoint<TAskBidItem>>);
|
||||
var
|
||||
point: TDataPoint<TAskBidItem>;
|
||||
midPrice: Single;
|
||||
barStartTime: TDateTime;
|
||||
lastBarTime: TDateTime;
|
||||
currentBar: TOhlcItem;
|
||||
producedBars: TList<TDataPoint<TOhlcItem>>;
|
||||
begin
|
||||
producedBars := TList<TDataPoint<TOhlcItem>>.Create;
|
||||
try
|
||||
// Process each incoming data point
|
||||
for point in Values do
|
||||
begin
|
||||
midPrice := (point.Data.Ask + point.Data.Bid) / 2;
|
||||
|
||||
// Update bar for the strategy's timeframe
|
||||
barStartTime := GetBarStartTime(point.Time, FTimeframe);
|
||||
lastBarTime := FCurrentBar.Time;
|
||||
|
||||
if (barStartTime > lastBarTime) then
|
||||
begin
|
||||
// A new bar starts, so the previous one is now complete.
|
||||
if (lastBarTime > 0) then
|
||||
begin
|
||||
producedBars.Add(FCurrentBar);
|
||||
end;
|
||||
|
||||
// Start a new bar, Volume is 1 because this is the first tick.
|
||||
currentBar := TOhlcItem.Create(midPrice, midPrice, midPrice, midPrice, 1);
|
||||
FCurrentBar.Data := currentBar;
|
||||
FCurrentBar.Time := barStartTime;
|
||||
end
|
||||
else
|
||||
begin
|
||||
// Update the currently aggregating bar
|
||||
currentBar := FCurrentBar.Data;
|
||||
currentBar.High := Max(currentBar.High, midPrice);
|
||||
currentBar.Low := Min(currentBar.Low, midPrice);
|
||||
currentBar.Close := midPrice;
|
||||
// Volume is the number of ticks needed to build the complete bar.
|
||||
currentBar.Volume := currentBar.Volume + 1;
|
||||
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]);
|
||||
|
||||
Broadcast(producedBars.ToArray);
|
||||
finally
|
||||
producedBars.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ THullMovingAverage }
|
||||
|
||||
constructor THullMovingAverage.Create(const APeriod: Integer);
|
||||
begin
|
||||
inherited Create;
|
||||
FPeriod := APeriod;
|
||||
FPeriodHalf := APeriod div 2;
|
||||
FPeriodSqrt := Round(Sqrt(APeriod));
|
||||
|
||||
// Initialize data arrays.
|
||||
FSourceData := TMycDataArray<Double>.CreateEmpty;
|
||||
FDiffSeries := TMycDataArray<Double>.CreateEmpty;
|
||||
end;
|
||||
|
||||
function THullMovingAverage.CalculateWMA(const Series: TMycDataArray<Double>; const Period: Integer): Double;
|
||||
var
|
||||
i: Integer;
|
||||
numerator: Double;
|
||||
denominator: Int64;
|
||||
begin
|
||||
// Ensure there is enough data to calculate the WMA
|
||||
if (Series.Count < Period) or (Period <= 0) then
|
||||
Exit(0.0);
|
||||
|
||||
numerator := 0;
|
||||
// The sum of weights (1 + 2 + ... + Period)
|
||||
denominator := Period * (Period + 1) div 2;
|
||||
|
||||
if (denominator = 0) then
|
||||
Exit(0.0);
|
||||
|
||||
for i := 0 to Period - 1 do
|
||||
begin
|
||||
// Newest data (index 0) gets the highest weight (Period)
|
||||
numerator := numerator + Series[i] * (Period - i);
|
||||
end;
|
||||
|
||||
Result := numerator / denominator;
|
||||
end;
|
||||
|
||||
function THullMovingAverage.GetLookback: Integer;
|
||||
begin
|
||||
Result := FPeriod + FPeriodSqrt - 1;
|
||||
end;
|
||||
|
||||
procedure THullMovingAverage.ProcessData(const Values: TArray<Double>);
|
||||
var
|
||||
i: Integer;
|
||||
price: Double;
|
||||
wmaHalf, wmaFull, diff: Double;
|
||||
hma: Double;
|
||||
resultArray: TArray<Double>;
|
||||
begin
|
||||
// Pre-allocate the result array since its size is known in advance.
|
||||
SetLength(resultArray, Length(Values));
|
||||
|
||||
for i := 0 to High(Values) do
|
||||
begin
|
||||
price := Values[i];
|
||||
|
||||
// Default HMA to 0.0 for the warm-up period.
|
||||
hma := 0.0;
|
||||
|
||||
// Add new price to the source data array, respecting the lookback period.
|
||||
FSourceData := FSourceData.Add(price, FPeriod);
|
||||
|
||||
// Check if there is enough data to start the first stage of calculation.
|
||||
if (FSourceData.Count >= FPeriod) then
|
||||
begin
|
||||
// Calculate the two WMAs for the first step.
|
||||
wmaHalf := CalculateWMA(FSourceData, FPeriodHalf);
|
||||
wmaFull := CalculateWMA(FSourceData, FPeriod);
|
||||
|
||||
// Calculate the difference and add to the intermediate series.
|
||||
diff := 2 * wmaHalf - wmaFull;
|
||||
FDiffSeries := FDiffSeries.Add(diff, FPeriodSqrt);
|
||||
|
||||
// Check if there is enough intermediate data for the final calculation.
|
||||
if (FDiffSeries.Count >= FPeriodSqrt) then
|
||||
begin
|
||||
// Calculate the final HMA value, overwriting the default 0.0.
|
||||
hma := CalculateWMA(FDiffSeries, FPeriodSqrt);
|
||||
end;
|
||||
end;
|
||||
|
||||
// Assign the result (either the calculated HMA or 0.0) directly into the array.
|
||||
resultArray[i] := hma;
|
||||
end;
|
||||
|
||||
// Broadcast the result array if the input was not empty.
|
||||
if (Length(resultArray) > 0) then
|
||||
begin
|
||||
Broadcast(resultArray);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TMycGenericConverter<S, T> }
|
||||
|
||||
constructor TMycGenericConverter<S, T>.Create(const AFunc: TConvertFunc);
|
||||
begin
|
||||
inherited Create;
|
||||
FFunc := AFunc;
|
||||
end;
|
||||
|
||||
procedure TMycGenericConverter<S, T>.ProcessData(const Value: S);
|
||||
begin
|
||||
Broadcast(FFunc(Value));
|
||||
end;
|
||||
|
||||
constructor TMycGenericIndicator<S, T>.Create(ALookback: Integer; const AFunc: TConvertFunc);
|
||||
begin
|
||||
inherited Create;
|
||||
FFunc := AFunc;
|
||||
FLookback := ALookback;
|
||||
end;
|
||||
|
||||
function TMycGenericIndicator<S, T>.GetLookback: Integer;
|
||||
begin
|
||||
Result := FLookback;
|
||||
end;
|
||||
|
||||
procedure TMycGenericIndicator<S, T>.ProcessData(const Value: TArray<S>);
|
||||
var
|
||||
Arr: TArray<T>;
|
||||
begin
|
||||
inherited;
|
||||
SetLength(Arr, Length(Value));
|
||||
for var i := 0 to High(Arr) do
|
||||
Arr[i] := FFunc(Value[i]);
|
||||
Broadcast(Arr);
|
||||
end;
|
||||
|
||||
{ TMycConverter<S, T> }
|
||||
|
||||
constructor TMycConverter<S, T>.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FObservers := TMycBroadcast<T>.Create(Self);
|
||||
end;
|
||||
|
||||
destructor TMycConverter<S, T>.Destroy;
|
||||
begin
|
||||
FObservers.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TMycConverter<S, T>.Broadcast(const Value: T);
|
||||
begin
|
||||
FObservers.Broadcast(Value);
|
||||
end;
|
||||
|
||||
function TMycConverter<S, T>.GetObservers: IMycBroadcast<T>;
|
||||
begin
|
||||
Result := FObservers;
|
||||
end;
|
||||
|
||||
end.
|
||||
@@ -70,7 +70,7 @@ object Form1: TForm1
|
||||
Size.Height = 400.00000000000000000
|
||||
Size.PlatformDefault = False
|
||||
TabOrder = 7
|
||||
object FlowLayout1: TFlowLayout
|
||||
object FlowLayout: TFlowLayout
|
||||
Position.X = 224.00000000000000000
|
||||
Position.Y = 167.00000000000000000
|
||||
TabOrder = 4
|
||||
@@ -128,12 +128,15 @@ object Form1: TForm1
|
||||
end
|
||||
end
|
||||
end
|
||||
object SpeedButton1: TSpeedButton
|
||||
Position.X = 376.00000000000000000
|
||||
Position.Y = 8.00000000000000000
|
||||
Text = 'SpeedButton1'
|
||||
object StrategyButton: TSpeedButton
|
||||
Align = FitLeft
|
||||
Position.X = 290.90911865234370000
|
||||
Size.Width = 145.45446777343750000
|
||||
Size.Height = 40.00000000000000000
|
||||
Size.PlatformDefault = False
|
||||
Text = 'Strategy'
|
||||
TextSettings.Trimming = None
|
||||
OnClick = SpeedButton1Click
|
||||
OnClick = StrategyButtonClick
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
+145
-48
@@ -44,7 +44,9 @@ uses
|
||||
FMX.ImgList,
|
||||
System.Actions,
|
||||
FMX.ActnList,
|
||||
TestChartControl;
|
||||
DynamicFMXControl,
|
||||
FirstStrategy,
|
||||
Myc.FMX.Chart;
|
||||
|
||||
type
|
||||
TForm1 = class(TForm)
|
||||
@@ -69,9 +71,9 @@ type
|
||||
TreeView: TTreeView;
|
||||
TestButton: TSpeedButton;
|
||||
TestAction: TAction;
|
||||
SpeedButton1: TSpeedButton;
|
||||
TestPopup: TPopup;
|
||||
FlowLayout1: TFlowLayout;
|
||||
FlowLayout: TFlowLayout;
|
||||
StrategyButton: TSpeedButton;
|
||||
procedure RandomButtonClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
@@ -82,31 +84,33 @@ type
|
||||
procedure TreeViewDblClick(Sender: TObject);
|
||||
procedure AddWorkspaceActionExecute(Sender: TObject);
|
||||
procedure TestActionExecute(Sender: TObject);
|
||||
procedure SpeedButton1Click(Sender: TObject);
|
||||
procedure StrategyButtonClick(Sender: TObject);
|
||||
private
|
||||
const
|
||||
cnt = 20;
|
||||
type
|
||||
TRndItem = record
|
||||
Stream: IDataStream<TAskBidItem>;
|
||||
Data: TMutable<TDataSeries<TAskBidItem>>;
|
||||
Stream: IDataStream<TAuraAskBidFileItem>;
|
||||
Data: TMutable<TDataSeries<TAuraAskBidFileItem>>;
|
||||
Labl: TLabel;
|
||||
end;
|
||||
private
|
||||
FOnEvent: TNotifyEvent;
|
||||
{ Private declarations }
|
||||
FServer: IDataServer<TAskBidItem>;
|
||||
FServer: IDataServer<TAuraAskBidFileItem>;
|
||||
FSymbols: TFuture<TArray<String>>;
|
||||
FRandom: TList<TRndItem>;
|
||||
FTerminate: TEvent;
|
||||
FLoadDone: TState;
|
||||
FProcessDone: TState;
|
||||
FApplication: IAuraApplication;
|
||||
FModulesItem: TTreeViewItem;
|
||||
function SelectedSymbol: String;
|
||||
function ExecuteStrategy(const Symbol: String; const Processor: IMycProcessor<TArray<TDataPoint<TAskBidItem>>>): TState;
|
||||
|
||||
public
|
||||
procedure NewWorkspace;
|
||||
function CurrLayout: TFlowLayout;
|
||||
function CurrLayout<T: TControl>: T;
|
||||
procedure AlignControl(Control: TControl);
|
||||
published
|
||||
property OnEvent: TNotifyEvent read FOnEvent write FOnEvent;
|
||||
end;
|
||||
@@ -134,10 +138,6 @@ begin
|
||||
scrollbox.Parent := tab;
|
||||
scrollbox.Align := TAlignLayout.Client;
|
||||
|
||||
var flow := TFlowLayout.Create(Self);
|
||||
flow.Parent := tab;
|
||||
flow.Align := TAlignLayout.Client;
|
||||
|
||||
tab.ProcessSignal(ws.Name.Changed, procedure begin tab.Text := ws.Caption; end);
|
||||
end;
|
||||
|
||||
@@ -146,6 +146,68 @@ begin
|
||||
FTerminate.Notify;
|
||||
end;
|
||||
|
||||
procedure TForm1.StrategyButtonClick(Sender: TObject);
|
||||
begin
|
||||
var Layout := CurrLayout<TVertScrollBox>;
|
||||
if Layout = nil then
|
||||
exit;
|
||||
|
||||
var Symbol := SelectedSymbol;
|
||||
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;
|
||||
|
||||
/////
|
||||
|
||||
var strategy: ITicksToTimeframe := TTicksToTimeframe.Create( D, stateText );
|
||||
|
||||
var Ohlc: IMycIndicator<TDataPoint<TOhlcItem>, TOhlcItem> := TMycGenericIndicator<TDataPoint<TOhlcItem>, TOhlcItem>.Create( 0,
|
||||
function( const Ohlc: TDataPoint<TOhlcItem> ): TOhlcItem
|
||||
begin
|
||||
Result := Ohlc.Data;
|
||||
end );
|
||||
|
||||
strategy.Observers.Link(Ohlc);
|
||||
|
||||
var Closes: IMycIndicator<TOhlcItem, Double> := TMycGenericIndicator<TOhlcItem, Double>.Create( 0,
|
||||
function( const Ohlc: TOhlcItem ): Double
|
||||
begin
|
||||
Result := Ohlc.Close;
|
||||
end );
|
||||
|
||||
Ohlc.Observers.Link( Closes );
|
||||
|
||||
var Hull: IMycIndicator<Double, Double> := THullMovingAverage.Create( 50 );
|
||||
|
||||
Closes.Observers.Link( Hull );
|
||||
|
||||
Hull.Observers.Link(chart.CreateDoubleListener);
|
||||
|
||||
var done := ExecuteStrategy( Symbol, strategy );
|
||||
|
||||
/////
|
||||
|
||||
stateLabel.ProcessSignal(
|
||||
stateText.Changed, done,
|
||||
procedure
|
||||
begin
|
||||
stateLabel.Text := stateText.Value;
|
||||
end );
|
||||
|
||||
FProcessDone := TState.All([FProcessDone, done]);
|
||||
|
||||
strategy.Observers.Link(chart.CreateOhlcListener);
|
||||
end;
|
||||
|
||||
procedure TForm1.TreeViewDblClick(Sender: TObject);
|
||||
begin
|
||||
var sel := TreeView.Selected as TTreeViewItem;
|
||||
@@ -209,6 +271,7 @@ begin
|
||||
// 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;
|
||||
@@ -244,7 +307,7 @@ procedure TForm1.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
FSymbols.WaitFor;
|
||||
FTerminate.Notify;
|
||||
TaskManager.WaitFor(FLoadDone);
|
||||
TaskManager.WaitFor(FProcessDone);
|
||||
FRandom.Free;
|
||||
end;
|
||||
|
||||
@@ -257,12 +320,12 @@ procedure TForm1.LoadButtonClick(Sender: TObject);
|
||||
begin
|
||||
if SymbolsComboBox.ItemIndex < 0 then
|
||||
exit;
|
||||
var Layout := CurrLayout;
|
||||
var Layout := CurrLayout<TVertScrollBox>;
|
||||
if Layout = nil then
|
||||
exit;
|
||||
|
||||
var Stream := FServer.CreateStream(FSymbols.WaitFor[SymbolsComboBox.ItemIndex]);
|
||||
var Data := TDataStreamProvider.Create<TAskBidItem>(30000, 10000, Stream);
|
||||
var Data := TDataStreamProvider.Create<TAuraAskBidFileItem>(30000, 10000, Stream);
|
||||
|
||||
var path := TPath.Create(Self);
|
||||
path.Parent := Layout;
|
||||
@@ -292,14 +355,14 @@ end;
|
||||
|
||||
procedure TForm1.RandomButtonClick(Sender: TObject);
|
||||
begin
|
||||
var Layout := CurrLayout;
|
||||
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<TAskBidItem>(3000, 1000, rnd.Stream);
|
||||
rnd.Data := TDataStreamProvider.Create<TAuraAskBidFileItem>(3000, 1000, rnd.Stream);
|
||||
|
||||
rnd.Labl := TLabel.Create(Self);
|
||||
rnd.Labl.Parent := Layout;
|
||||
@@ -346,9 +409,22 @@ 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;
|
||||
var Layout := CurrLayout<TVertScrollBox>;
|
||||
if Layout = nil then
|
||||
exit;
|
||||
|
||||
@@ -361,41 +437,44 @@ begin
|
||||
|
||||
const width = 300;
|
||||
|
||||
var terminated := TFlag.CreateObserver(FTerminate.Signal).State;
|
||||
|
||||
var done :=
|
||||
TaskManager.RunTask(
|
||||
nil,
|
||||
function: TState
|
||||
begin
|
||||
var Prices := TDataSeries<TAskBidItem>.CreateDataSeries(width);
|
||||
var Prices := TDataSeries<TAuraAskBidFileItem>.CreateDataSeries(width);
|
||||
Result :=
|
||||
FServer.ProcessData(
|
||||
Symbol,
|
||||
FTerminate.Signal,
|
||||
procedure(const Values: TArray<TDataPoint<TAskBidItem>>; const Terminated: TState)
|
||||
begin
|
||||
Prices := Prices.Add(Values);
|
||||
currLog.Value := Prices.TotalCount.ToString;
|
||||
|
||||
var PathData := TPathData.Create;
|
||||
if Prices.Count > 0 then
|
||||
terminated,
|
||||
TMycGenericProcessor<TArray<TDataPoint<TAuraAskBidFileItem>>>.Create(
|
||||
procedure(const Values: TArray<TDataPoint<TAuraAskBidFileItem>>)
|
||||
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));
|
||||
Prices := Prices.Add(Values);
|
||||
currLog.Value := Prices.TotalCount.ToString;
|
||||
|
||||
for var i := n - 1 downto 0 do
|
||||
PathData.LineTo(PointF(n - i - 1, Prices[i].Data.Bid));
|
||||
end;
|
||||
PathData.ClosePath;
|
||||
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));
|
||||
|
||||
currPathData.Value := TObjectRef<TPathData>.Create(PathData);
|
||||
end
|
||||
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
|
||||
);
|
||||
|
||||
FLoadDone := TState.All([FLoadDone, done]);
|
||||
FProcessDone := TState.All([FProcessDone, done]);
|
||||
|
||||
var path := TPath.Create(Self);
|
||||
path.Parent := Layout;
|
||||
@@ -412,19 +491,19 @@ begin
|
||||
);
|
||||
end;
|
||||
|
||||
function TForm1.CurrLayout: TFlowLayout;
|
||||
function TForm1.CurrLayout<T>: T;
|
||||
begin
|
||||
if TabControl.ActiveTab = nil then
|
||||
exit(nil);
|
||||
|
||||
var Res: TFlowLayout := nil;
|
||||
var Res: T := nil;
|
||||
TabControl.ActiveTab.EnumControls(
|
||||
function(Control: TControl): TEnumControlsResult
|
||||
begin
|
||||
Result := TEnumControlsResult.Continue;
|
||||
if Control is TFlowLayout then
|
||||
if Control is T then
|
||||
begin
|
||||
Res := Control as TFlowLayout;
|
||||
Res := Control as T;
|
||||
Result := TEnumControlsResult.Stop;
|
||||
end;
|
||||
end
|
||||
@@ -433,6 +512,29 @@ begin
|
||||
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.Observers.Link( Processor );
|
||||
|
||||
Result := FServer.ProcessData( Symbol, terminated, dataProvider );
|
||||
end;
|
||||
|
||||
function TForm1.SelectedSymbol: String;
|
||||
begin
|
||||
Result := '';
|
||||
@@ -442,9 +544,4 @@ begin
|
||||
Result := FSymbols.WaitFor[SymbolsComboBox.ItemIndex];
|
||||
end;
|
||||
|
||||
procedure TForm1.SpeedButton1Click(Sender: TObject);
|
||||
begin
|
||||
TestChartForm.Visible := true;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -0,0 +1,419 @@
|
||||
unit Myc.Fmx.Chart;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Classes,
|
||||
System.Types,
|
||||
System.Generics.Collections,
|
||||
System.UITypes,
|
||||
System.UIConsts,
|
||||
System.Messaging,
|
||||
System.Math.Vectors,
|
||||
FMX.Types,
|
||||
FMX.Controls,
|
||||
FMX.Graphics,
|
||||
Myc.Trade.DataPoint,
|
||||
Myc.Signals;
|
||||
|
||||
type
|
||||
TCandleStyle = (csCandleStick, csHiLoBar);
|
||||
|
||||
TMycChart = class(TStyledControl)
|
||||
type
|
||||
TSeries = class abstract(TContainedObject)
|
||||
private
|
||||
function GetMainSeries: TSeries;
|
||||
function GetOwner: TMycChart;
|
||||
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; const AXForm, AYForm: TFunc<Double, Single>); virtual; abstract;
|
||||
|
||||
public
|
||||
constructor Create(AOwner: TMycChart);
|
||||
property Count: Int64 read GetCount;
|
||||
property MainSeries: TSeries read GetMainSeries;
|
||||
property Owner: TMycChart read GetOwner;
|
||||
end;
|
||||
|
||||
private
|
||||
FSeriesList: TList<TSeries>;
|
||||
FLookback: Integer;
|
||||
FIdleSubscrId: TMessageSubscriptionId;
|
||||
protected
|
||||
procedure Paint; override;
|
||||
procedure DoIdle;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
|
||||
// Creates an OHLC candlestick/bar series
|
||||
function CreateOhlcListener(
|
||||
const AUpColor: TAlphaColor = TAlphaColors.Green;
|
||||
const ADownColor: TAlphaColor = TAlphaColors.Red;
|
||||
const AStyle: TCandleStyle = csCandleStick
|
||||
): IMycProcessor<TArray<TDataPoint<TOhlcItem>>>;
|
||||
|
||||
// Creates a simple line series for double values
|
||||
function CreateDoubleListener(const ALineColor: TAlphaColor = TAlphaColors.Cornflowerblue; const ALineWidth: Single = 1.5):
|
||||
IMycProcessor<TArray<Double>>;
|
||||
|
||||
// The maximum number of data points to display from the main series.
|
||||
property Lookback: Integer read FLookback write FLookback;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.Math,
|
||||
System.SyncObjs, WinApi.Windows,
|
||||
Myc.Trade.DataArray;
|
||||
|
||||
type
|
||||
TChartSeriesProcessor<T> = class(TMycChart.TSeries, IMycProcessor<TArray<T>>)
|
||||
strict private
|
||||
FDataSeries: TMycDataArray<T>;
|
||||
FChanged: Boolean;
|
||||
FLock: TSpinLock;
|
||||
procedure ProcessData(const Values: TArray<T>);
|
||||
private
|
||||
FData: TMycDataArray<T>;
|
||||
protected
|
||||
function GetCount: Int64; override;
|
||||
function Update: Boolean; override;
|
||||
|
||||
public
|
||||
constructor Create(AOwner: TMycChart);
|
||||
property Data: TMycDataArray<T> read FData;
|
||||
end;
|
||||
|
||||
{ TChartOhlcSeries }
|
||||
TChartOhlcSeries = class(TChartSeriesProcessor<TDataPoint<TOhlcItem>>)
|
||||
private
|
||||
FUpColor: TAlphaColor;
|
||||
FDownColor: TAlphaColor;
|
||||
FStyle: TCandleStyle;
|
||||
protected
|
||||
function GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; override;
|
||||
procedure Paint(const ACanvas: TCanvas; const AXForm, AYForm: TFunc<Double, Single>); override;
|
||||
public
|
||||
constructor Create(AOwner: TMycChart; const AUpColor, ADownColor: TAlphaColor; AStyle: TCandleStyle);
|
||||
end;
|
||||
|
||||
{ TChartLineSeries }
|
||||
TChartLineSeries = class(TChartSeriesProcessor<Double>)
|
||||
private
|
||||
FLineColor: TAlphaColor;
|
||||
FLineWidth: Single;
|
||||
protected
|
||||
function GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean; override;
|
||||
procedure Paint(const ACanvas: TCanvas; const AXForm, AYForm: TFunc<Double, Single>); override;
|
||||
public
|
||||
constructor Create(AOwner: TMycChart; const ALineColor: TAlphaColor; ALineWidth: Single);
|
||||
end;
|
||||
|
||||
{ TMycChart.TSeries }
|
||||
|
||||
constructor TMycChart.TSeries.Create(AOwner: TMycChart);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
end;
|
||||
|
||||
function TMycChart.TSeries.GetMainSeries: TSeries;
|
||||
begin
|
||||
Result := nil;
|
||||
if Owner.FSeriesList.Count > 0 then
|
||||
Result := Owner.FSeriesList[0];
|
||||
end;
|
||||
|
||||
function TMycChart.TSeries.GetOwner: TMycChart;
|
||||
begin
|
||||
Result := Controller as TMycChart;
|
||||
end;
|
||||
|
||||
{ TMycChart }
|
||||
|
||||
constructor TMycChart.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FSeriesList := TObjectList<TSeries>.Create(true);
|
||||
FLookback := 100; // Default lookback
|
||||
|
||||
FIdleSubscrId :=
|
||||
TMessageManager
|
||||
.DefaultManager
|
||||
.SubscribeToMessage(TIdleMessage, procedure(const Sender: TObject; const M: TMessage) begin DoIdle; end);
|
||||
end;
|
||||
|
||||
destructor TMycChart.Destroy;
|
||||
begin
|
||||
TMessageManager.DefaultManager.Unsubscribe(TIdleMessage, FIdleSubscrId);
|
||||
|
||||
FSeriesList.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TMycChart.CreateDoubleListener(const ALineColor: TAlphaColor = TAlphaColors.Cornflowerblue; const ALineWidth: Single = 1.5):
|
||||
IMycProcessor<TArray<Double>>;
|
||||
var
|
||||
series: TChartLineSeries;
|
||||
begin
|
||||
series := TChartLineSeries.Create(Self, ALineColor, ALineWidth);
|
||||
FSeriesList.Add(series);
|
||||
Result := series;
|
||||
end;
|
||||
|
||||
function TMycChart.CreateOhlcListener(
|
||||
const AUpColor: TAlphaColor = TAlphaColors.Green;
|
||||
const ADownColor: TAlphaColor = TAlphaColors.Red;
|
||||
const AStyle: TCandleStyle = csCandleStick
|
||||
): IMycProcessor<TArray<TDataPoint<TOhlcItem>>>;
|
||||
var
|
||||
series: TChartOhlcSeries;
|
||||
begin
|
||||
series := TChartOhlcSeries.Create(Self, AUpColor, ADownColor, AStyle);
|
||||
FSeriesList.Add(series);
|
||||
Result := series;
|
||||
end;
|
||||
|
||||
procedure TMycChart.DoIdle;
|
||||
begin
|
||||
var doRepaint := false;
|
||||
for var series in FSeriesList do
|
||||
if series.Update then
|
||||
doRepaint := true;
|
||||
if doRepaint then
|
||||
Repaint;
|
||||
end;
|
||||
|
||||
procedure TMycChart.Paint;
|
||||
var
|
||||
rect: TRectF;
|
||||
series: TSeries;
|
||||
globalMin, globalMax, seriesMin, seriesMax, padding: Double;
|
||||
rangeInitialized: Boolean;
|
||||
xTransform: TFunc<Double, Single>;
|
||||
yTransform: TFunc<Double, Single>;
|
||||
begin
|
||||
inherited;
|
||||
rect := Self.LocalRect;
|
||||
|
||||
if (FSeriesList.Count = 0) or (FLookback <= 1) then
|
||||
begin
|
||||
Canvas.Fill.Color := TAlphaColors.Gray;
|
||||
Canvas.FillText(rect, 'No Data', false, 1, [], TTextAlign.Center, TTextAlign.Center);
|
||||
Exit;
|
||||
end;
|
||||
|
||||
rangeInitialized := false;
|
||||
|
||||
for series in FSeriesList do
|
||||
begin
|
||||
if series.GetValueRange(0, FLookback, seriesMin, seriesMax) then
|
||||
begin
|
||||
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;
|
||||
|
||||
if not rangeInitialized then
|
||||
Exit;
|
||||
|
||||
padding := (globalMax - globalMin) * 0.1;
|
||||
globalMin := globalMin - padding;
|
||||
globalMax := globalMax + padding;
|
||||
|
||||
if (globalMax - globalMin) = 0 then
|
||||
exit;
|
||||
|
||||
xTransform := function(index: Double): Single begin Result := rect.Right - (index / (FLookback - 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));
|
||||
|
||||
for series in FSeriesList do
|
||||
begin
|
||||
series.Paint(Self.Canvas, xTransform, yTransform);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TChartSeriesProcessor<T> }
|
||||
|
||||
constructor TChartSeriesProcessor<T>.Create(AOwner: TMycChart);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FLock := TSpinLock.Create(false);
|
||||
FDataSeries := TMycDataArray<T>.CreateEmpty;
|
||||
FData := FDataSeries;
|
||||
end;
|
||||
|
||||
function TChartSeriesProcessor<T>.GetCount: Int64;
|
||||
begin
|
||||
Result := FData.Count;
|
||||
end;
|
||||
|
||||
procedure TChartSeriesProcessor<T>.ProcessData(const Values: TArray<T>);
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
FDataSeries := FDataSeries.Add(Values, 0, Length(Values), Owner.Lookback);
|
||||
FChanged := true;
|
||||
finally
|
||||
FLock.Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TChartSeriesProcessor<T>.Update: Boolean;
|
||||
begin
|
||||
FLock.Enter;
|
||||
try
|
||||
Result := FChanged;
|
||||
FChanged := false;
|
||||
if Result then
|
||||
FData := FDataSeries;
|
||||
finally
|
||||
FLock.Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TChartOhlcSeries }
|
||||
|
||||
constructor TChartOhlcSeries.Create(AOwner: TMycChart; const AUpColor, ADownColor: TAlphaColor; AStyle: TCandleStyle);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FUpColor := AUpColor;
|
||||
FDownColor := ADownColor;
|
||||
FStyle := AStyle;
|
||||
end;
|
||||
|
||||
function TChartOhlcSeries.GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean;
|
||||
var
|
||||
i: 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
|
||||
begin
|
||||
Min := System.Math.Min(Min, Data.Items[i].Data.Low);
|
||||
Max := System.Math.Max(Max, Data.Items[i].Data.High);
|
||||
end;
|
||||
Result := (Min <> MaxDouble);
|
||||
end;
|
||||
|
||||
procedure TChartOhlcSeries.Paint(const ACanvas: TCanvas; const AXForm, AYForm: TFunc<Double, Single>);
|
||||
var
|
||||
i, displayCount: Int64;
|
||||
x, candleWidth: Single;
|
||||
yOpen, yHigh, yLow, yClose: Single;
|
||||
item: TDataPoint<TOhlcItem>;
|
||||
isUp: boolean;
|
||||
begin
|
||||
displayCount := System.Math.Min(Data.Count, Owner.Lookback);
|
||||
if displayCount <= 0 then
|
||||
Exit;
|
||||
|
||||
if displayCount > 1 then
|
||||
candleWidth := Max(2, 0.8 * Abs((AXForm(1) - AXForm(0))))
|
||||
else
|
||||
candleWidth := 10;
|
||||
|
||||
for i := 0 to displayCount - 1 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);
|
||||
isUp := item.Data.Close >= item.Data.Open;
|
||||
|
||||
if isUp then
|
||||
ACanvas.Stroke.Color := FUpColor
|
||||
else
|
||||
ACanvas.Stroke.Color := FDownColor;
|
||||
ACanvas.Stroke.Thickness := 1.0;
|
||||
|
||||
ACanvas.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;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TChartLineSeries }
|
||||
|
||||
constructor TChartLineSeries.Create(AOwner: TMycChart; const ALineColor: TAlphaColor; ALineWidth: Single);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FLineColor := ALineColor;
|
||||
FLineWidth := ALineWidth;
|
||||
end;
|
||||
|
||||
function TChartLineSeries.GetValueRange(StartIndex, Count: Int64; out Min, Max: Double): Boolean;
|
||||
var
|
||||
i: 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
|
||||
begin
|
||||
Min := System.Math.Min(Min, Data.Items[i]);
|
||||
Max := System.Math.Max(Max, Data.Items[i]);
|
||||
end;
|
||||
Result := (Min <> MaxDouble);
|
||||
end;
|
||||
|
||||
procedure TChartLineSeries.Paint(const ACanvas: TCanvas; const AXForm, AYForm: TFunc<Double, Single>);
|
||||
begin
|
||||
if not Assigned(MainSeries) or (Data.Count = 0) or (MainSeries.Count = 0) then
|
||||
Exit;
|
||||
|
||||
var points := TPathData.Create;
|
||||
|
||||
var displayCount := System.Math.Min(Data.Count, Owner.Lookback);
|
||||
if displayCount < 2 then
|
||||
Exit;
|
||||
|
||||
points.MoveTo( TPointF.Create(AXForm(0), AYForm(Data[0])) );
|
||||
for var i := 1 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.
|
||||
@@ -23,6 +23,9 @@ type
|
||||
Receiver: T; // The registered interface instance (the event sink).
|
||||
end;
|
||||
|
||||
// Notify function. If this results false, it will be removed from the notify list
|
||||
TNotifyProc = reference to function(const Obj: T): Boolean;
|
||||
|
||||
strict private
|
||||
// Head of the linked list. The pointer value itself is repurposed for a spinlock.
|
||||
// Bit 0 of the address stores the lock state (0 = locked, 1 = unlocked).
|
||||
@@ -36,9 +39,9 @@ type
|
||||
|
||||
public
|
||||
// Initializes the list in an unlocked state.
|
||||
procedure Create;
|
||||
class operator Initialize(out Dest: TMycNotifyList<T>);
|
||||
// Safely clears all registered receivers and cleans up resources.
|
||||
procedure Destroy;
|
||||
procedure Finalize;
|
||||
// Registers a receiver interface and returns an opaque tag for later unsubscription.
|
||||
function Advise(const Receiver: T): TTag;
|
||||
// Unregisters a single receiver using its subscription tag.
|
||||
@@ -54,17 +57,17 @@ type
|
||||
// Invokes a predicate for each registered receiver.
|
||||
// If the predicate returns false, the receiver is detached from further notifications
|
||||
// by setting its interface reference to nil. The list item itself is not freed here.
|
||||
procedure Notify(Func: TPredicate<T>);
|
||||
procedure Notify(const Func: TNotifyProc);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
procedure TMycNotifyList<T>.Create;
|
||||
class operator TMycNotifyList<T>.Initialize(out Dest: TMycNotifyList<T>);
|
||||
begin
|
||||
NativeUInt(FList) := 1;
|
||||
NativeUInt(Dest.FList) := 1;
|
||||
end;
|
||||
|
||||
procedure TMycNotifyList<T>.Destroy;
|
||||
procedure TMycNotifyList<T>.Finalize;
|
||||
begin
|
||||
Lock;
|
||||
UnadviseAll;
|
||||
@@ -114,7 +117,7 @@ begin
|
||||
Result := NativeUInt(FList) and 1 = 0;
|
||||
end;
|
||||
|
||||
procedure TMycNotifyList<T>.Notify(Func: TPredicate<T>);
|
||||
procedure TMycNotifyList<T>.Notify(const Func: TNotifyProc);
|
||||
var
|
||||
Item: PItem;
|
||||
Last: PItem;
|
||||
|
||||
@@ -184,12 +184,11 @@ end;
|
||||
constructor TMycEvent.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FSubscribers.Create;
|
||||
end;
|
||||
|
||||
destructor TMycEvent.Destroy;
|
||||
begin
|
||||
FSubscribers.Destroy;
|
||||
FSubscribers.Finalize;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
@@ -202,7 +201,7 @@ function TMycEvent.Notify: Boolean;
|
||||
begin
|
||||
FSubscribers.Lock;
|
||||
try
|
||||
FSubscribers.Notify(function(Subscriber: TSignal.ISubscriber): Boolean begin Result := Subscriber.Notify; end);
|
||||
FSubscribers.Notify(function(const Subscriber: TSignal.ISubscriber): Boolean begin Result := Subscriber.Notify; end);
|
||||
finally
|
||||
FSubscribers.Release;
|
||||
end;
|
||||
@@ -275,12 +274,11 @@ begin
|
||||
inherited Create;
|
||||
Assert(ACount >= 0);
|
||||
FCount := ACount;
|
||||
FSubscribers.Create;
|
||||
end;
|
||||
|
||||
destructor TMycLatch.Destroy;
|
||||
begin
|
||||
FSubscribers.Destroy;
|
||||
FSubscribers.Finalize;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
@@ -300,7 +298,7 @@ begin
|
||||
|
||||
if shouldNotifySubscribers then
|
||||
begin
|
||||
FSubscribers.Notify(function(Subscriber: TSignal.ISubscriber): Boolean begin Result := Subscriber.Notify; end);
|
||||
FSubscribers.Notify(function(const Subscriber: TSignal.ISubscriber): Boolean begin Result := Subscriber.Notify; end);
|
||||
end;
|
||||
|
||||
// Returns true if the latch has not yet been set by this Notify call (count > 0).
|
||||
@@ -395,12 +393,11 @@ constructor TMycFlag.Create(AInit: Boolean);
|
||||
begin
|
||||
inherited Create;
|
||||
FFlag := AInit;
|
||||
FSubscribers.Create;
|
||||
end;
|
||||
|
||||
destructor TMycFlag.Destroy;
|
||||
begin
|
||||
FSubscribers.Destroy; // Clean up the subscriber list.
|
||||
FSubscribers.Finalize;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
@@ -438,7 +435,7 @@ begin
|
||||
|
||||
if wasPreviouslyClean then // Only notify subscribers if state changed from clean to dirty.
|
||||
begin
|
||||
FSubscribers.Notify(function(Subscriber: TSignal.ISubscriber): Boolean begin Result := Subscriber.Notify; end);
|
||||
FSubscribers.Notify(function(const Subscriber: TSignal.ISubscriber): Boolean begin Result := Subscriber.Notify; end);
|
||||
end;
|
||||
finally
|
||||
FSubscribers.Release;
|
||||
|
||||
@@ -14,6 +14,7 @@ type
|
||||
public
|
||||
function ProcessSignal(const Signal: TSignal; const Proc: TMsgProc): TComponent; overload;
|
||||
function ProcessSignal(const Signal: TSignal; const Proc: TProc): TComponent; overload;
|
||||
function ProcessSignal(const Signal: TSignal; const Done: TState; const Proc: TProc): TComponent; overload;
|
||||
end;
|
||||
|
||||
TSignalSyncHelper = record helper for TSignal
|
||||
@@ -198,6 +199,21 @@ begin
|
||||
Result := TSignalSubscriber.Create(Self, Signal, Proc);
|
||||
end;
|
||||
|
||||
function TSignalComponentHelper.ProcessSignal(const Signal: TSignal; const Done: TState; const Proc: TProc): TComponent;
|
||||
begin
|
||||
var cProc: TProc := Proc;
|
||||
var cDone: TState := Done;
|
||||
Result :=
|
||||
ProcessSignal(
|
||||
Signal,
|
||||
procedure(out IsDone: Boolean)
|
||||
begin
|
||||
cProc();
|
||||
IsDone := cDone.IsSet;
|
||||
end
|
||||
);
|
||||
end;
|
||||
|
||||
{ TSignalSyncHelper }
|
||||
|
||||
function TSignalSyncHelper.Queue(const Proc: TProc; Delay: Integer = 0): TSignal.TSubscription;
|
||||
|
||||
+1
-1
@@ -153,7 +153,7 @@ type
|
||||
|
||||
class function CreateLatch(Count: Integer): ILatch; static;
|
||||
|
||||
class function Enqueue1(var Gate: TLatch): TState; overload; static;
|
||||
class function Enqueue1(var Gate: TLatch): TState; overload; static; deprecated; experimental;
|
||||
function Enqueue: TState; overload;
|
||||
|
||||
class property Null: ILatch read FNull;
|
||||
|
||||
@@ -134,7 +134,7 @@ procedure TTestDataSeries.TestSetupSeriesWithDataVerification;
|
||||
var
|
||||
i: Integer;
|
||||
baseTime, expectedTime: TDateTime;
|
||||
expectedAsk: Single;
|
||||
expectedAsk: Double;
|
||||
begin
|
||||
SetupSeriesWithData;
|
||||
baseTime := EncodeDate(2020, 7, 7);
|
||||
@@ -200,7 +200,7 @@ begin
|
||||
begin
|
||||
expectedTime := baseTime + (9 - i);
|
||||
Assert.AreEqual(expectedTime, FSeries.Items[i].Time, 'Item at logical index should have reversed chronological time');
|
||||
Assert.AreEqual(Single(9 - i), FSeries.Items[i].Data.Ask, 'Item data at logical index should match reversed insertion order');
|
||||
Assert.AreEqual(Double(9 - i), FSeries.Items[i].Data.Ask, 'Item data at logical index should match reversed insertion order');
|
||||
end;
|
||||
end;
|
||||
|
||||
@@ -648,9 +648,9 @@ procedure TTestDataSeries.TestDataAndTimePropertiesRespectLookback;
|
||||
var
|
||||
baseTime: TDateTime;
|
||||
expectedOldestTime: TDateTime;
|
||||
expectedOldestAsk: Single;
|
||||
expectedOldestAsk: Double;
|
||||
expectedNewestTime: TDateTime;
|
||||
expectedNewestAsk: Single;
|
||||
expectedNewestAsk: Double;
|
||||
begin
|
||||
SetupSeriesWithData(20, 15); // Add 20 items, lookback 15.
|
||||
// Visible items are those originally at index 5 through 19.
|
||||
|
||||
@@ -19,8 +19,8 @@ type
|
||||
[IgnoreMemoryLeaks(true)]
|
||||
TTest_TABFileServer_Equivalence = class(TObject)
|
||||
private
|
||||
FServer: IDataServer<TAskBidItem>;
|
||||
FStream: IDataStream<TAskBidItem>;
|
||||
FServer: IDataServer<TAuraAskBidFileItem>;
|
||||
FStream: IDataStream<TAuraAskBidFileItem>;
|
||||
public
|
||||
[SetupFixture]
|
||||
procedure SetupFixture;
|
||||
@@ -77,17 +77,17 @@ end;
|
||||
|
||||
procedure TTest_TABFileServer_Equivalence.Test_ServerReturnsSameDataAs_LoadDataSeries;
|
||||
var
|
||||
chunk: array[0..C_MAX_FETCH - 1] of TDataPoint<TAskBidItem>;
|
||||
dst: TArray<TDataPoint<TAskBidItem>>;
|
||||
chunk: array[0..C_MAX_FETCH - 1] of TDataPoint<TAuraAskBidFileItem>;
|
||||
dst: TArray<TDataPoint<TAuraAskBidFileItem>>;
|
||||
i: Int64;
|
||||
n: Integer;
|
||||
cnt: Int64;
|
||||
timeout: Integer;
|
||||
filename: TAuraDataFile;
|
||||
expectedData: TArray<TDataPoint<TAskBidItem>>;
|
||||
expectedData: TArray<TDataPoint<TAuraAskBidFileItem>>;
|
||||
begin
|
||||
// 1. Expected data is loaded directly using LoadDataSeries.
|
||||
filename := (FServer as TAuraDataServer<TAskBidItem>).FindFirstFile(C_TEST_SYMBOL).WaitFor;
|
||||
filename := (FServer as TAuraDataServer<TAuraAskBidFileItem>).FindFirstFile(C_TEST_SYMBOL).WaitFor;
|
||||
Assert.IsTrue(filename.IsValid, 'Test data file could not be found.');
|
||||
|
||||
expectedData := (FServer as TAuraTABFileServer).LoadDataSeries(filename).WaitFor;
|
||||
|
||||
@@ -5,35 +5,14 @@ interface
|
||||
uses
|
||||
System.Generics.Collections,
|
||||
System.TimeSpan,
|
||||
Myc.Trade.DataPoint;
|
||||
Myc.Trade.DataPoint,
|
||||
Myc.Trade.DataArray;
|
||||
|
||||
type
|
||||
TMycDataArray<T> = record
|
||||
private
|
||||
const
|
||||
ChunkSize = 1024;
|
||||
type
|
||||
TChunk = TArray<TDataPoint<T>>;
|
||||
private
|
||||
FChunks: TArray<TChunk>;
|
||||
FCount: Int64;
|
||||
|
||||
function LogicalToPhysicalIndex(LogicalIndex: Int64): Int64; inline;
|
||||
function GetItems(Idx: Int64): TDataPoint<T>; inline;
|
||||
public
|
||||
constructor Create(const AChunks: TArray<TChunk>; ACount: Int64);
|
||||
function Add(const Data: array of TDataPoint<T>; First, Count, Lookback: Int64): TMycDataArray<T>;
|
||||
class function CreateEmpty: TMycDataArray<T>; static;
|
||||
// Helper to create a data array from a raw TArray.
|
||||
class function CreateFromArray(const AData: TArray<TDataPoint<T>>; First, Count: Integer): TMycDataArray<T>; static;
|
||||
property Count: Int64 read FCount;
|
||||
property Items[Idx: Int64]: TDataPoint<T> read GetItems; default;
|
||||
end;
|
||||
|
||||
// The implementation class for IDataSeries<T>.
|
||||
TMycDataSeries<T> = class(TInterfacedObject, IDataSeries<T>)
|
||||
private
|
||||
FData: TMycDataArray<T>;
|
||||
FData: TMycDataArray<TDataPoint<T>>;
|
||||
FLookback: Int64;
|
||||
FTotalCount: Int64;
|
||||
function GetCount: Int64;
|
||||
@@ -41,10 +20,14 @@ type
|
||||
function GetLookback: Int64;
|
||||
function GetTotalCount: Int64;
|
||||
public
|
||||
constructor Create(ALookback: Int64; const AData: TMycDataArray<T>; ATotalCount: Int64);
|
||||
constructor Create(ALookback: Int64; const AData: TMycDataArray<TDataPoint<T>>; ATotalCount: Int64);
|
||||
destructor Destroy; override;
|
||||
function Add(const Data: TArray<TDataPoint<T>>; First, Count: Integer): IDataSeries<T>;
|
||||
class function CreateDataSeries(Lookback: Int64; const AData: TMycDataArray<T>; ATotalCount: Int64): IDataSeries<T>; static;
|
||||
class function CreateDataSeries(
|
||||
Lookback: Int64;
|
||||
const AData: TMycDataArray<TDataPoint<T>>;
|
||||
ATotalCount: Int64
|
||||
): IDataSeries<T>; static;
|
||||
end;
|
||||
|
||||
// Null object implementation for IDataSeries<T>
|
||||
@@ -69,7 +52,7 @@ type
|
||||
TCompositeDataSeries<T> = class(TInterfacedObject, IDataSeries<T>)
|
||||
private
|
||||
FBaseSeries: IDataSeries<T>;
|
||||
FAddedData: TMycDataArray<T>;
|
||||
FAddedData: TMycDataArray<TDataPoint<T>>;
|
||||
FLookback: Int64;
|
||||
FCount: Int64;
|
||||
function GetCount: Int64;
|
||||
@@ -77,7 +60,7 @@ type
|
||||
function GetLookback: Int64;
|
||||
function GetTotalCount: Int64;
|
||||
public
|
||||
constructor Create(const ABaseSeries: IDataSeries<T>; const AAddedData: TMycDataArray<T>);
|
||||
constructor Create(const ABaseSeries: IDataSeries<T>; const AAddedData: TMycDataArray<TDataPoint<T>>);
|
||||
function Add(const Data: TArray<TDataPoint<T>>; First, Count: Integer): IDataSeries<T>;
|
||||
class function CreateComposite(
|
||||
const BaseSeries: IDataSeries<T>;
|
||||
@@ -128,97 +111,9 @@ uses
|
||||
System.SysUtils,
|
||||
System.Math;
|
||||
|
||||
{ TMycDataArray<T> }
|
||||
|
||||
constructor TMycDataArray<T>.Create(const AChunks: TArray<TChunk>; ACount: Int64);
|
||||
begin
|
||||
FChunks := AChunks;
|
||||
FCount := ACount;
|
||||
end;
|
||||
|
||||
class function TMycDataArray<T>.CreateEmpty: TMycDataArray<T>;
|
||||
begin
|
||||
Result.FChunks := nil;
|
||||
Result.FCount := 0;
|
||||
end;
|
||||
|
||||
class function TMycDataArray<T>.CreateFromArray(const AData: TArray<TDataPoint<T>>; First, Count: Integer): TMycDataArray<T>;
|
||||
begin
|
||||
// Use the Add method on an empty array to perform the chunking logic.
|
||||
Result := CreateEmpty.Add(AData, First, Count, Count);
|
||||
end;
|
||||
|
||||
function TMycDataArray<T>.Add(const Data: array of TDataPoint<T>; First, Count, Lookback: Int64): TMycDataArray<T>;
|
||||
var
|
||||
destPhysicalIdx, sourcePhysicalIdx: Int64;
|
||||
itemsToSkip: Int64;
|
||||
numNewChunks: Integer;
|
||||
newChunks: TArray<TChunk>;
|
||||
destChunkIdx, destSubIdx: Integer;
|
||||
sumCount, newCount: Int64;
|
||||
begin
|
||||
if Count < 0 then
|
||||
Count := Length(Data) - First;
|
||||
if (Lookback <= 0) or (Count = 0) then
|
||||
exit(Self);
|
||||
|
||||
Assert(Count <= (Length(Data) - First), 'Count cannot be larger than the source array');
|
||||
for var i := First + 1 to First + Count - 1 do
|
||||
Assert(Data[i].Time >= Data[i - 1].Time, 'Input array for Add is not chronologically sorted');
|
||||
if FCount > 0 then
|
||||
Assert(Data[First].Time >= Self.Items[0].Time, 'First new item is older than last existing item');
|
||||
|
||||
sumCount := FCount + Count;
|
||||
newCount := sumCount;
|
||||
if (Lookback > 0) and (newCount > Lookback) then
|
||||
newCount := Lookback;
|
||||
itemsToSkip := sumCount - newCount;
|
||||
|
||||
numNewChunks := 0;
|
||||
if newCount > 0 then
|
||||
numNewChunks := (newCount - 1) div ChunkSize + 1;
|
||||
SetLength(newChunks, numNewChunks);
|
||||
|
||||
for destPhysicalIdx := 0 to newCount - 1 do
|
||||
begin
|
||||
destChunkIdx := destPhysicalIdx div ChunkSize;
|
||||
destSubIdx := destPhysicalIdx mod ChunkSize;
|
||||
|
||||
if destSubIdx = 0 then
|
||||
SetLength(newChunks[destChunkIdx], ChunkSize);
|
||||
|
||||
sourcePhysicalIdx := itemsToSkip + destPhysicalIdx;
|
||||
|
||||
if sourcePhysicalIdx < FCount then
|
||||
begin
|
||||
newChunks[destChunkIdx][destSubIdx] := FChunks[sourcePhysicalIdx div ChunkSize][sourcePhysicalIdx mod ChunkSize];
|
||||
end
|
||||
else
|
||||
begin
|
||||
newChunks[destChunkIdx][destSubIdx] := Data[First + (sourcePhysicalIdx - FCount)];
|
||||
end;
|
||||
end;
|
||||
|
||||
Result := TMycDataArray<T>.Create(newChunks, newCount);
|
||||
end;
|
||||
|
||||
function TMycDataArray<T>.GetItems(Idx: Int64): TDataPoint<T>;
|
||||
var
|
||||
physicalIndex: Int64;
|
||||
begin
|
||||
Assert((Idx >= 0) and (Idx < FCount), 'Logical index is out of bounds.');
|
||||
physicalIndex := LogicalToPhysicalIndex(Idx);
|
||||
Result := FChunks[physicalIndex div ChunkSize][physicalIndex mod ChunkSize];
|
||||
end;
|
||||
|
||||
function TMycDataArray<T>.LogicalToPhysicalIndex(LogicalIndex: Int64): Int64;
|
||||
begin
|
||||
Result := FCount - LogicalIndex - 1;
|
||||
end;
|
||||
|
||||
{ TMycDataSeries<T> }
|
||||
|
||||
constructor TMycDataSeries<T>.Create(ALookback: Int64; const AData: TMycDataArray<T>; ATotalCount: Int64);
|
||||
constructor TMycDataSeries<T>.Create(ALookback: Int64; const AData: TMycDataArray<TDataPoint<T>>; ATotalCount: Int64);
|
||||
begin
|
||||
inherited Create;
|
||||
FLookback := ALookback;
|
||||
@@ -231,7 +126,11 @@ begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
class function TMycDataSeries<T>.CreateDataSeries(Lookback: Int64; const AData: TMycDataArray<T>; ATotalCount: Int64): IDataSeries<T>;
|
||||
class function TMycDataSeries<T>.CreateDataSeries(
|
||||
Lookback: Int64;
|
||||
const AData: TMycDataArray<TDataPoint<T>>;
|
||||
ATotalCount: Int64
|
||||
): IDataSeries<T>;
|
||||
begin
|
||||
if Lookback > 0 then
|
||||
Result := TMycDataSeries<T>.Create(Lookback, AData, ATotalCount)
|
||||
@@ -241,7 +140,7 @@ end;
|
||||
|
||||
function TMycDataSeries<T>.Add(const Data: TArray<TDataPoint<T>>; First, Count: Integer): IDataSeries<T>;
|
||||
var
|
||||
newData: TMycDataArray<T>;
|
||||
newData: TMycDataArray<TDataPoint<T>>;
|
||||
newTotalCount: Int64;
|
||||
begin
|
||||
if Count < 0 then
|
||||
@@ -319,7 +218,7 @@ end;
|
||||
|
||||
{ TCompositeDataSeries<T> }
|
||||
|
||||
constructor TCompositeDataSeries<T>.Create(const ABaseSeries: IDataSeries<T>; const AAddedData: TMycDataArray<T>);
|
||||
constructor TCompositeDataSeries<T>.Create(const ABaseSeries: IDataSeries<T>; const AAddedData: TMycDataArray<TDataPoint<T>>);
|
||||
begin
|
||||
inherited Create;
|
||||
FBaseSeries := ABaseSeries;
|
||||
@@ -334,7 +233,7 @@ end;
|
||||
|
||||
function TCompositeDataSeries<T>.Add(const Data: TArray<TDataPoint<T>>; First, Count: Integer): IDataSeries<T>;
|
||||
var
|
||||
newAddedData: TMycDataArray<T>;
|
||||
newAddedData: TMycDataArray<TDataPoint<T>>;
|
||||
itemsInBase: Int64;
|
||||
lookbackForAdd: Int64;
|
||||
begin
|
||||
@@ -373,7 +272,7 @@ begin
|
||||
if Count = 0 then
|
||||
exit(BaseSeries);
|
||||
|
||||
Result := TCompositeDataSeries<T>.Create(BaseSeries, TMycDataArray<T>.CreateFromArray(Data, First, Count));
|
||||
Result := TCompositeDataSeries<T>.Create(BaseSeries, TMycDataArray<TDataPoint<T>>.CreateFromArray(Data, First, Count));
|
||||
end;
|
||||
|
||||
function TCompositeDataSeries<T>.GetCount: Int64;
|
||||
|
||||
@@ -0,0 +1,123 @@
|
||||
unit Myc.Trade.DataArray;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Myc.Trade.DataPoint;
|
||||
|
||||
type
|
||||
TMycDataArray<T> = record
|
||||
private
|
||||
const
|
||||
ChunkSize = 1024;
|
||||
type
|
||||
TChunk = TArray<T>;
|
||||
private
|
||||
FChunks: TArray<TChunk>;
|
||||
FCount: Int64;
|
||||
|
||||
function LogicalToPhysicalIndex(LogicalIndex: Int64): Int64; inline;
|
||||
function GetItems(Idx: Int64): T; inline;
|
||||
public
|
||||
constructor Create(const AChunks: TArray<TChunk>; ACount: Int64);
|
||||
function Add(const Data: T; Lookback: Int64): TMycDataArray<T>; overload;
|
||||
function Add(const Data: array of T; First, Count, Lookback: Int64): TMycDataArray<T>; overload;
|
||||
class function CreateEmpty: TMycDataArray<T>; static;
|
||||
// Helper to create a data array from a raw TArray.
|
||||
class function CreateFromArray(const AData: TArray<T>; First, Count: Integer): TMycDataArray<T>; static;
|
||||
property Count: Int64 read FCount;
|
||||
property Items[Idx: Int64]: T read GetItems; default;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TMycDataArray<T> }
|
||||
|
||||
constructor TMycDataArray<T>.Create(const AChunks: TArray<TChunk>; ACount: Int64);
|
||||
begin
|
||||
FChunks := AChunks;
|
||||
FCount := ACount;
|
||||
end;
|
||||
|
||||
class function TMycDataArray<T>.CreateEmpty: TMycDataArray<T>;
|
||||
begin
|
||||
Result.FChunks := nil;
|
||||
Result.FCount := 0;
|
||||
end;
|
||||
|
||||
class function TMycDataArray<T>.CreateFromArray(const AData: TArray<T>; First, Count: Integer): TMycDataArray<T>;
|
||||
begin
|
||||
// Use the Add method on an empty array to perform the chunking logic.
|
||||
Result := CreateEmpty.Add(AData, First, Count, Count);
|
||||
end;
|
||||
|
||||
function TMycDataArray<T>.Add(const Data: array of T; First, Count, Lookback: Int64): TMycDataArray<T>;
|
||||
var
|
||||
destPhysicalIdx, sourcePhysicalIdx: Int64;
|
||||
itemsToSkip: Int64;
|
||||
numNewChunks: Integer;
|
||||
newChunks: TArray<TChunk>;
|
||||
destChunkIdx, destSubIdx: Integer;
|
||||
sumCount, newCount: Int64;
|
||||
begin
|
||||
if Count < 0 then
|
||||
Count := Length(Data) - First;
|
||||
if (Lookback <= 0) or (Count = 0) then
|
||||
exit(Self);
|
||||
|
||||
Assert(Count <= (Length(Data) - First), 'Count cannot be larger than the source array');
|
||||
|
||||
sumCount := FCount + Count;
|
||||
newCount := sumCount;
|
||||
if (Lookback > 0) and (newCount > Lookback) then
|
||||
newCount := Lookback;
|
||||
itemsToSkip := sumCount - newCount;
|
||||
|
||||
numNewChunks := 0;
|
||||
if newCount > 0 then
|
||||
numNewChunks := (newCount - 1) div ChunkSize + 1;
|
||||
SetLength(newChunks, numNewChunks);
|
||||
|
||||
for destPhysicalIdx := 0 to newCount - 1 do
|
||||
begin
|
||||
destChunkIdx := destPhysicalIdx div ChunkSize;
|
||||
destSubIdx := destPhysicalIdx mod ChunkSize;
|
||||
|
||||
if destSubIdx = 0 then
|
||||
SetLength(newChunks[destChunkIdx], ChunkSize);
|
||||
|
||||
sourcePhysicalIdx := itemsToSkip + destPhysicalIdx;
|
||||
|
||||
if sourcePhysicalIdx < FCount then
|
||||
begin
|
||||
newChunks[destChunkIdx][destSubIdx] := FChunks[sourcePhysicalIdx div ChunkSize][sourcePhysicalIdx mod ChunkSize];
|
||||
end
|
||||
else
|
||||
begin
|
||||
newChunks[destChunkIdx][destSubIdx] := Data[First + (sourcePhysicalIdx - FCount)];
|
||||
end;
|
||||
end;
|
||||
|
||||
Result := TMycDataArray<T>.Create(newChunks, newCount);
|
||||
end;
|
||||
|
||||
function TMycDataArray<T>.Add(const Data: T; Lookback: Int64): TMycDataArray<T>;
|
||||
begin
|
||||
Result := Add([Data], 0, 1, Lookback);
|
||||
end;
|
||||
|
||||
function TMycDataArray<T>.GetItems(Idx: Int64): T;
|
||||
var
|
||||
physicalIndex: Int64;
|
||||
begin
|
||||
Assert((Idx >= 0) and (Idx < FCount), 'Logical index is out of bounds.');
|
||||
physicalIndex := LogicalToPhysicalIndex(Idx);
|
||||
Result := FChunks[physicalIndex div ChunkSize][physicalIndex mod ChunkSize];
|
||||
end;
|
||||
|
||||
function TMycDataArray<T>.LogicalToPhysicalIndex(LogicalIndex: Int64): Int64;
|
||||
begin
|
||||
Result := FCount - LogicalIndex - 1;
|
||||
end;
|
||||
|
||||
end.
|
||||
+105
-19
@@ -8,18 +8,18 @@ uses
|
||||
type
|
||||
// A data record for an Ask/Bid price pair.
|
||||
TAskBidItem = packed record
|
||||
Ask: Single;
|
||||
Bid: Single;
|
||||
constructor Create(AAsk, ABid: Single);
|
||||
Ask: Double;
|
||||
Bid: Double;
|
||||
constructor Create(AAsk, ABid: Double);
|
||||
end;
|
||||
|
||||
TOhlcItem = record
|
||||
Open: Single;
|
||||
High: Single;
|
||||
Low: Single;
|
||||
Close: Single;
|
||||
Volume: Single;
|
||||
constructor Create(AOpen, AHigh, ALow, AClose, AVolume: Single);
|
||||
Open: Double;
|
||||
High: Double;
|
||||
Low: Double;
|
||||
Close: Double;
|
||||
Volume: Double;
|
||||
constructor Create(AOpen, AHigh, ALow, AClose, AVolume: Double);
|
||||
end;
|
||||
|
||||
// Represents a time-stamped data point in a series.
|
||||
@@ -29,13 +29,38 @@ type
|
||||
constructor Create(ATime: TDateTime; const AData: T);
|
||||
end;
|
||||
|
||||
// A time-ordered series of data points, optimized for chronological additions.
|
||||
// The most recently added element has the logical index 0.
|
||||
IMycProcessor<T> = interface
|
||||
procedure ProcessData(const Value: T);
|
||||
end;
|
||||
|
||||
TMycGenericProcessor<T> = class(TInterfacedObject, IMycProcessor<T>)
|
||||
type
|
||||
TProc = reference to procedure(const Value: T);
|
||||
private
|
||||
FProc: TProc;
|
||||
procedure ProcessData(const Value: T);
|
||||
public
|
||||
constructor Create(const AProc: TProc);
|
||||
end;
|
||||
|
||||
TMycContainedProcessor<T> = class(TContainedObject, IMycProcessor<T>)
|
||||
type
|
||||
TProc = procedure(const Value: T) of object;
|
||||
private
|
||||
FProc: TProc;
|
||||
procedure ProcessData(const Value: T);
|
||||
public
|
||||
constructor Create(const Controller: IInterface; const AProc: TProc);
|
||||
end;
|
||||
|
||||
// An immutable time-ordered series of data points.
|
||||
// The most recent element has the logical index 0.
|
||||
IDataSeries<T> = interface
|
||||
function GetCount: Int64;
|
||||
function GetItems(Idx: Int64): TDataPoint<T>;
|
||||
function GetTotalCount: Int64;
|
||||
function GetLookback: Int64;
|
||||
// Add data and result the new series.
|
||||
function Add(const Data: TArray<TDataPoint<T>>; First, Count: Integer): IDataSeries<T>;
|
||||
property Count: Int64 read GetCount;
|
||||
// Accesses data points by their logical index.
|
||||
@@ -74,7 +99,6 @@ type
|
||||
|
||||
function Add(const Data: TArray<TDataPoint<T>>): TDataSeries<T>; overload;
|
||||
function Add(const Data: TArray<TDataPoint<T>>; First, Count: Integer): TDataSeries<T>; overload;
|
||||
|
||||
function Convert<S>(const Func: TConvertFunc<S>): TDataSeries<S>;
|
||||
|
||||
// Searches for a data point by its timestamp.
|
||||
@@ -99,12 +123,21 @@ type
|
||||
function ToOhlc(TimeFrame: TTimeSpan): TDataSeries<TOhlcItem>;
|
||||
end;
|
||||
|
||||
TDataSeriesOhlcHelper = record helper for TDataSeries<TOhlcItem>
|
||||
function ToOpen: TDataSeries<Single>;
|
||||
function ToClose: TDataSeries<Single>;
|
||||
function ToHigh: TDataSeries<Single>;
|
||||
function ToLow: TDataSeries<Single>;
|
||||
function ToVolume: TDataSeries<Single>;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.SysUtils,
|
||||
System.Math,
|
||||
System.Generics.Collections,
|
||||
Myc.Trade.DataArray,
|
||||
Myc.Trade.Core.DataPoint;
|
||||
|
||||
// Optimized helper function using direct TTimeSpan features and integer arithmetic.
|
||||
@@ -180,17 +213,40 @@ begin
|
||||
if not firstPointInBar then
|
||||
ohlcPoints.Add(TDataPoint<TOhlcItem>.Create(windowEndTime, currentBar));
|
||||
|
||||
var dataArray := TMycDataArray<TOhlcItem>.CreateFromArray(ohlcPoints.ToArray, 0, ohlcPoints.Count);
|
||||
var seriesImpl := TMycDataSeries<TOhlcItem>.Create(ohlcPoints.Count, dataArray, ohlcPoints.Count);
|
||||
Result := TDataSeries<TOhlcItem>.Create(seriesImpl);
|
||||
Result := TDataSeries<TOhlcItem>.CreateDataSeries(ohlcPoints.Count, ohlcPoints.ToArray);
|
||||
finally
|
||||
ohlcPoints.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TDataSeriesOhlcHelper.ToClose: TDataSeries<Single>;
|
||||
begin
|
||||
Result := Self.Convert<Single>(function(const Ohlc: TDataPoint<TOhlcItem>): Single begin Result := Ohlc.Data.Close; end);
|
||||
end;
|
||||
|
||||
function TDataSeriesOhlcHelper.ToHigh: TDataSeries<Single>;
|
||||
begin
|
||||
Result := Self.Convert<Single>(function(const Ohlc: TDataPoint<TOhlcItem>): Single begin Result := Ohlc.Data.High; end);
|
||||
end;
|
||||
|
||||
function TDataSeriesOhlcHelper.ToLow: TDataSeries<Single>;
|
||||
begin
|
||||
Result := Self.Convert<Single>(function(const Ohlc: TDataPoint<TOhlcItem>): Single begin Result := Ohlc.Data.Low; end);
|
||||
end;
|
||||
|
||||
function TDataSeriesOhlcHelper.ToOpen: TDataSeries<Single>;
|
||||
begin
|
||||
Result := Self.Convert<Single>(function(const Ohlc: TDataPoint<TOhlcItem>): Single begin Result := Ohlc.Data.Open; end);
|
||||
end;
|
||||
|
||||
function TDataSeriesOhlcHelper.ToVolume: TDataSeries<Single>;
|
||||
begin
|
||||
Result := Self.Convert<Single>(function(const Ohlc: TDataPoint<TOhlcItem>): Single begin Result := Ohlc.Data.Volume; end);
|
||||
end;
|
||||
|
||||
{ TAskBidItem }
|
||||
|
||||
constructor TAskBidItem.Create(AAsk, ABid: Single);
|
||||
constructor TAskBidItem.Create(AAsk, ABid: Double);
|
||||
begin
|
||||
Ask := AAsk;
|
||||
Bid := ABid;
|
||||
@@ -198,7 +254,7 @@ end;
|
||||
|
||||
{ TOhlcItem }
|
||||
|
||||
constructor TOhlcItem.Create(AOpen, AHigh, ALow, AClose, AVolume: Single);
|
||||
constructor TOhlcItem.Create(AOpen, AHigh, ALow, AClose, AVolume: Double);
|
||||
begin
|
||||
Open := AOpen;
|
||||
High := AHigh;
|
||||
@@ -225,12 +281,19 @@ end;
|
||||
|
||||
function TDataSeries<T>.Add(const Data: TArray<TDataPoint<T>>; First, Count: Integer): TDataSeries<T>;
|
||||
begin
|
||||
{$ifdef DEBUG}
|
||||
for var i := First + 1 to First + Count - 1 do
|
||||
Assert(Data[i].Time >= Data[i - 1].Time, 'Input array for Add is not chronologically sorted');
|
||||
if FDataSeries.Count > 0 then
|
||||
Assert(Data[First].Time >= FDataSeries[0].Time, 'First new item is older than last existing item');
|
||||
{$endif}
|
||||
|
||||
Result := FDataSeries.Add(Data, First, Count);
|
||||
end;
|
||||
|
||||
function TDataSeries<T>.Add(const Data: TArray<TDataPoint<T>>): TDataSeries<T>;
|
||||
begin
|
||||
Result := FDataSeries.Add(Data, 0, Length(Data));
|
||||
Result := Add(Data, 0, Length(Data));
|
||||
end;
|
||||
|
||||
function TDataSeries<T>.Convert<S>(const Func: TConvertFunc<S>): TDataSeries<S>;
|
||||
@@ -240,7 +303,8 @@ end;
|
||||
|
||||
class function TDataSeries<T>.CreateDataSeries(Lookback: Int64; const Data: TArray<TDataPoint<T>> = nil): TDataSeries<T>;
|
||||
begin
|
||||
Result := TMycDataSeries<T>.CreateDataSeries(Lookback, TMycDataArray<T>.CreateFromArray(Data, 0, Length(Data)), Length(Data));
|
||||
Result :=
|
||||
TMycDataSeries<T>.CreateDataSeries(Lookback, TMycDataArray<TDataPoint<T>>.CreateFromArray(Data, 0, Length(Data)), Length(Data));
|
||||
end;
|
||||
|
||||
class operator TDataSeries<T>.Finalize(var Dest: TDataSeries<T>);
|
||||
@@ -350,4 +414,26 @@ begin
|
||||
Result[i] := FDataSeries[n - i].Data;
|
||||
end;
|
||||
|
||||
constructor TMycGenericProcessor<T>.Create(const AProc: TProc);
|
||||
begin
|
||||
inherited Create;
|
||||
FProc := AProc;
|
||||
end;
|
||||
|
||||
procedure TMycGenericProcessor<T>.ProcessData(const Value: T);
|
||||
begin
|
||||
FProc(Value);
|
||||
end;
|
||||
|
||||
constructor TMycContainedProcessor<T>.Create(const Controller: IInterface; const AProc: TProc);
|
||||
begin
|
||||
inherited Create(Controller);
|
||||
FProc := AProc;
|
||||
end;
|
||||
|
||||
procedure TMycContainedProcessor<T>.ProcessData(const Value: T);
|
||||
begin
|
||||
FProc(Value);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@@ -54,14 +54,12 @@ type
|
||||
function IsHistory: Boolean; virtual; abstract;
|
||||
end;
|
||||
|
||||
TDataProc<T> = reference to procedure(const Values: TArray<TDataPoint<T>>; const Terminated: TState);
|
||||
|
||||
// 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 Terminate: TSignal; const Proc: TDataProc<T>): TState;
|
||||
function ProcessData(const Symbol: String; const Terminated: TState; const Processor: IMycProcessor<TArray<TDataPoint<T>>>): TState;
|
||||
function EnumerateSymbols: TFuture<TArray<String>>;
|
||||
end;
|
||||
|
||||
@@ -104,8 +102,8 @@ type
|
||||
function ProcessFile(
|
||||
FileInfo: TAuraDataFile;
|
||||
const DataFile: TFuture<TArray<TDataPoint<T>>>;
|
||||
Terminated: TState;
|
||||
Proc: TDataProc<T>
|
||||
const Terminated: TState;
|
||||
Processor: IMycProcessor<TArray<TDataPoint<T>>>
|
||||
): TState;
|
||||
|
||||
strict private
|
||||
@@ -129,7 +127,7 @@ type
|
||||
function EnumerateSymbols: TFuture<TArray<String>>;
|
||||
function LoadDataFile(const DataFile: TAuraDataFile): TFuture<TArray<TDataPoint<T>>>;
|
||||
|
||||
function ProcessData(const Symbol: String; const Terminate: TSignal; const Proc: TDataProc<T>): TState;
|
||||
function ProcessData(const Symbol: String; const Terminated: TState; const Processor: IMycProcessor<TArray<TDataPoint<T>>>): TState;
|
||||
|
||||
property Path: String read GetPath;
|
||||
end;
|
||||
@@ -166,14 +164,19 @@ type
|
||||
|
||||
// Aura tick data file Ask-Bid
|
||||
|
||||
TAuraTABFileServer = class(TAuraDataServer<TAskBidItem>)
|
||||
TAuraAskBidFileItem = packed record
|
||||
Ask: Single;
|
||||
Bid: Single;
|
||||
end;
|
||||
|
||||
TAuraTABFileServer = class(TAuraDataServer<TAuraAskBidFileItem>)
|
||||
protected
|
||||
// Scans a directory and returns the oldest file found for each symbol.
|
||||
class function ReadCompressedData(const InputStream: TStream): TArray<TDataPoint<TAskBidItem>>; override;
|
||||
class function ReadUncompressedData(const InputStream: TStream): TArray<TDataPoint<TAskBidItem>>; override;
|
||||
class function ReadCompressedData(const InputStream: TStream): TArray<TDataPoint<TAuraAskBidFileItem>>; override;
|
||||
class function ReadUncompressedData(const InputStream: TStream): TArray<TDataPoint<TAuraAskBidFileItem>>; override;
|
||||
public
|
||||
function CreateStream(const Symbol: String): IDataStream<TAskBidItem>; override;
|
||||
function LoadDataSeries(const InitialFile: TAuraDataFile): TFuture<TArray<TDataPoint<TAskBidItem>>>;
|
||||
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;
|
||||
|
||||
@@ -390,17 +393,21 @@ begin
|
||||
Result := FPath;
|
||||
end;
|
||||
|
||||
function TAuraDataServer<T>.ProcessData(const Symbol: String; const Terminate: TSignal; const Proc: TDataProc<T>): TState;
|
||||
function TAuraDataServer<T>.ProcessData(
|
||||
const Symbol: String;
|
||||
const Terminated: TState;
|
||||
const Processor: IMycProcessor<TArray<TDataPoint<T>>>
|
||||
): TState;
|
||||
begin
|
||||
var capProc := Proc;
|
||||
var terminated := TFlag.CreateObserver(Terminate).State;
|
||||
var cProc := Processor;
|
||||
var cTerminated := Terminated;
|
||||
|
||||
Result :=
|
||||
FindFirstFile(Symbol)
|
||||
.Chain(
|
||||
function(const FirstFileInfo: TAuraDataFile): TState
|
||||
begin
|
||||
Result := ProcessFile(FirstFileInfo, LoadDataFile(FirstFileInfo), terminated, capProc);
|
||||
Result := ProcessFile(FirstFileInfo, LoadDataFile(FirstFileInfo), cTerminated, cProc);
|
||||
end);
|
||||
end;
|
||||
|
||||
@@ -413,23 +420,24 @@ end;
|
||||
function TAuraDataServer<T>.ProcessFile(
|
||||
FileInfo: TAuraDataFile;
|
||||
const DataFile: TFuture<TArray<TDataPoint<T>>>;
|
||||
Terminated: TState;
|
||||
Proc: TDataProc<T>
|
||||
const Terminated: TState;
|
||||
Processor: IMycProcessor<TArray<TDataPoint<T>>>
|
||||
): TState;
|
||||
begin
|
||||
if not FileInfo.IsValid or Terminated.IsSet then
|
||||
exit(TState.Null);
|
||||
exit(DataFile.Done);
|
||||
|
||||
// Read ahead the next file, while processing the current one
|
||||
var nextFileInfo := FileInfo.GetNextFile;
|
||||
var nextFile := LoadDataFile(nextFileInfo);
|
||||
|
||||
var cTerminated := Terminated;
|
||||
Result :=
|
||||
DataFile.Chain(
|
||||
function(const Data: TArray<TDataPoint<T>>): TState
|
||||
begin
|
||||
Proc(Data, Terminated);
|
||||
Result := ProcessFile(nextFileInfo, nextFile, Terminated, Proc);
|
||||
Processor.ProcessData(Data);
|
||||
Result := ProcessFile(nextFileInfo, nextFile, cTerminated, Processor);
|
||||
end
|
||||
);
|
||||
end;
|
||||
@@ -574,16 +582,16 @@ end;
|
||||
|
||||
{ TAuraTABFileServer }
|
||||
|
||||
function TAuraTABFileServer.CreateStream(const Symbol: String): IDataStream<TAskBidItem>;
|
||||
function TAuraTABFileServer.CreateStream(const Symbol: String): IDataStream<TAuraAskBidFileItem>;
|
||||
begin
|
||||
Result := TAuraFileStream<TAskBidItem>.Create(Self, Symbol);
|
||||
Result := TAuraFileStream<TAuraAskBidFileItem>.Create(Self, Symbol);
|
||||
end;
|
||||
|
||||
function TAuraTABFileServer.LoadDataSeries(const InitialFile: TAuraDataFile): TFuture<TArray<TDataPoint<TAskBidItem>>>;
|
||||
function TAuraTABFileServer.LoadDataSeries(const InitialFile: TAuraDataFile): TFuture<TArray<TDataPoint<TAuraAskBidFileItem>>>;
|
||||
var
|
||||
loadedState: TState;
|
||||
loadedFiles: TArray<TFuture<TArray<TDataPoint<TAskBidItem>>>>;
|
||||
liveData: TFuture<TArray<TDataPoint<TAskBidItem>>>;
|
||||
loadedFiles: TArray<TFuture<TArray<TDataPoint<TAuraAskBidFileItem>>>>;
|
||||
liveData: TFuture<TArray<TDataPoint<TAuraAskBidFileItem>>>;
|
||||
tabFiles: TList<TAuraDataFile>;
|
||||
liveFile: TAuraDataFile;
|
||||
currentFileInfo: TAuraDataFile;
|
||||
@@ -607,7 +615,7 @@ begin
|
||||
liveFile := ParseFileName(potentialLivePath);
|
||||
end;
|
||||
|
||||
var loadedFileList := TList<TFuture<TArray<TDataPoint<TAskBidItem>>>>.Create;
|
||||
var loadedFileList := TList<TFuture<TArray<TDataPoint<TAuraAskBidFileItem>>>>.Create;
|
||||
var loadStates := TList<TState>.Create;
|
||||
try
|
||||
for var fileInfo in tabFiles do
|
||||
@@ -617,7 +625,7 @@ begin
|
||||
loadStates.Add(data.Done);
|
||||
end;
|
||||
|
||||
liveData := TFuture<TArray<TDataPoint<TAskBidItem>>>.Null;
|
||||
liveData := TFuture<TArray<TDataPoint<TAuraAskBidFileItem>>>.Null;
|
||||
if liveFile.IsValid then
|
||||
begin
|
||||
liveData := LoadDataFile(liveFile);
|
||||
@@ -636,11 +644,11 @@ begin
|
||||
end;
|
||||
|
||||
Result :=
|
||||
TFuture<TArray<TDataPoint<TAskBidItem>>>.Construct(
|
||||
TFuture<TArray<TDataPoint<TAuraAskBidFileItem>>>.Construct(
|
||||
loadedState,
|
||||
function: TArray<TDataPoint<TAskBidItem>>
|
||||
function: TArray<TDataPoint<TAuraAskBidFileItem>>
|
||||
begin
|
||||
var tickList := TList<TDataPoint<TAskBidItem>>.Create;
|
||||
var tickList := TList<TDataPoint<TAuraAskBidFileItem>>.Create;
|
||||
try
|
||||
var overallLastTabTickTime: TDateTime := 0;
|
||||
var cnt := 0;
|
||||
@@ -710,7 +718,7 @@ begin
|
||||
Result := TAuraDataFile.Create(path, symbol, fileExt, year, month);
|
||||
end;
|
||||
|
||||
class function TAuraTABFileServer.ReadCompressedData(const InputStream: TStream): TArray<TDataPoint<TAskBidItem>>;
|
||||
class function TAuraTABFileServer.ReadCompressedData(const InputStream: TStream): TArray<TDataPoint<TAuraAskBidFileItem>>;
|
||||
var
|
||||
decompressionStream: TStream;
|
||||
localHeader: TZipHeader;
|
||||
@@ -749,11 +757,11 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TAuraTABFileServer.ReadUncompressedData(const InputStream: TStream): TArray<TDataPoint<TAskBidItem>>;
|
||||
class function TAuraTABFileServer.ReadUncompressedData(const InputStream: TStream): TArray<TDataPoint<TAuraAskBidFileItem>>;
|
||||
type
|
||||
TFileRecord = packed record
|
||||
TimeStamp: TDateTime;
|
||||
Data: TAskBidItem;
|
||||
Data: TAuraAskBidFileItem;
|
||||
end;
|
||||
var
|
||||
fileSize: Int64;
|
||||
|
||||
@@ -74,8 +74,8 @@ end;
|
||||
|
||||
procedure TMycTestNotifierTests.Setup;
|
||||
begin
|
||||
FNotifier.Create;
|
||||
// FNotifier's internal FFirst is now 1 (unlocked, not finalized)
|
||||
FNotifier := Default(TMycNotifyList<IMyTestInterface>);
|
||||
end;
|
||||
|
||||
procedure TMycTestNotifierTests.TearDown;
|
||||
@@ -92,7 +92,7 @@ procedure TMycTestNotifierTests.Test01_DestroyExecutesWithoutErrors;
|
||||
begin
|
||||
// This call is expected to succeed without raising EAssertionFailed or other exceptions
|
||||
// if TMycNotifyList.Destroy is implemented correctly.
|
||||
FNotifier.Destroy;
|
||||
FNotifier.Finalize;
|
||||
Assert.IsTrue(True, 'FNotifier.Destroy completed without raising an exception.');
|
||||
end;
|
||||
|
||||
@@ -102,11 +102,11 @@ end;
|
||||
procedure TMycTestNotifierTests.Test02_NotifyOnFinalizedLockedEmptyListExecutesWithoutErrors;
|
||||
var
|
||||
predicateCallCount: Integer;
|
||||
dummyPredicate: TPredicate<IMyTestInterface>;
|
||||
dummyPredicate: TMycNotifyList<IMyTestInterface>.TNotifyProc;
|
||||
begin
|
||||
predicateCallCount := 0;
|
||||
dummyPredicate :=
|
||||
function(Item: IMyTestInterface): Boolean
|
||||
function(const Item: IMyTestInterface): Boolean
|
||||
begin
|
||||
Inc(predicateCallCount);
|
||||
Result := True;
|
||||
@@ -209,7 +209,7 @@ begin
|
||||
|
||||
itemsProcessedCount := 0;
|
||||
FNotifier.Notify(
|
||||
function(Item: IMyTestInterface): Boolean
|
||||
function(const Item: IMyTestInterface): Boolean
|
||||
begin
|
||||
Inc(itemsProcessedCount);
|
||||
TMyTestReceiver(Item).Foo;
|
||||
@@ -229,7 +229,7 @@ begin
|
||||
itemsProcessedCount := 0;
|
||||
|
||||
FNotifier.Notify(
|
||||
function(Item: IMyTestInterface): Boolean
|
||||
function(const Item: IMyTestInterface): Boolean
|
||||
begin
|
||||
Inc(itemsProcessedCount);
|
||||
TMyTestReceiver(Item).Foo;
|
||||
|
||||
@@ -213,7 +213,7 @@ begin
|
||||
// if not FOwnerFixture.FNotifier.IsFinalized then // Don't notify if finalized
|
||||
begin
|
||||
FOwnerFixture.FNotifier.Notify(
|
||||
function(Item: IMyStressTestInterface): Boolean
|
||||
function(const Item: IMyStressTestInterface): Boolean
|
||||
begin
|
||||
Item.Foo(FThreadID); // Pass ThreadID as notification type for context
|
||||
Result := True; // Keep item
|
||||
@@ -255,7 +255,6 @@ end;
|
||||
procedure TMycNotifierChaosStressTests.Setup;
|
||||
begin
|
||||
Randomize; // Initialize random number generator
|
||||
FNotifier.Create;
|
||||
FAllReceiversCreated := TList<IMyStressTestInterface>.Create;
|
||||
FCriticalSectionForList := TCriticalSection.Create;
|
||||
FNextReceiverInstanceID := 0;
|
||||
@@ -359,7 +358,7 @@ begin
|
||||
// if not FNotifier.IsFinalized then
|
||||
begin
|
||||
FNotifier.Notify(
|
||||
function(Item: IMyStressTestInterface): Boolean
|
||||
function(const Item: IMyStressTestInterface): Boolean
|
||||
begin
|
||||
actualLiveReceiversInNotifier.Add(Item);
|
||||
Result := True;
|
||||
|
||||
@@ -154,7 +154,6 @@ end;
|
||||
procedure TMycNotifierThreadingTests.Setup;
|
||||
begin
|
||||
Randomize;
|
||||
FNotifier.Create;
|
||||
FReceiverMasterList := TList<IMyTestInterface>.Create;
|
||||
end;
|
||||
|
||||
@@ -256,7 +255,7 @@ begin
|
||||
FNotifier.Lock;
|
||||
try
|
||||
FNotifier.Notify(
|
||||
function(Item: IMyTestInterface): Boolean
|
||||
function(const Item: IMyTestInterface): Boolean
|
||||
begin
|
||||
Inc(currentNotifyCount);
|
||||
Result := True; // Keep item in the Notifier
|
||||
@@ -288,7 +287,7 @@ begin
|
||||
FNotifier.Lock;
|
||||
try
|
||||
FNotifier.Notify(
|
||||
function(Item: IMyTestInterface): Boolean
|
||||
function(const Item: IMyTestInterface): Boolean
|
||||
begin
|
||||
Inc(currentNotifyCount);
|
||||
Result := True;
|
||||
|
||||
Reference in New Issue
Block a user