德尔福中的受约束泛型事件

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.

我最终希望通过允许调用"订阅"来避免"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.