Process.Update for synchronization

This commit is contained in:
Michael Schimmel
2025-07-12 12:11:16 +02:00
parent cf17e06e32
commit 4727db1a01
5 changed files with 89 additions and 92 deletions
+50 -50
View File
@@ -12,45 +12,45 @@ object Form1: TForm1
DesignerMasterStyle = 0
object MainPanel: TPanel
Align = Client
Size.Width = 796.00000000000000000
Size.Height = 712.00000000000000000
Size.Width = 796.000000000000000000
Size.Height = 712.000000000000000000
Size.PlatformDefault = False
TabOrder = 2
object Splitter1: TSplitter
Align = Left
Cursor = crHSplit
MinSize = 20.00000000000000000
Position.X = 169.00000000000000000
Size.Width = 8.00000000000000000
Size.Height = 712.00000000000000000
MinSize = 20.000000000000000000
Position.X = 169.000000000000000000
Size.Width = 8.000000000000000000
Size.Height = 712.000000000000000000
Size.PlatformDefault = False
end
object WorkspacePanel: TPanel
Align = Client
Size.Width = 619.00000000000000000
Size.Height = 712.00000000000000000
Size.Width = 619.000000000000000000
Size.Height = 712.000000000000000000
Size.PlatformDefault = False
TabOrder = 3
object TabControl: TTabControl
Align = Client
Size.Width = 619.00000000000000000
Size.Height = 672.00000000000000000
Size.Width = 619.000000000000000000
Size.Height = 672.000000000000000000
Size.PlatformDefault = False
TabIndex = 0
TabOrder = 10
TabPosition = PlatformDefault
end
object ToolBar: TToolBar
Size.Width = 619.00000000000000000
Size.Height = 40.00000000000000000
Size.Width = 619.000000000000000000
Size.Height = 40.000000000000000000
Size.PlatformDefault = False
TabOrder = 3
object AddWorkspaceButton: TSpeedButton
Action = AddWorkspaceAction
Align = FitLeft
ImageIndex = -1
Size.Width = 145.45458984375000000
Size.Height = 40.00000000000000000
Size.Width = 145.454589843750000000
Size.Height = 40.000000000000000000
Size.PlatformDefault = False
Text = 'Add'
TextSettings.Trimming = None
@@ -59,20 +59,20 @@ object Form1: TForm1
Action = TestAction
Align = FitLeft
ImageIndex = -1
Position.X = 145.45458984375000000
Size.Width = 145.45454406738280000
Size.Height = 40.00000000000000000
Position.X = 145.454589843750000000
Size.Width = 145.454544067382800000
Size.Height = 40.000000000000000000
Size.PlatformDefault = False
TextSettings.Trimming = None
object TestPopup: TPopup
PlacementTarget = TestButton
Size.Width = 400.00000000000000000
Size.Height = 400.00000000000000000
Size.Width = 400.000000000000000000
Size.Height = 400.000000000000000000
Size.PlatformDefault = False
TabOrder = 7
object FlowLayout: TFlowLayout
Position.X = 224.00000000000000000
Position.Y = 167.00000000000000000
Position.X = 224.000000000000000000
Position.Y = 167.000000000000000000
TabOrder = 4
Justify = Left
JustifyLastLine = Left
@@ -84,9 +84,9 @@ object Form1: TForm1
end
object LoadButton: TButton
Anchors = [akTop, akRight]
Position.Y = 19.00000000000000000
Size.Width = 47.00000000000000000
Size.Height = 22.00000000000000000
Position.Y = 19.000000000000000000
Size.Width = 47.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 5
Text = 'Load'
@@ -95,7 +95,7 @@ object Form1: TForm1
end
object RandomButton: TButton
Anchors = [akTop, akRight]
Position.Y = 41.00000000000000000
Position.Y = 41.000000000000000000
TabOrder = 2
Text = 'Random'
TextSettings.Trimming = None
@@ -103,7 +103,7 @@ object Form1: TForm1
end
object StopButton: TButton
Anchors = [akTop, akRight]
Position.Y = 63.00000000000000000
Position.Y = 63.000000000000000000
TabOrder = 8
Text = 'StopButton'
TextSettings.Trimming = None
@@ -111,7 +111,7 @@ object Form1: TForm1
end
object ChartButton: TButton
Anchors = [akTop, akRight]
Position.Y = 85.00000000000000000
Position.Y = 85.000000000000000000
TabOrder = 7
Text = 'ChartButton'
TextSettings.Trimming = None
@@ -119,9 +119,9 @@ object Form1: TForm1
end
object SymbolsComboBox: TComboBox
Anchors = [akTop, akRight]
Position.Y = 107.00000000000000000
Size.Width = 177.00000000000000000
Size.Height = 22.00000000000000000
Position.Y = 107.000000000000000000
Size.Width = 177.000000000000000000
Size.Height = 22.000000000000000000
Size.PlatformDefault = False
TabOrder = 4
end
@@ -130,9 +130,9 @@ object Form1: TForm1
end
object StrategyButton: TSpeedButton
Align = FitLeft
Position.X = 290.90911865234370000
Size.Width = 145.45446777343750000
Size.Height = 40.00000000000000000
Position.X = 290.909118652343800000
Size.Width = 145.454467773437500000
Size.Height = 40.000000000000000000
Size.PlatformDefault = False
Text = 'Strategy'
TextSettings.Trimming = None
@@ -142,14 +142,14 @@ object Form1: TForm1
end
object ObjectsPanel: TPanel
Align = Left
Size.Width = 169.00000000000000000
Size.Height = 712.00000000000000000
Size.Width = 169.000000000000000000
Size.Height = 712.000000000000000000
Size.PlatformDefault = False
TabOrder = 4
object ObjectsTabControl: TTabControl
Align = Client
Size.Width = 169.00000000000000000
Size.Height = 712.00000000000000000
Size.Width = 169.000000000000000000
Size.Height = 712.000000000000000000
Size.PlatformDefault = False
TabIndex = 0
TabOrder = 0
@@ -163,24 +163,24 @@ object Form1: TForm1
end>
TextSettings.Trimming = None
IsSelected = True
Size.Width = 66.00000000000000000
Size.Height = 26.00000000000000000
Size.Width = 66.000000000000000000
Size.Height = 26.000000000000000000
Size.PlatformDefault = False
StyleLookup = ''
TabOrder = 0
Text = 'Modules'
ExplicitSize.cx = 66.00000000000000000
ExplicitSize.cy = 26.00000000000000000
ExplicitSize.cx = 66.000000000000000000
ExplicitSize.cy = 26.000000000000000000
object TreeView: TTreeView
Align = Client
Size.Width = 169.00000000000000000
Size.Height = 686.00000000000000000
Size.Width = 169.000000000000000000
Size.Height = 686.000000000000000000
Size.PlatformDefault = False
TabOrder = 0
OnDblClick = TreeViewDblClick
AllowDrag = True
Viewport.Width = 165.00000000000000000
Viewport.Height = 682.00000000000000000
Viewport.Width = 165.000000000000000000
Viewport.Height = 682.000000000000000000
end
end
end
@@ -190,13 +190,13 @@ object Form1: TForm1
Touch.InteractiveGestures = [Pan, LongTap, DoubleTap]
DataDetectorTypes = []
Align = Bottom
Position.Y = 712.00000000000000000
Size.Width = 796.00000000000000000
Size.Height = 128.00000000000000000
Position.Y = 712.000000000000000000
Size.Width = 796.000000000000000000
Size.Height = 128.000000000000000000
Size.PlatformDefault = False
TabOrder = 1
Viewport.Width = 792.00000000000000000
Viewport.Height = 124.00000000000000000
Viewport.Width = 792.000000000000000000
Viewport.Height = 124.000000000000000000
end
object ActionList: TActionList
Left = 209
+1 -1
View File
@@ -165,7 +165,7 @@ begin
var chart := TMycChart.Create(Self);
AlignControl( chart );
chart.Height := Layout.ChildrenRect.Width*9/16;
chart.Lookback := 1000;
chart.Lookback.Value := 1000;
/////
+23 -21
View File
@@ -31,18 +31,19 @@ type
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;
procedure Paint(const ACanvas: TCanvas; Lookback: Int64; const AXForm, AYForm: TFunc<Double, Single>); virtual; abstract;
property MainSeries: TSeries read GetMainSeries;
public
constructor Create(AOwner: TMycChart);
property Count: Int64 read GetCount;
property MainSeries: TSeries read GetMainSeries;
property Owner: TMycChart read FOwner;
end;
private
FSeriesList: TList<TSeries>;
FLookback: Integer;
FLookback: TWriteable<Int64>;
FIdleSubscrId: TMessageSubscriptionId;
protected
procedure Paint; override;
@@ -66,8 +67,7 @@ type
const ALineWidth: Single = 1.5
);
// The maximum number of data points to display from the main series.
property Lookback: Integer read FLookback write FLookback;
property Lookback: TWriteable<Int64> read FLookback write FLookback;
end;
implementation
@@ -82,14 +82,14 @@ type
TChartSeriesReceiver<T> = class(TMycProcessor<T>)
strict private
FCurrData: TMycDataArray<T>;
FLookback: Int64;
FLookback: TWriteable<Int64>;
private
FData: TWriteable<TMycDataArray<T>>;
protected
function ProcessData(const Value: T): Boolean; override;
procedure Update; override;
public
constructor Create(ALookback: Int64);
constructor Create(const ALookback: TWriteable<Int64>);
function GetData(var Data: TMycDataArray<T>): Boolean;
property Data: TWriteable<TMycDataArray<T>> read FData;
end;
@@ -121,7 +121,7 @@ type
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;
procedure Paint(const ACanvas: TCanvas; Lookback: Int64; const AXForm, AYForm: TFunc<Double, Single>); override;
public
constructor Create(
AOwner: TMycChart;
@@ -138,7 +138,7 @@ type
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;
procedure Paint(const ACanvas: TCanvas; Lookback: Int64; const AXForm, AYForm: TFunc<Double, Single>); override;
public
constructor Create(
AOwner: TMycChart;
@@ -169,7 +169,8 @@ constructor TMycChart.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FSeriesList := TObjectList<TSeries>.Create(true);
FLookback := 10000;
FLookback := TWriteable<Int64>.CreateWriteable( 100 );
FIdleSubscrId :=
TMessageManager
@@ -231,8 +232,9 @@ var
begin
inherited;
rect := Self.LocalRect;
var lookback := FLookback.Value;
if (FSeriesList.Count = 0) or (FLookback <= 1) then
if (FSeriesList.Count = 0) or (lookback <= 1) then
begin
Canvas.Fill.Color := TAlphaColors.Gray;
Canvas.FillText(rect, 'No Data', false, 1, [], TTextAlign.Center, TTextAlign.Center);
@@ -243,7 +245,7 @@ begin
for series in FSeriesList do
begin
if series.GetValueRange(0, FLookback, seriesMin, seriesMax) then
if series.GetValueRange(0, lookback, seriesMin, seriesMax) then
begin
if not rangeInitialized then
begin
@@ -269,7 +271,7 @@ begin
if (globalMax - globalMin) = 0 then
exit;
xTransform := function(index: Double): Single begin Result := rect.Right - (index / (FLookback - 1)) * rect.Width; end;
xTransform := function(index: Double): Single begin Result := rect.Right - (index / (lookback - 1)) * rect.Width; end;
yTransform :=
function(value: Double): Single begin Result := rect.Top + (1 - (value - globalMin) / (globalMax - globalMin)) * rect.Height; end;
@@ -280,7 +282,7 @@ begin
for series in FSeriesList do
begin
series.Paint(Self.Canvas, xTransform, yTransform);
series.Paint(Self.Canvas, lookback, xTransform, yTransform);
end;
end;
@@ -293,7 +295,7 @@ begin
FDataSeries := TMycDataArray<T>.CreateEmpty;
FData := FDataSeries;
FDataProvider := ADataProvider;
FReceiver := TChartSeriesReceiver<T>.Create(AOwner.Lookback);
FReceiver := TChartSeriesReceiver<T>.Create(AOwner.FLookback);
FReceiverTag := FDataProvider.Link(FReceiver);
end;
@@ -347,7 +349,7 @@ begin
Result := (Min <> MaxDouble);
end;
procedure TChartOhlcSeries.Paint(const ACanvas: TCanvas; const AXForm, AYForm: TFunc<Double, Single>);
procedure TChartOhlcSeries.Paint(const ACanvas: TCanvas; Lookback: Int64; const AXForm, AYForm: TFunc<Double, Single>);
var
i, displayCount: Int64;
x, candleWidth: Single;
@@ -355,7 +357,7 @@ var
item: TDataPoint<TOhlcItem>;
isUp: boolean;
begin
displayCount := System.Math.Min(Data.Count, Owner.Lookback);
displayCount := System.Math.Min(Data.Count, Lookback);
if displayCount <= 0 then
Exit;
@@ -429,14 +431,14 @@ begin
Result := (Min <> MaxDouble);
end;
procedure TChartLineSeries.Paint(const ACanvas: TCanvas; const AXForm, AYForm: TFunc<Double, Single>);
procedure TChartLineSeries.Paint(const ACanvas: TCanvas; Lookback: Int64; 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);
var displayCount := System.Math.Min(Data.Count, Lookback);
if displayCount < 2 then
Exit;
@@ -460,7 +462,7 @@ end;
{ TChartSeriesReceiver<T> }
constructor TChartSeriesReceiver<T>.Create(ALookback: Int64);
constructor TChartSeriesReceiver<T>.Create(const ALookback: TWriteable<Int64>);
begin
inherited Create;
FLookback := ALookback;
@@ -478,7 +480,7 @@ end;
function TChartSeriesReceiver<T>.ProcessData(const Value: T): Boolean;
begin
Result := true;
FCurrData := FCurrData.Add(Value, FLookback);
FCurrData := FCurrData.Add(Value, FLookback.Value);
end;
procedure TChartSeriesReceiver<T>.Update;
+8 -20
View File
@@ -5,6 +5,7 @@ interface
uses
System.Classes,
System.SysUtils,
System.SyncObjs,
Myc.Signals,
Myc.Lazy;
@@ -81,13 +82,11 @@ type
TMycProtectedMutable<T> = class(TInterfacedObject, TMutable<T>.IMutable, TWriteable<T>.IWriteable)
private
FWriteable: TWriteable<T>.IWriteable;
FLock: Integer;
FLock: TLightweightMREW;
protected
function Exchange(const Value: T): T;
function GetChanged: TSignal;
function GetValue: T;
procedure Lock; inline;
procedure Release; inline;
public
constructor Create(const AWriteable: TWriteable<T>.IWriteable);
procedure SetValue(const Value: T);
@@ -243,11 +242,11 @@ end;
function TMycProtectedMutable<T>.Exchange(const Value: T): T;
begin
Lock;
FLock.BeginWrite;
try
Result := FWriteable.Exchange(Value);
finally
Release;
FLock.EndWrite;
end;
end;
@@ -258,32 +257,21 @@ end;
function TMycProtectedMutable<T>.GetValue: T;
begin
Lock;
FLock.BeginRead;
try
Result := FWriteable.Value;
finally
Release;
FLock.EndRead;
end;
end;
procedure TMycProtectedMutable<T>.Lock;
begin
while AtomicExchange(FLock, 1) = 1 do
YieldProcessor;
end;
procedure TMycProtectedMutable<T>.Release;
begin
AtomicExchange(FLock, 0);
end;
procedure TMycProtectedMutable<T>.SetValue(const Value: T);
begin
Lock;
FLock.BeginWrite;
try
FWriteable.SetValue(Value);
finally
Release;
Flock.EndWrite;
end;
end;
+7
View File
@@ -67,6 +67,8 @@ type
function Protect: TWriteable<T>;
function AsMutable: TMutable<T>;
property Value: T read GetValue write SetValue;
property Changed: TSignal read GetChanged;
end;
@@ -211,6 +213,11 @@ begin
Assert(Assigned(FWriteable));
end;
function TWriteable<T>.AsMutable: TMutable<T>;
begin
Result.Create(FWriteable);
end;
class function TWriteable<T>.CreateWriteable: TWriteable<T>;
begin
Result := CreateWriteable(Default(T));