Chart Control V1
This commit is contained in:
Michael Schimmel
+134
-65
@@ -5,145 +5,214 @@ interface
|
||||
uses
|
||||
System.Classes,
|
||||
System.SysUtils,
|
||||
System.Generics.Collections,
|
||||
System.Diagnostics,
|
||||
System.Messaging,
|
||||
Myc.Signals;
|
||||
|
||||
type
|
||||
TSignalComponentHelper = class helper for TComponent
|
||||
type
|
||||
TMsgProc = reference to procedure(out IsDone: Boolean);
|
||||
|
||||
TSignalSubscription = class(TComponent, TSignal.ISubscriber)
|
||||
private
|
||||
FSignal: TSignal;
|
||||
FSigSubscr: TSignal.TSubscription;
|
||||
FProc: TMsgProc;
|
||||
FNotified: Integer;
|
||||
FIdleSubscrId: TMessageSubscriptionId;
|
||||
class var
|
||||
FQueued: Integer;
|
||||
FCount: Integer;
|
||||
FItems: TList<TSignalSubscription>;
|
||||
FIdx: Integer;
|
||||
class procedure HandleSignals(Timeout: Int64);
|
||||
function Notify: Boolean;
|
||||
public
|
||||
constructor Create(AOwner: TComponent; const ASignal: TSignal; const AProc: TMsgProc); reintroduce;
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
public
|
||||
procedure ProcessSignal(const Signal: TSignal; const Proc: TMsgProc); overload;
|
||||
procedure ProcessSignal(const Signal: TSignal; const Proc: TProc); overload;
|
||||
function ProcessSignal(const Signal: TSignal; const Proc: TMsgProc): TComponent; overload;
|
||||
function ProcessSignal(const Signal: TSignal; const Proc: TProc): TComponent; overload;
|
||||
end;
|
||||
|
||||
TSignalSyncHelper = record helper for TSignal
|
||||
function Queue(const Proc: TProc; Delay: Integer = 0): TSignal.TSubscription; overload;
|
||||
function Queue(Thread: TThread; const Proc: TProc; Delay: Integer = 0): TSignal.TSubscription; overload;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
System.Diagnostics,
|
||||
System.Messaging,
|
||||
FMX.Types;
|
||||
|
||||
{ TSignalComponentHelper.TSignalSubscription }
|
||||
type
|
||||
TSignalSubscriber = class(TComponent, TSignal.ISubscriber)
|
||||
private
|
||||
FSignal: TSignal;
|
||||
FSigSubscr: TSignal.TSubscription;
|
||||
FProc: TSignalComponentHelper.TMsgProc;
|
||||
FNotified: Integer;
|
||||
FIdleSubscrId: TMessageSubscriptionId;
|
||||
FNext, FPrev: TSignalSubscriber;
|
||||
class var
|
||||
FQueued: Integer;
|
||||
FCount: Integer;
|
||||
FFirst: TSignalSubscriber;
|
||||
FCurr: TSignalSubscriber;
|
||||
class procedure HandleSignals(Timeout: Int64);
|
||||
public
|
||||
constructor Create(AOwner: TComponent; const ASignal: TSignal; const AProc: TSignalComponentHelper.TMsgProc); reintroduce;
|
||||
destructor Destroy; override;
|
||||
procedure AfterConstruction; override;
|
||||
procedure BeforeDestruction; override;
|
||||
function Notify: Boolean;
|
||||
end;
|
||||
|
||||
constructor TSignalComponentHelper.TSignalSubscription.Create(AOwner: TComponent; const ASignal: TSignal; const AProc: TMsgProc);
|
||||
TSyncSubscriber = class(TInterfacedObject, TSignal.ISubscriber)
|
||||
Thread: TThread;
|
||||
Delay: Integer;
|
||||
Timestamp: Int64;
|
||||
Proc: TProc;
|
||||
class var
|
||||
Timer: TStopwatch;
|
||||
function Notify: Boolean;
|
||||
class constructor CreateClass;
|
||||
end;
|
||||
|
||||
class constructor TSyncSubscriber.CreateClass;
|
||||
begin
|
||||
Timer := TStopwatch.StartNew;
|
||||
end;
|
||||
|
||||
function TSyncSubscriber.Notify: Boolean;
|
||||
begin
|
||||
if Assigned(Proc) then
|
||||
begin
|
||||
var cProc := Proc;
|
||||
Proc := nil;
|
||||
TThread.ForceQueue(Thread, procedure begin cProc() end, Delay - (Timer.ElapsedMilliseconds - Timestamp));
|
||||
end;
|
||||
Result := false;
|
||||
end;
|
||||
|
||||
{ TSignalSubscription }
|
||||
|
||||
constructor TSignalSubscriber.Create(AOwner: TComponent; const ASignal: TSignal; const AProc: TSignalComponentHelper.TMsgProc);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FSignal := ASignal;
|
||||
FProc := AProc;
|
||||
FIdx := 0;
|
||||
|
||||
if FItems = nil then
|
||||
if FFirst = nil then
|
||||
begin
|
||||
FItems := TList<TSignalSubscription>.Create;
|
||||
FIdleSubscrId :=
|
||||
TMessageManager
|
||||
.DefaultManager
|
||||
.SubscribeToMessage(TIdleMessage, procedure(const Sender: TObject; const M: TMessage) begin HandleSignals(50); end);
|
||||
end;
|
||||
FItems.Add(Self);
|
||||
|
||||
FPrev := nil;
|
||||
if FFirst <> nil then
|
||||
FNext := FFirst;
|
||||
if FNext <> nil then
|
||||
FNext.FPrev := Self;
|
||||
FFirst := Self;
|
||||
|
||||
FSigSubscr := FSignal.Subscribe(Self);
|
||||
end;
|
||||
|
||||
destructor TSignalComponentHelper.TSignalSubscription.Destroy;
|
||||
destructor TSignalSubscriber.Destroy;
|
||||
begin
|
||||
FSigSubscr.Unsubscribe;
|
||||
|
||||
FItems.Remove(Self);
|
||||
if FItems.Count = 0 then
|
||||
if FFirst = Self then
|
||||
FFirst := FNext;
|
||||
if FNext <> nil then
|
||||
FNext.FPrev := FPrev;
|
||||
if FPrev <> nil then
|
||||
FPrev.FNext := FNext;
|
||||
|
||||
if FFirst = nil then
|
||||
begin
|
||||
TMessageManager.DefaultManager.Unsubscribe(TIdleMessage, FIdleSubscrId);
|
||||
FreeAndNil(FItems);
|
||||
end;
|
||||
|
||||
inherited;
|
||||
end;
|
||||
|
||||
class procedure TSignalComponentHelper.TSignalSubscription.HandleSignals(Timeout: Int64);
|
||||
procedure TSignalSubscriber.AfterConstruction;
|
||||
begin
|
||||
inherited;
|
||||
Notify;
|
||||
end;
|
||||
|
||||
procedure TSignalSubscriber.BeforeDestruction;
|
||||
begin
|
||||
FSigSubscr.Unsubscribe;
|
||||
if FCurr = Self then
|
||||
FCurr := FCurr.FNext;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
class procedure TSignalSubscriber.HandleSignals(Timeout: Int64);
|
||||
begin
|
||||
if AtomicExchange(FQueued, 0) = 0 then
|
||||
exit;
|
||||
|
||||
var Stopwatch := TStopwatch.StartNew;
|
||||
var doBreak := false;
|
||||
|
||||
if (FIdx = 0) or (FIdx > FItems.Count) then
|
||||
FIdx := FItems.Count;
|
||||
if FCurr = nil then
|
||||
FCurr := FFirst;
|
||||
|
||||
while FIdx > 0 do
|
||||
while FCurr <> nil do
|
||||
begin
|
||||
dec(FIdx);
|
||||
var sub := FItems[FIdx];
|
||||
var sub := FCurr;
|
||||
FCurr := sub.FNext;
|
||||
|
||||
if AtomicExchange(sub.FNotified, 0) = 1 then
|
||||
begin
|
||||
var done := false;
|
||||
try
|
||||
sub.FProc(done);
|
||||
finally
|
||||
if done then
|
||||
sub.Free;
|
||||
if not (csDestroying in sub.ComponentState) then
|
||||
begin
|
||||
var done := false;
|
||||
try
|
||||
sub.FProc(done);
|
||||
finally
|
||||
if done then
|
||||
sub.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
if AtomicDecrement(FCount) = 1 then
|
||||
break;
|
||||
doBreak := AtomicDecrement(FCount) = 1;
|
||||
end;
|
||||
|
||||
if Stopwatch.ElapsedMilliseconds > Timeout then
|
||||
doBreak := doBreak or (Stopwatch.ElapsedMilliseconds > Timeout);
|
||||
|
||||
if doBreak then
|
||||
begin
|
||||
AtomicExchange(FQueued, 1);
|
||||
break;
|
||||
end;
|
||||
|
||||
if FIdx = 0 then
|
||||
FIdx := FItems.Count;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TSignalComponentHelper.TSignalSubscription.Notify: Boolean;
|
||||
function TSignalSubscriber.Notify: Boolean;
|
||||
begin
|
||||
if AtomicExchange(FNotified, 1) = 0 then
|
||||
AtomicIncrement(FCount);
|
||||
AtomicExchange(FQueued, 1);
|
||||
|
||||
// if AtomicExchange(FQueued, 1) = 0 then
|
||||
// TThread.Queue( nil,
|
||||
// procedure
|
||||
// begin
|
||||
// if AtomicExchange(FQueued, 0) = 1 then
|
||||
// HandleSignals( 40 );
|
||||
// end);
|
||||
Result := true;
|
||||
end;
|
||||
|
||||
procedure TSignalComponentHelper.ProcessSignal(const Signal: TSignal; const Proc: TProc);
|
||||
function TSignalComponentHelper.ProcessSignal(const Signal: TSignal; const Proc: TProc): TComponent;
|
||||
begin
|
||||
var cProc: TProc := Proc;
|
||||
TSignalSubscription.Create(Self, Signal, procedure(out IsDone: Boolean) begin cProc(); end);
|
||||
Result := ProcessSignal(Signal, procedure(out IsDone: Boolean) begin cProc(); end);
|
||||
end;
|
||||
|
||||
procedure TSignalComponentHelper.ProcessSignal(const Signal: TSignal; const Proc: TMsgProc);
|
||||
function TSignalComponentHelper.ProcessSignal(const Signal: TSignal; const Proc: TMsgProc): TComponent;
|
||||
begin
|
||||
TSignalSubscription.Create(Self, Signal, Proc);
|
||||
Result := TSignalSubscriber.Create(Self, Signal, Proc);
|
||||
end;
|
||||
|
||||
{ TSignalSyncHelper }
|
||||
|
||||
function TSignalSyncHelper.Queue(const Proc: TProc; Delay: Integer = 0): TSignal.TSubscription;
|
||||
begin
|
||||
Result := Queue(nil, Proc, Delay);
|
||||
end;
|
||||
|
||||
function TSignalSyncHelper.Queue(Thread: TThread; const Proc: TProc; Delay: Integer = 0): TSignal.TSubscription;
|
||||
begin
|
||||
var Subscr := TSyncSubscriber.Create;
|
||||
Subscr.Thread := Thread;
|
||||
Subscr.Proc := Proc;
|
||||
Subscr.Delay := Delay;
|
||||
Subscr.Timestamp := TSyncSubscriber.Timer.ElapsedMilliseconds;
|
||||
Result := Subscribe(Subscr);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Reference in New Issue
Block a user