[分享]环境中发消息的原理说明

alang

环境是平台上各个运行对象运行的基础，有关环境的背景知识请参考
http://bbs.justep.com/forum.php?mod=viewthread&tid=2357
http://bbs.justep.com/forum.php?mod=viewthread&tid=19153

环境中可以发消息，也可以给环境链的父或者子发广播的消息；
在环境中可以注册消息的处理程序，在收到消息时候对消息进行处理

平台很多地方用到了发消息，
比如：功能关闭时候检查数据集是否被修改后没有提交，
比如：主界面上功能切换时候获取业务关联信息
比如：任何流程一个流程动作的发生都会发消息

附件是环境中发消息的例子

alang

消息类
TBizMessage = class(Business.System.TObject)
public
  constructor create(AName: string);
  property Name: string; readonly;
end;

消息处理类
TBizMessageHandler = class(Business.System.TObject)
protected
  procedure DoExecute(AMessage: TBizMessage; AParam: THandleParam; Handled: Boolean); virtual;
public
  constructor create;
  function Execute(AMessage: TBizMessage; AParam: THandleParam): Boolean;
  property Next: TBizMessageHandler; readonly;
end;

环境中跟发消息有关的函数
AddMessageHandler 增加一个消息处理对象
RemoveMessageHandler删除一个消息处理对象
SendMessage 在环境中发消息
BroadcastToChildren 给子环境发消息
BroadcastToParent 给父环境发消息

alang

通常环境中发消息是这样做的
1) 定义一个自己的消息类
  消息都是从TBizMessage继承下来的，为了让消息处理对象在处理消息时候区别于别的消息，一般需要在消息中定义一个变量或者属性，如例子中的FContext，这样消息处理程序就可以区分出来是哪个环境发来的消息了
  TMyMessage = class(TBizMessage)
  private
    FContext: TContext;
  public
    constructor Create(AName: String; AContext: TContext);
  end;

constructor TMyMessage.Create(AName: String; AContext: TContext);
begin
  inherited Create(AName);
  FContext := AContext;
end;

alang

2) 定义一个消息处理类
  在收到消息以后，需要做相应的处理，重载DoExecute方法来做相应的处理

    procedure DoExecute(AMessage: TBizMessage; const AParam: THandleParam;
      var Handled: Boolean); override;
AMessage是收到的消息，一般要强制类型转换成需要的类型来访问这个消息特定的属性或方法，比如这个例子中就是TMyMessage(AMessage)
AParam 是消息的来源，表示消息是通过调用SendMessage、BroadCastToChildren、BroadCastToParent中哪个方法发出的
Handled表示消息是否得到了处理
  如果True，那么不在处理了
  如果False，那么对于BroadCastToChildren、BroadCastToParent方法继续往子或者父发消息，知道消息得到处理或者直到没有子或者没有父

  TMyMessageHandler = class(TBizMessageHandler)
  private
    FText: String;
    FHandled: Boolean;
  public
    procedure DoExecute(AMessage: TBizMessage; const AParam: THandleParam;
      var Handled: Boolean); override;
  end;

procedure TMyMessageHandler.DoExecute(AMessage: TBizMessage; const AParam: THandleParam;
      var Handled: Boolean);
var
  s: String;
begin
  case AParam.SendTo of
  TSendToKind.stChildren: s := 'BroadcastToChildren';
  TSendToKind.stParent:   s := 'BroadcastToParent';
  TSendToKind.stSelf:     s := 'SendMessage';
  else                    s := '[Unknown]';
  end;
  s := SysUtils.Format('%s'#13#10'消息由 %s 执行 %s 方法发送的。', [FText, TMyMessage(AMessage).FContext.IsolationLevel, s]);
  Dialogs.Showmessage(s);
  Handled := FHandled;
end;

alang

3) 创建消息处理对象的实例，注册到环境中
procedure AddMessageHandler(AName: string; AHandler: TBizMessageHandler);
在环境中注册一个消息处理对象
AName 是消息的名称，表示这个消息对象只处理这个名称的消息，其他的消息不处理
AHandler 消息处理对象的实例
procedure RemoveMessageHandler(AName: string; AHandler: TBizMessageHandler);
在环境中注销一个消息处理对象
参数说明同上

