[分享]有关环境的说明

alang

背景知识： 环境链、隔离级 可以参考 http://bbs.justep.com/forum.php? ... =%BB%B7%BE%B3%C1%B4

NameSpace: Business.Model
--------------------------------------------------------------------------------
TContext = class(Business.System.TObject)
protected
  property BizObjectPool[Longint]: TBizObject; readonly;
  property BizObjectPoolCount: Longint; readonly;
public
  constructor create(AOwner: TBizObject; AParent: TContext);
  procedure AddMessageHandler(AName: string; AHandler: TBizMessageHandler);
  function BroadcastToChildren(AMessage: TBizMessage): Boolean;
  function BroadcastToParent(AMessage: TBizMessage): Boolean;
  procedure Destroy; override;
  function FindBizObject(AClass: TBizClassURL): TBizObject;
  function FindItem(AURL: TBizURL): Business.System.TComponent;
  function FindParentContext(AIsolationLevel: string): TContext;
  function GetBizObject(AClass: TBizClassURL): TBizObject;
  function GetBizObjectEx(AClass: TBizClassURL; AIsolationLevel: string): TBizObject;
  function GetItem(AURL: TBizURL): Business.System.TComponent;
  function GetParentContext(AIsolationLevel: string): TContext;
  procedure RemoveChild(AChild: TContext);
  procedure RemoveMessageHandler(AName: string; AHandler: TBizMessageHandler);
  function SendMessage(AMessage: TBizMessage): Boolean;
  property ChildCount: Longint; readonly;
  property Children[Longint]: TContext; readonly;
  property IsolationLevel: string; readonly;
  property Owner: TBizObject; readonly;
  property Parent: TContext; readonly;
end;

alang

业务对象TBizObject都是生存在一定的环境中，在环境中可以用以下函数查找或者创建业务对象或者控件
  FindBizObject        在环境中查找AClass的业务对象（比如查找窗体、查找信息等）
  FindItem        在环境中查找AURL的控件（比如查找业务参数、业务元素等）
  GetBizObject        在环境中查找AClass的业务对象，如果没有就在环境中创建这个对象
  GetItem        在环境中查找AURL的控件，如果没有就在环境中创建这个控件
  GetBizObjectEx通过环境在指定的隔离级AIsolationLevel查找AURL的控件，如果没有就在环境中创建这个控件

可以通过环境的保护protected属性得到BizObjectPoolCount缓冲池中的对象个数，BizObjectPool得到每一个对象，因为这些方法都是保护的方法，实际只能用上面提到的方法来获取缓冲池中的业务对象

alang

全局环境的拥有者是一个TBizGlobalObject类型的对象
人员环境的拥有者是一个TOrgOperator类型的对象，可以通过这个对象得到当前登陆者的信息（用户ID，所有的岗位等）
岗位环境的拥有者是一个TOperatorPosition类型的对象，可以得到岗位ID等信息
流程环境的拥有者是一个TFlowControl类型的对象，可以通过这个对象来对控制流程
功能环境的拥有者是一个TFunc类型的对象，是这个环境所属的功能
信息环境的拥有者是一个TInfo类型的对象，是这个环境所属的信息

alang

通过环境可以找到父环境，也可以找到子环境，从而从任何一级环境触发可以找到整个环境链信息
IsolationLevel        环境的隔离级
Parent                父环境
ChildCount        子环境的个数
Children        每一个子环境
GetParentContext查找某个隔离级的父环境，找不到则报错
FindParentContext查找某个隔离级的父环境，找不到则返回nil
RemoveChild        从环境中删掉一个子环境

alang

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

可以发送和处理平台上定义好的消息
有关环境中发消息的详细的说明，请参考 http://bbs.justep.com/forum.php?mod=viewthread&tid=24102
如果需要自定义消息及处理，可以参考 http://bbs.justep.com/forum.php?mod=viewthread&tid=18518

alang

关于环境链，以下是一个例子，把从全局环境的所有环境信息都显示到一个TreeView上
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
function GetBizObjectDesc(AObject: TBizObject): String;
var
  s: String;
begin
  if AObject is TOperatorPosition then
  begin
    Result := SysUtils.Format('部门:%s 岗位:%s', [(AObject as TOperatorPosition).DeptID, (AObject as TOperatorPosition).PositionID]);
    Result := Result + ':TOperatorPosition';
    Exit;
  end;
  if AObject is TFlowControl then
  begin
    Result := SysUtils.Format('流程:%s 环节:%s', [(AObject as TFlowControl).Proc.DisplayName, (AObject as TFlowControl).CurrentProcUnit.DisplayName]);
    Result := Result + ':TFlowControl';
    Exit;
  end;
  try
    s := ObjectHelper.ToString(ObjectHelper.GetPropertyValue(AObject, 'ID',[]));
  except
    try
      s := ObjectHelper.ToString(ObjectHelper.GetPropertyValue(AObject, 'Name',[]));
    except
      s := '(unknown)';
    end;
  end;
  try
    s := s+' '+ObjectHelper.ToString(ObjectHelper.GetPropertyValue(AObject, 'DisplayName',[]));
  except
  end;
  try
    Result := s+':'+ObjectHelper.GetType(AObject).Name;
  except
    Result := s+'unknown type)';
  end;
