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

GUI Signals

Browse Source
This commit is contained in:
Michael Schimmel
2025-06-24 14:37:38 +02:00
parent 3048c28fe3
commit 35413f5966
5 changed files with 105 additions and 116 deletions
Download Patch File Download Diff File Expand all files Collapse all files
AuraTrader/MainForm.pas
+61 -65
View File
@@ -61,8 +61,6 @@ type
FOnEvent: TNotifyEvent;
{ Private declarations }
FServer: IDataServer<TAskBidItem>;
FSymbolsValid: TFMXValidationState;
FStreamUpdate: TFMXValidationState;
FSymbols: TFuture<TArray<String>>;
FRandom: TList<TRndItem>;
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<TAskBidItem>(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<TAskBidItem>(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;
Src/Myc.Core.Notifier.pas
+2 -1
View File
@@ -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;
Src/Myc.Core.Signals.pas
-9
View File
@@ -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.
Src/Myc.Signals.FMX.pas
+38 -37
View File
@@ -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.
Src/Myc.Trade.Core.DataPoint.pas
+4 -4
View File
@@ -14,7 +14,7 @@ type
TChunk = TArray<TDataPoint<T>>;
private
FChunks: TArray<TChunk>;
FChunks1: TArray<TChunk>;
FChunks1: TArray<TChunk>;
FCount: Int64;
FMaxLookback: Int64;
FTotalCount: Int64;
@@ -40,8 +40,8 @@ type
// Null object implementation for IDataSeries<T>
TNullDataSeries<T> = class(TInterfacedObject, IDataSeries<T>)
strict private
class var
FNull: IDataSeries<T>;
class var
FNull: IDataSeries<T>;
private
class constructor CreateClass;
public
@@ -173,7 +173,7 @@ end;
function TDataArray<T>.Copy: IDataSeries<T>;
begin
Result := TStaticDataSeries<T>.Create( FChunks, FCount, FMaxLookback, FTotalCount );
Result := TStaticDataSeries<T>.Create(FChunks, FCount, FMaxLookback, FTotalCount);
end;
function TDataArray<T>.GetCount: Int64;