procedure TMainForm.actGlobalAddHandlerExecute(Sender: TObject);
begin
  if FGlobalHandler=nil then
  begin
    FGlobalHandler := TMyMessageHandler.Create;
    FGlobalHandler.FText    := '这是全局环境的Handler';
    FGlobalHandler.FHandled := False;
  end;
  Context.GetParentContext(BizSys.IL_GLOBAL).AddMessageHandler(MsgName, FGlobalHandler);
end;

alang

4) 在需要发消息的地方，创建一个消息的实例，调用SendMessage、BroadCastToChildren、BroadCastToParent方法来发消息

function SendMessage(AMessage: TBizMessage): Boolean;
发消息给环境，如果没有相应的处理对象，或者处理对象执行结果Handled为False，则函数返回者为False，否者为True

function BroadcastToChildren(AMessage: TBizMessage): Boolean;
逐级的把消息发给子环境，如果某个子环境上注册了消息处理对象，并且执行结果为True，则任务消息已经被处理，停止寻找下一个子环境，不再发消息，函数返回值为True，如果没有找到消息处理对象，或者处理结果为False，则继续找下一个子环境来处理这个消息，直到没有子为止。
function BroadcastToParent(AMessage: TBizMessage): Boolean;
逐级发消息给父环境，直到消息得到处理或者没有父环境为止

procedure TMainForm.SendMessage(AContext: TContext);
var
  msg: TMyMessage;
begin
  msg := TMyMessage.Create(MsgName, AContext);
  try
    if AContext.SendMessage(msg) then
      Dialogs.Showmessage('消息已经被处理！')
    else
      Dialogs.Showmessage('消息没有被处理！');
  finally
    msg.Free;
  end;
end;

alang

1楼例子的完整代码如下：
unit MainForm;

interface

uses
  Business.System, Business.Forms, Business.Model;