end;

function GetPolicyDesc(APolicy: TBizObjectPolicy): String;
begin
  Result := APolicy.Name+':'+APolicy.Kind+' '+APolicy.Description;
end;

function GetComponentDesc(AComponent: TComponent): String;
begin
  try
    Result := AComponent.Name+':'+ObjectHelper.GetType(AComponent).Name;
  except
    Result := AComponent.Name+'unknown type)';
  end;
end;

procedure AddSubContext(ATreeView: TTreeView; ANode: TTreeNode; AContext: TContext);
var
  i: Integer;
  node, pnode: TTreeNode;
begin
  if AContext.ChildCount=0 then Exit;

  pnode := ATreeView.Items.AddChild(ANode, '环境');
  for i := 0 to AContext.ChildCount-1 do
  begin
    node := ATreeView.Items.AddChildObject(pnode, GetBizObjectDesc(AContext.Children.Owner), AContext.Children.Owner);
    ParseContext(ATreeView, node, AContext.Children);
  end;
end;

procedure AddPolicies(ATreeView: TTreeView; ANode: TTreeNode; AObject: TBizObject);
var
  i: Integer;
  pnode: TTreeNode;
begin
  if AObject.PolicyCount=0 then Exit;

  pnode := ATreeView.Items.AddChild(ANode, '策略');
  for i:=0 to AObject.PolicyCount-1 do
  begin
    ATreeView.Items.AddChildObject(pnode, GetPolicyDesc(AObject.Policies), AObject.Policies);
  end;
end;

type
  TMyContext = class(TContext)
  private
    function GetMyObject(Index: Integer): TBizObject;
    function GetObjectCount: Integer;
  public
    property BizObjPool[Index: Longint]: TBizObject read GetMyObject;
    property BizObjPoolCount: Longint read GetObjectCount;
  end;

function TMyContext.GetMyObject(Index: Integer): TBizObject;
begin
  Result := BizObjectPool[Index];
end;

function TMyContext.GetObjectCount: Integer;
begin
  Result := BizObjectPoolCount;
end;

procedure AddComponent(ATreeView: TTreeView; ANode: TTreeNode; AComp: TComponent);
var
  i: Integer;
  node, pNode: TTreeNode;
begin
  if (AComp.ComponentCount=0) and ((not (AComp is TFunc)) or ((AComp as TFunc).MainForm=nil)) then Exit;

  pnode := ATreeView.Items.AddChild(ANode, '组件');
  for i:=0 to AComp.ComponentCount-1 do
  begin
    node := ATreeView.Items.AddChildObject(pnode, GetComponentDesc(AComp.Components), AComp.Components);
    AddComponent(ATreeView, node, AComp.Components);
  end;
  if (AComp is TFunc) and ((AComp as TFunc).MainForm<>nil) then
  begin
    node := ATreeView.Items.AddChildObject(pnode, GetComponentDesc((AComp as TFunc).MainForm), (AComp as TFunc).MainForm);
    AddComponent(ATreeView, node, (AComp as TFunc).MainForm);
  end;
end;

procedure AddBizObject(ATreeView: TTreeView; ANode: TTreeNode; AContext: TMyContext);
var
  i: Integer;
  node, pnode: TTreeNode;
begin
  if AContext.BizObjPoolCount=0 then Exit;

  pnode := ATreeView.Items.AddChild(ANode, '缓冲池');
  for i:=0 to AContext.BizObjPoolCount-1 do
  begin
    node := ATreeView.Items.AddChildObject(pnode, GetBizObjectDesc(AContext.BizObjPool), AContext.BizObjPool);
    AddComponent(ATreeView, node, AContext.BizObjPool);
  end;
end;

procedure ParseContext(ATreeView: TTreeView; ANode: TTreeNode; AContext: TContext);
var
  node: TTreeNode;
  i: Integer;
begin
  AddSubContext(ATreeView, ANode, AContext);
  AddPolicies(ATreeView, ANode, AContext.Owner);
  AddBizObject(ATreeView, ANode, TMyContext(AContext));
  AddComponent(ATreeView, ANode, AContext.Owner);
end;

procedure TMainForm.Button3Click(Sender: TObject);
var
  ctx: TContext;
  node: TTreeNode;
begin
  tv.Items.Clear;
  ctx := Context.GetParentContext(BizSys.IL_GLOBAL);
  node := tv.Items.AddChildObjectFirst(nil, '全局', ctx);
  ParseContext(tv, node, ctx);
end;

alang

下图是上述代码执行结果