From 35413f5966dd49a1392ae49f544a82ecb2431b8d Mon Sep 17 00:00:00 2001 From: Michael Schimmel Date: Tue, 24 Jun 2025 14:37:38 +0200 Subject: [PATCH] GUI Signals --- AuraTrader/MainForm.pas | 126 +++++++++++++++---------------- Src/Myc.Core.Notifier.pas | 3 +- Src/Myc.Core.Signals.pas | 9 --- Src/Myc.Signals.FMX.pas | 75 +++++++++--------- Src/Myc.Trade.Core.DataPoint.pas | 8 +- 5 files changed, 105 insertions(+), 116 deletions(-) diff --git a/AuraTrader/MainForm.pas b/AuraTrader/MainForm.pas index 114f3f0..fbba2ba 100644 --- a/AuraTrader/MainForm.pas +++ b/AuraTrader/MainForm.pas @@ -61,8 +61,6 @@ type FOnEvent: TNotifyEvent; { Private declarations } FServer: IDataServer; - FSymbolsValid: TFMXValidationState; - FStreamUpdate: TFMXValidationState; FSymbols: TFuture>; FRandom: TList; public @@ -89,63 +87,61 @@ begin FSymbols := FServer.EnumerateSymbols; - FSymbolsValid := - TFMXValidationState.Create( - SymbolsComboBox, - FSymbols.Done.Signal, - procedure - begin - SymbolsComboBox.BeginUpdate; - try - SymbolsComboBox.Items.Clear; - SymbolsComboBox.Items.AddStrings(FSymbols.WaitFor); - if SymbolsComboBox.Items.Count > 0 then - begin - if SymbolsComboBox.ItemIndex < 0 then - SymbolsComboBox.ItemIndex := SymbolsComboBox.Items.IndexOf('GER40'); - SymbolsComboBox.Enabled := true; - end; - finally - SymbolsComboBox.EndUpdate; + SymbolsComboBox.AddIdleHandler( + FSymbols.Done.Signal, + procedure + begin + SymbolsComboBox.BeginUpdate; + try + SymbolsComboBox.Items.Clear; + SymbolsComboBox.Items.AddStrings(FSymbols.WaitFor); + if SymbolsComboBox.Items.Count > 0 then + begin + if SymbolsComboBox.ItemIndex < 0 then + SymbolsComboBox.ItemIndex := SymbolsComboBox.Items.IndexOf('GER40'); + SymbolsComboBox.Enabled := true; end; - end - ); + finally + SymbolsComboBox.EndUpdate; + end; + end + ); end; procedure TForm1.FormDestroy(Sender: TObject); begin Application.OnIdle := nil; - FSymbolsValid.Free; FRandom.Free; end; procedure TForm1.LoadButtonClick(Sender: TObject); begin - var Stream := FServer.CreateStream(FSymbols.WaitFor[SymbolsComboBox.ItemIndex]); - var Data := TDataStreamProvider.Create(3000, 1000, Stream); - var Idx := 0; - FStreamUpdate := - TFMXValidationState.Create( - Path1, - Data.Changed, - procedure - begin - var Prices := Data.Value; + if SymbolsComboBox.ItemIndex < 0 then + exit; - if Prices.Count > 0 then - begin - Path1.BeginUpdate; - try - Path1.Data.Clear; - Path1.Data.MoveTo(PointF(Path1.Width-1, Prices[0].Data.Ask)); - for var i := 1 to Prices.Count - 1 do - Path1.Data.LineTo(PointF(Path1.Width-i-1, Prices[i].Data.Ask)); - finally - Path1.EndUpdate; - end; + var Stream := FServer.CreateStream(FSymbols.WaitFor[SymbolsComboBox.ItemIndex]); + var Data := TDataStreamProvider.Create(30000, 10000, Stream); + + Path1.AddIdleHandler( + Data.Changed, + procedure + begin + var Prices := Data.Value; + + if Prices.Count > 0 then + begin + Path1.BeginUpdate; + try + Path1.Data.Clear; + Path1.Data.MoveTo(PointF(Path1.Width - 1, Prices[0].Data.Ask)); + for var i := 1 to Prices.Count - 1 do + Path1.Data.LineTo(PointF(Path1.Width - i - 1, Prices[i].Data.Ask)); + finally + Path1.EndUpdate; end; - end - ); + end; + end + ); end; procedure TForm1.RandomButtonClick(Sender: TObject); @@ -167,26 +163,26 @@ begin var Proc := procedure(idx: Integer) begin - TFMXValidationState.Create( - FRandom[idx].Labl, - FRandom[idx].Data.Changed, - procedure - begin - var data := FRandom[idx].Data.Value; - if data.Count > 0 then + FRandom[idx] + .Labl + .AddIdleHandler( + FRandom[idx].Data.Changed, + procedure begin - var dp := data[0]; - FRandom[idx].Labl.Text := - FRandom[idx].Stream.Symbol - + ' ' - + dp.Time.ToString - + ' ' - + data.TotalCount.ToString - + ' ' - + dp.Data.Ask.ToString; - end; - end - ); + var data := FRandom[idx].Data.Value; + if data.Count > 0 then + begin + var dp := data[0]; + FRandom[idx].Labl.Text := + FRandom[idx].Stream.Symbol + + ' ' + + dp.Time.ToString + + ' ' + + data.TotalCount.ToString + + ' ' + + dp.Data.Ask.ToString; + end; + end); end; Proc(FRandom.Count - 1); end; diff --git a/Src/Myc.Core.Notifier.pas b/Src/Myc.Core.Notifier.pas index 17e79ae..5d5e001 100644 --- a/Src/Myc.Core.Notifier.pas +++ b/Src/Myc.Core.Notifier.pas @@ -26,7 +26,8 @@ type 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). - [volatile] FList: PItem; + [volatile] + FList: PItem; // Allocates memory for a new TItem. class function AllocItem: PItem; static; inline; diff --git a/Src/Myc.Core.Signals.pas b/Src/Myc.Core.Signals.pas index 87021ef..f12a65c 100644 --- a/Src/Myc.Core.Signals.pas +++ b/Src/Myc.Core.Signals.pas @@ -108,9 +108,6 @@ type constructor Create(AInit: Boolean); destructor Destroy; override; - // Factory method to create a new TMycFlag instance. - class function CreateDirty: TFlag.IFlag; static; - function Subscribe(Subscriber: TSignal.ISubscriber): Pointer; procedure Unsubscribe(Tag: Pointer); @@ -402,12 +399,6 @@ begin FSubscribers.Create; end; -class function TMycFlag.CreateDirty: TFlag.IFlag; -begin - // Factory method to create a new TMycFlag instance. - Result := TMycFlag.Create(true); -end; - destructor TMycFlag.Destroy; begin FSubscribers.Destroy; // Clean up the subscriber list. diff --git a/Src/Myc.Signals.FMX.pas b/Src/Myc.Signals.FMX.pas index 8f088c0..1a51dad 100644 --- a/Src/Myc.Signals.FMX.pas +++ b/Src/Myc.Signals.FMX.pas @@ -6,73 +6,74 @@ uses System.Classes, System.SysUtils, System.Messaging, - FMX.Controls, Myc.Signals; type - TFMXValidationState = class(TComponent) + TMsgProc = reference to procedure( const Sender: TObject; const M: TMessage ); + + TComponentValidation = class(TComponent) private - [volatile] - FSignal: TSignal; - FInvalidated: TFlag; - FSubscription: TSignal.TSubscription; - FProc: TProc; - FIdleSubsription: TMessageSubscriptionId; - procedure DoIdle(const Sender: TObject; const M: TMessage); - protected - function Notify: Boolean; + FReceived: TFlag; + FProc: TMsgProc; + FSubscription: TMessageSubscriptionId; + FMsgClass: TClass; + procedure DoMsg(const Sender: TObject; const M: TMessage); public - constructor Create(AOwner: TControl; const ASignal: TSignal; const AProc: TProc); reintroduce; + constructor Create(AOwner: TComponent; const AMsgClass: TClass; const ASignal: TSignal; const AProc: TMsgProc); reintroduce; destructor Destroy; override; - procedure AfterConstruction; override; - procedure BeforeDestruction; override; + end; + + TComponentValidationHelper = class helper for TComponent + procedure AddMsgHandler(const MsgClass: TClass; const Signal: TSignal; const Proc: TMsgProc); + procedure AddIdleHandler(const Signal: TSignal; const Proc: TProc); end; implementation uses - System.SyncObjs, - FMX.Types; + {$IFDEF FRAMEWORK_FMX} + FMX.Types + {$ELSE} + VCL.Types // to be checked + {$IFEND}; -{ TFMXValidationState } +{ TComponentValidation } -constructor TFMXValidationState.Create(AOwner: TControl; const ASignal: TSignal; const AProc: TProc); +constructor TComponentValidation.Create(AOwner: TComponent; const AMsgClass: TClass; const ASignal: TSignal; const AProc: TMsgProc); begin inherited Create(AOwner); - FSignal := ASignal; - FInvalidated := TFlag.CreateFlag; + FMsgClass := AMsgClass; FProc := AProc; + FReceived := TFlag.CreateObserver(ASignal); + FSubscription := TMessageManager.DefaultManager.SubscribeToMessage(FMsgClass, DoMsg); end; -destructor TFMXValidationState.Destroy; +destructor TComponentValidation.Destroy; begin + TMessageManager.DefaultManager.Unsubscribe(FMsgClass, FSubscription); inherited; end; -procedure TFMXValidationState.AfterConstruction; +procedure TComponentValidation.DoMsg(const Sender: TObject; const M: TMessage); begin - inherited; - FSubscription := FSignal.Subscribe(FInvalidated); - FIdleSubsription := TMessageManager.DefaultManager.SubscribeToMessage(TIdleMessage, DoIdle); + if FReceived.Reset then + FProc( Sender, M ); end; -procedure TFMXValidationState.BeforeDestruction; +procedure TComponentValidationHelper.AddIdleHandler(const Signal: TSignal; const Proc: TProc); begin - TMessageManager.DefaultManager.Unsubscribe(TIdleMessage, FIdleSubsription); - FSubscription.Unsubscribe; - inherited; + var capProc := Proc; + AddMsgHandler(TIdleMessage, Signal, + procedure( const Sender: TObject; const M: TMessage ) + begin + capProc(); + end ); end; -procedure TFMXValidationState.DoIdle(const Sender: TObject; const M: TMessage); +procedure TComponentValidationHelper.AddMsgHandler(const MsgClass: TClass; const Signal: TSignal; const Proc: TMsgProc); begin - if FInvalidated.Reset then - FProc; -end; - -function TFMXValidationState.Notify: Boolean; -begin - Result := FInvalidated.Notify; + TComponentValidation.Create(Self, MsgClass, Signal, Proc); end; end. diff --git a/Src/Myc.Trade.Core.DataPoint.pas b/Src/Myc.Trade.Core.DataPoint.pas index e8b8116..b5c239e 100644 --- a/Src/Myc.Trade.Core.DataPoint.pas +++ b/Src/Myc.Trade.Core.DataPoint.pas @@ -14,7 +14,7 @@ type TChunk = TArray>; private FChunks: TArray; - FChunks1: TArray; + FChunks1: TArray; FCount: Int64; FMaxLookback: Int64; FTotalCount: Int64; @@ -40,8 +40,8 @@ type // Null object implementation for IDataSeries TNullDataSeries = class(TInterfacedObject, IDataSeries) strict private - class var - FNull: IDataSeries; + class var + FNull: IDataSeries; private class constructor CreateClass; public @@ -173,7 +173,7 @@ end; function TDataArray.Copy: IDataSeries; begin - Result := TStaticDataSeries.Create( FChunks, FCount, FMaxLookback, FTotalCount ); + Result := TStaticDataSeries.Create(FChunks, FCount, FMaxLookback, FTotalCount); end; function TDataArray.GetCount: Int64;