type
  TMainForm = class(TForm)
    GroupBox1: TGroupBox;
    btnAddHandlerToGlobal: TButton;
    edtGlobal: TEdit;
    ckbGlobal: TCheckBox;
    Label1: TLabel;
    btnRemoveHandlerFromGlobal: TButton;
    ApplicationEvents1: TApplicationEvents;
    GroupBox2: TGroupBox;
    Label2: TLabel;
    Button1: TButton;
    edtFunc: TEdit;
    CheckBox1: TCheckBox;
    Button2: TButton;
    GroupBox3: TGroupBox;
    Label3: TLabel;
    Button3: TButton;
    edtPerson: TEdit;
    CheckBox2: TCheckBox;
    Button4: TButton;
    ActionList1: TActionList;
    actGlobalAddHandler: TAction;
    actGlobalRemoveHandler: TAction;
    actGlobalHandled: TAction;
    actFuncAddHandler: TAction;
    actFuncRemoveHandler: TAction;
    actFuncHandled: TAction;
    actPersonAddHandler: TAction;
    actPersonRemoveHandler: TAction;
    actPersonHandled: TAction;
    Button5: TButton;
    actGlobalSendMessage: TAction;
    Button6: TButton;
    actGlobalBroadcastToParent: TAction;
    actFuncSendMessage: TAction;
    actFuncBroadcastToParent: TAction;
    actPersonBroadcastToParent: TAction;
    actPersonSendMessage: TAction;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button10: TButton;
    actGlobalBroadcastToChildren: TAction;
    actFuncBroadcastToChildren: TAction;
    actPersonBroadcastToChildren: TAction;
    Button11: TButton;
    Button12: TButton;
    Button13: TButton;
    aa: TNotebook;
    Button14: TButton;
    procedure actGlobalAddHandlerUpdate(Sender: TObject);
    procedure actGlobalAddHandlerExecute(Sender: TObject);
    procedure actGlobalRemoveHandlerUpdate(Sender: TObject);
    procedure actGlobalRemoveHandlerExecute(Sender: TObject);
    procedure actGlobalHandledUpdate(Sender: TObject);
    procedure actGlobalHandledExecute(Sender: TObject);
    procedure actFuncAddHandlerUpdate(Sender: TObject);
    procedure actFuncAddHandlerExecute(Sender: TObject);
    procedure actFuncRemoveHandlerUpdate(Sender: TObject);
    procedure actFuncRemoveHandlerExecute(Sender: TObject);
    procedure actFuncHandledUpdate(Sender: TObject);
    procedure actFuncHandledExecute(Sender: TObject);
    procedure actPersonAddHandlerUpdate(Sender: TObject);
    procedure actPersonAddHandlerExecute(Sender: TObject);
    procedure actPersonRemoveHandlerUpdate(Sender: TObject);
    procedure actPersonRemoveHandlerExecute(Sender: TObject);
    procedure actPersonHandledUpdate(Sender: TObject);
    procedure actPersonHandledExecute(Sender: TObject);
    procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
    procedure actGlobalSendMessageExecute(Sender: TObject);
    procedure actGlobalBroadcastToParentExecute(Sender: TObject);
    procedure actFuncSendMessageExecute(Sender: TObject);
    procedure actFuncBroadcastToParentExecute(Sender: TObject);
    procedure actPersonSendMessageExecute(Sender: TObject);
    procedure actPersonBroadcastToParentExecute(Sender: TObject);
    procedure actGlobalBroadcastToChildrenExecute(Sender: TObject);
    procedure actFuncBroadcastToChildrenExecute(Sender: TObject);
    procedure actPersonBroadcastToChildrenExecute(Sender: TObject);
  private
    {private declarations}
    procedure SendMessage(AContext: TContext);
    procedure BroadcastToParent(AContext: TContext);
    procedure BroadcastToChildren(AContext: TContext);
  public
    {public declarations}
    FGlobalHandler: TMyMessageHandler;
    FPersonHandler: TMyMessageHandler;
    FFuncHandler: TMyMessageHandler;
    constructor Create(AContext: TContext);
  end;

  TMyMessage = class(TBizMessage)
  private
    FContext: TContext;
  public
    constructor Create(AName: String; AContext: TContext);
  end;

  TMyMessageHandler = class(TBizMessageHandler)
  private
    FText: String;
    FHandled: Boolean;
  public
    procedure DoExecute(AMessage: TBizMessage; const AParam: THandleParam;
      var Handled: Boolean); override;
  end;

implementation

const
  MsgName='MyMessage.Test';

constructor TMyMessage.Create(AName: String; AContext: TContext);
begin
  inherited Create(AName);
  FContext := AContext;
end;

procedure TMyMessageHandler.DoExecute(AMessage: TBizMessage; const AParam: THandleParam;
      var Handled: Boolean);
var
  s: String;
