delphi - Delphi 中的约束通用事件

Question

我想创建一个消息总线，以便我可以编写发布者，如下所示:

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.

订阅者如下:

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.

我最终希望通过允许调用“Subscribe”来避免“MyHandler”中的类型转换任何通用类型的处理程序:

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

我无法弄清楚如何声明和实现“TMessageBus.Subscribe”来支持这一点

Answer 1

您可以查看标准 TMessageManager已实现。我认为目前在 Delphi 中您想要实现的目标是不可能的，因为您无法将不同类的对象存储在列表中，然后在编译时提取而不强制转换为适当的类。

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;

更新

实际上，在一些 RTTI 帮助下，我认为可以做一些接近您想要的事情。

使用下面的单位，您可以编写以下内容

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;

这里是发布者，请注意该文件必须名为UPublisher.pas

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.