Constrained generisches Ereignis in Delphi

Question

Ich möchte eine Nachricht Bus erstellen, so dass ich einen Verleger schreiben wie folgt:

unit Publisher; 

interface 

type 
    TStuffHasHappenedMessage 
      = class(TMessage) 
       public 
       Text: string; 
       constructor Create(aText: string); 
       end; 

    TSomeClass = class 
       procedure DoStuff; 
       end; 

implementation 

constructor TStuffHasHappenedMessage.Create(aText: string); 
begin 
    Text := aText; 
end; 

procedure TSomeClass.DoStuff; 
begin 
    ... 
    TMessageBus.Notify(Self, TStuffHasHappenedMessage.Create('Some Text')); 
end; 

end. 

und einem Teilnehmer wie folgt:

unit Subscriber; 

interface 

uses 
    Publisher; 

TMyClass = class 
      procedure MyHandler(Sender: TObject; Message: TStuffHasHappenedMessage); 
      constructor Create; 
      end 

constructor TMyClass.Create; 
begin 
    TMessageBus.Subscribe(TStuffHasHappenedMessage, MyHandler); 
end; 

procedure TMyClass.MyHandler(Sender: TObject; Message: TStuffHasHappenedMessage); 
begin 
    ShowMessage(Message.Text) 
end; 

end. 

Ich möchte schließlich vermeiden eine Art Guss in „MyHandler“ durch einen Anruf Lassen „Subcribe“ mit jedem Handler der gattungsgemäßen Art:

THandler<T:TMessage> = procedure (Sender: TObject: Message: T); 

Ich kann nicht herausfinden, wie "TMessageBus.Subscribe" deklariert und implementiert werden kann, um dies zu unterstützen.

Answer 1

Sie können überprüfen, wie der Standard TMessageManager implementiert ist. Ich denke nicht, was Sie erreichen möchten, ist derzeit in Delphi möglich, weil Sie Objekte verschiedener Klassen nicht in einer Liste speichern und dann ohne Kompilierung in die entsprechende Klasse zur Kompilierungszeit extrahieren können.

type 
    TStringMessage = TMessage<string>; 

procedure TForm1.Button9Click(Sender: TObject); 
begin 
    TMessageManager.DefaultManager.SubscribeToMessage(TStringMessage, 
    procedure(const Sender: TObject; const M: TMessage) 
    begin 
    ShowMessage(TStringMessage(M).Value); 
    end); 

    TMessageManager.DefaultManager.SendMessage(Self, TStringMessage.Create('test'), True); 
end; 

aktualisieren

Eigentlich mit einigen RTTI Hilfe Ich denke, es möglich ist, etwas in der Nähe zu tun, was Sie wollen.

Mit unterhalb Sie Gerät kann

type 
    TTestMessage = class(TMessage) 
    Test: string; 
    constructor Create(const ATest: string); 
    end; 

constructor TTestMessage.Create(const ATest: string); 
begin 
    Test := ATest; 
end; 

procedure HandleMessage(const ASender: TObject; const AMyTestMessage: TTestMessage); 
begin 
    ShowMessage(AMyTestMessage.Test); 
end; 

procedure TMainForm.Button6Click(Sender: TObject); 
begin 
    TPublisher<TTestMessage>.Subscribe(HandleMessage); 
    MessageBus.SendMessage(Self, TTestMessage.Create('test')); 
end; 

und hier ist Herausgeber folgende schreiben, beachten Sie, dass Datei aufgerufen werden UPublisher.pas haben

unit UPublisher; 

interface 

uses System.Messaging; 

type 
    TPublisherBase = class 
    protected 
    procedure SendMessageM(const ASender: TObject; const AMessage: TMessage); virtual; abstract; 
    end; 

    TPublisherBaseClass = class of TPublisherBase; 

    TPublisher<T: class> = class(TPublisherBase) 
    private 
    type 
     THandler = procedure(const Sender: TObject; const AMessage: T); 
    private 
    class var FHandlers: TArray<THandler>; 
    class var FPublisher: TPublisher<T>; 
    protected 
    procedure SendMessageM(const ASender: TObject; const AMessage: TMessage); override; 
    class procedure SendMessage(const ASender: TObject; const AMessage: T); 
    public 
    class constructor Create; 
    class destructor Destroy; 
    class procedure Subscribe(const AHandler: THandler); 
    end; 

    TMessageBus = class 
    strict private 
    FPublishers: TArray<TPublisherBase>; 
    private 
    procedure RegisterPublisher(const APublisher: TPublisherBase); 
    public 
    procedure SendMessage(const ASender: TObject; const AMessage: TMessage); 
    constructor Create; 
    end; 

var 
    MessageBus: TMessageBus; 

implementation 

constructor TMessageBus.Create; 
begin 
    FPublishers := []; 
end; 

procedure TMessageBus.RegisterPublisher(const APublisher: TPublisherBase); 
begin 
    FPublishers := FPublishers + [APublisher]; 
end; 

procedure TMessageBus.SendMessage(const ASender: TObject; const AMessage: TMessage); 
var 
    Publisher: TPublisherBase; 
    PublisherType: string; 
begin 
    PublisherType := 'UPublisher.TPublisher<' + AMessage.QualifiedClassName + '>'; 

    for Publisher in FPublishers do 
    begin 
    if Publisher.QualifiedClassName = PublisherType then 
    begin 
     Publisher.SendMessageM(ASender, AMessage); 
    end; 
    end; 
end; 

class constructor TPublisher<T>.Create; 
begin 
    FHandlers := []; 
    FPublisher := TPublisher<T>.Create; 
    MessageBus.RegisterPublisher(FPublisher); 
end; 

class destructor TPublisher<T>.Destroy; 
begin 
    FPublisher.Free; 
end; 

class procedure TPublisher<T>.Subscribe(const AHandler: THandler); 
begin 
    FHandlers := FHandlers + [@AHandler]; 
end; 

procedure TPublisher<T>.SendMessageM(const ASender: TObject; const AMessage: TMessage); 
begin 
    SendMessage(ASender, T(AMessage)); 
end; 

class procedure TPublisher<T>.SendMessage(const ASender: TObject; const AMessage: T); 
var 
    Handler: THandler; 
begin 
    for Handler in FPublisher.FHandlers do 
    begin 
    Handler(ASender, AMessage); 
    end; 
end; 

initialization 
    MessageBus := TMessageBus.Create; 
finalization 
    MessageBus.Free; 
end.