begin
  case AParam.SendTo of
  TSendToKind.stChildren: s := 'BroadcastToChildren';
  TSendToKind.stParent:   s := 'BroadcastToParent';
  TSendToKind.stSelf:     s := 'SendMessage';
  else                    s := '[Unknown]';
  end;
  s := SysUtils.Format('%s'#13#10'消息由 %s 执行 %s 方法发送的。', [FText, TMyMessage(AMessage).FContext.IsolationLevel, s]);
  Dialogs.Showmessage(s);
  Handled := FHandled;
end;

constructor TMainForm.Create(AContext: TContext);
begin
  inherited;
end;

procedure TMainForm.SendMessage(AContext: TContext);
var
  msg: TMyMessage;
begin
  msg := TMyMessage.Create(MsgName, AContext);
  try
    if AContext.SendMessage(msg) then
      Dialogs.Showmessage('消息已经被处理！')
    else
      Dialogs.Showmessage('消息没有被处理！');
  finally
    msg.Free;
  end;
end;

procedure TMainForm.BroadcastToParent(AContext: TContext);
var
  msg: TMyMessage;
begin
  msg := TMyMessage.Create(MsgName, AContext);
  try
    if AContext.BroadcastToParent(msg) then
      Dialogs.Showmessage('消息已经被处理！')
    else
      Dialogs.Showmessage('消息没有被处理！');
  finally
    msg.Free;
  end;
end;

procedure TMainForm.BroadcastToChildren(AContext: TContext);
var
  msg: TMyMessage;
begin
  msg := TMyMessage.Create(MsgName, AContext);
  try
    if AContext.BroadcastToChildren(msg) then
      Dialogs.Showmessage('消息已经被处理！')
    else
      Dialogs.Showmessage('消息没有被处理！');
  finally
    msg.Free;
  end;
end;

procedure TMainForm.actGlobalAddHandlerUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := FGlobalHandler=nil;
end;

procedure TMainForm.actGlobalAddHandlerExecute(Sender: TObject);
begin
  if FGlobalHandler=nil then
  begin
    FGlobalHandler := TMyMessageHandler.Create;
    FGlobalHandler.FText    := '这是全局环境的Handler';
    FGlobalHandler.FHandled := False;
  end;
  Context.GetParentContext(BizSys.IL_GLOBAL).AddMessageHandler(MsgName, FGlobalHandler);
end;

procedure TMainForm.actGlobalRemoveHandlerUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := FGlobalHandler<>nil;
end;

procedure TMainForm.actGlobalRemoveHandlerExecute(Sender: TObject);
begin
  Context.GetParentContext(BizSys.IL_GLOBAL).RemoveMessageHandler(msgName, FGlobalHandler);
  FreeAndNil(FGlobalHandler);
end;

procedure TMainForm.actGlobalSendMessageExecute(Sender: TObject);
begin
  SendMessage(Context.GetParentContext(BizSys.IL_GLOBAL));
end;

procedure TMainForm.actGlobalBroadcastToParentExecute(Sender: TObject);
begin
  BroadcastToParent(Context.GetParentContext(BizSys.IL_GLOBAL));
end;

procedure TMainForm.actGlobalBroadcastToChildrenExecute(Sender: TObject);
begin
  BroadcastToChildren(Context.GetParentContext(BizSys.IL_GLOBAL));
end;

procedure TMainForm.actGlobalHandledUpdate(Sender: TObject);
begin
  TACtion(Sender).Enabled := FGlobalHandler<>nil;
  TAction(Sender).Checked := (FGlobalHandler<>nil) and (FGlobalHandler.FHandled)
end;

procedure TMainForm.actGlobalHandledExecute(Sender: TObject);
begin
  if FGlobalHandler<>nil then
    FGlobalHandler.FHandled := TAction(Sender).Checked;
end;

procedure TMainForm.actFuncAddHandlerUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := FFuncHandler=nil;
end;

procedure TMainForm.actFuncAddHandlerExecute(Sender: TObject);
begin
  if FFuncHandler=nil then
  begin
    FFuncHandler := TMyMessageHandler.Create;
    FFuncHandler.FText    := '这是功能环境的Handler';
    FFuncHandler.FHandled := False;
  end;
  Context.AddMessageHandler(MsgName, FFuncHandler);
end;

procedure TMainForm.actFuncRemoveHandlerUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := FFuncHandler<>nil;
end;

procedure TMainForm.actFuncRemoveHandlerExecute(Sender: TObject);
begin
  Context.RemoveMessageHandler(msgName, FFuncHandler);
  FreeAndNil(FFuncHandler);
end;

procedure TMainForm.actFuncSendMessageExecute(Sender: TObject);
begin
  SendMessage(Context);
end;

procedure TMainForm.actFuncBroadcastToParentExecute(Sender: TObject);
begin
  BroadcastToParent(Context);
end;

procedure TMainForm.actFuncBroadcastToChildrenExecute(Sender: TObject);
begin
  BroadcastToChildren(Context);
end;

procedure TMainForm.actFuncHandledUpdate(Sender: TObject);
begin
  TACtion(Sender).Enabled := FFuncHandler<>nil;
  TAction(Sender).Checked := (FFuncHandler<>nil) and (FFuncHandler.FHandled)
end;

procedure TMainForm.actFuncHandledExecute(Sender: TObject);
begin
  if FFuncHandler<>nil then
    FFuncHandler.FHandled := TAction(Sender).Checked;
end;

procedure TMainForm.actPersonAddHandlerUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := FPersonHandler=nil;
end;

procedure TMainForm.actPersonAddHandlerExecute(Sender: TObject);
begin
  if FPersonHandler=nil then
  begin
    FPersonHandler := TMyMessageHandler.Create;
    FPersonHandler.FText    := '这是人员环境的Handler';
    FPersonHandler.FHandled := False;
  end;
  Context.GetParentContext(BizSys.IL_PERSON).AddMessageHandler(MsgName, FPersonHandler);
end;

procedure TMainForm.actPersonRemoveHandlerUpdate(Sender: TObject);
begin
  TAction(Sender).Enabled := FPersonHandler<>nil;
end;

procedure TMainForm.actPersonRemoveHandlerExecute(Sender: TObject);
begin
  Context.GetParentContext(BizSys.IL_PERSON).RemoveMessageHandler(msgName, FPersonHandler);
  FreeAndNil(FPersonHandler);
end;

procedure TMainForm.actPersonSendMessageExecute(Sender: TObject);
begin
  SendMessage(Context.GetParentContext(BizSys.IL_PERSON));
end;

procedure TMainForm.actPersonBroadcastToParentExecute(Sender: TObject);
begin
  BroadcastToParent(Context.GetParentContext(BizSys.IL_PERSON));
end;

procedure TMainForm.actPersonBroadcastToChildrenExecute(Sender: TObject);
begin
  BroadcastToChildren(Context.GetParentContext(BizSys.IL_PERSON));
end;

procedure TMainForm.actPersonHandledUpdate(Sender: TObject);
begin
  TACtion(Sender).Enabled := FPersonHandler<>nil;
  TAction(Sender).Checked := (FPersonHandler<>nil) and (FPersonHandler.FHandled)
end;

procedure TMainForm.actPersonHandledExecute(Sender: TObject);
begin
  if FPersonHandler<>nil then
    FPersonHandler.FHandled := TAction(Sender).Checked;
end;

procedure TMainForm.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
begin
  if FGlobalHandler<>nil then
    edtGlobal.Text := FGlobalHandler.FText
  else
    edtGlobal.Text := '[空]';
  if FFuncHandler<>nil then
    edtFunc.Text := FFuncHandler.FText
  else
    edtFunc.Text := '[空]';
  if FPersonHandler<>nil then
    edtPerson.Text := FPersonHandler.FText
  else
    edtPerson.Text := '[空]';
end;

end.

alang

下面我们来看看这个例子运行出来的效果
Global  Person  Func
分别代表了各自的环境：全局环境、人员环境、功能环境

以全局环境为例
AddHandler                 在全局环境中增加消息处理对象
RemoveHandler          在全局环境中去掉消息处理对象
SendMessage             在全局环境执行SendMessage
BroadcastToParent     在全局环境执行BroadcastToParent
BroadcastToChildren   在全局环境执行BroadcastToChildren
Text                             全局环境的消息处理对象的FText属性，显示看的区分各个环境下的消息处理对象
Handled                      全局环境的消息处理对象DoExecute的Handled参数的返回值

alang

进一步说明，以上涉及到的环境中，全局环境为最高的父环境，功能环境是最低的子环境，人员环境在中间

alang

在全局环境AddHandler
在功能环境AddHandler
在人员环境SendMessage

运行结果：
  全局环境和功能环境的消息处理对象都没有执行，消息没有得到处理
说明：
  SendMessage只检查当前环境有没有消息处理对象，不会管父环境或者子环境是否有消息处理对象