[分享]功能代码中定义业务关联**

alang

运行效果图：

alang

在功能中，在项目管理中，引入 协同系统\关联\业务关联库
在代码中，写法如下：
//定义消息处理对象的处理方法
uses RelevancyLib;

  TRelevancyMsgHandle = class(TBizMessageHandler)
  private
    FForm: TMainForm;
  public
    procedure DoExecute(AMessage: TBizMessage; const AParam: THandleParam;
      var Handled: Boolean); override;
  end;

procedure TRelevancyMsgHandle.DoExecute(AMessage: TBizMessage; const AParam: THandleParam;
      var Handled: Boolean);
var
  lMsg: TRefreshRelevanciesMessage;
begin
  if AMessage is TRefreshRelevanciesMessage then
  begin
    lMsg := AMessage as TRefreshRelevanciesMessage;
    lMsg.RelevancyNavBar.AddAction('mytest', FForm.Action1);
    Handled := True;
  end;
end;

//在主窗体上注册这个消息处理对象
var
  lmh: TRelevancyMsgHandle;
begin
  lmh := TRelevancyMsgHandle.Create;
  TRelevancyMsgHandle(lmh).FForm := Self;
  Context.AddMessageHandler('Relevancy.View.Refresh.Message', lmh);

alang

lMsg.RelevancyNavBar是TRelevancyNavBar，可以调用这个对象的以下方法来控制关联项，比如当功能中PageControl切换时候，可以只绑定当前TabSheet上的数据集
NameSpace: RelevancyLib
--------------------------------------------------------------------------------
TRelevancyNavBar = class(Justep.Tools.ExpressNavBar.TdxNavBar)
public
  constructor create(AOwner: Business.System.TComponent); overload;
  //增加一个动作Action
  procedure AddAction(GroupCaption: string; Action: Business.Forms.TAction);
  //绑定一个数据集
  procedure BindDataSet(ADataSet: Business.Model.TBizDataSet);
  //解除绑定一个数据集
  procedure UnbindDataSet(ADataSet: Business.Model.TBizDataSet);
  procedure Clear;
  procedure ClearBindDataSets;
  procedure Destroy; override; overload;
  //获取分组对象，可以修改这个对象来改变分组显示的颜色图标等
  function GetGroup(AGroup: RelevancyInfo.TRelevancyGroupRec): Justep.Tools.ExpressNavBar.TdxNavBarGroup; overload;
  function GetGroup(AGroupCaption: string): Justep.Tools.ExpressNavBar.TdxNavBarGroup; overload;
  //重新加载关联项
  procedure ReloadRelevancies(AOwnerContext: Business.Model.TContext; OwnerURL: string; ExceptFuncURL: array of string); overload;
  procedure ReloadRelevancies(AOwnerContext: Business.Model.TContext; OwnerURL: string); overload;
end;

alang

标准风格主界面在功能切换时候才可以刷新关联条，而且只有在功能环境下的信息环境中的数据集才可以识别出来
以下情况关联条不能自动识别出来：
1  直接放在窗体上的数据集
2  信息的隔离级不是缺省或者不是功能的
3  代码创建的数据集
4  在功能中，需要自动识别在Page页上的数据集

alang

以下举例为：
窗体上创建的数据集，当Page页切换时候，只识别当前Page页上的数据集，而且处理识别数据集之外，可以增加一些自定义的动作
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
unit MainForm;

interface

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

type
  TMainForm = class(TForm)
    ControlBar1: TControlBar;
    DataNavigator1: TDataNavigator;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    DataGrid1: TDataGrid;
    InfoBroker1: TInfoBroker;
    DataSetBroker1: TDataSetBroker;
    DataSource1: TDataSource;
    DataGrid2: TDataGrid;
    DataSetBZSJJ1: TSQLDataSet;
    ActionList1: TActionList;
    Action1: TAction;
    FuncBroker1: TFuncBroker;
    procedure BizFormShow(Sender: TObject);
    procedure BizFormCreate(Sender: TObject);
    procedure Action1Execute(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure BizFormDestroy(Sender: TObject);
  private
    {private declarations}
    MsgHandler: TBizMessageHandler;
  public
    {public declarations}
  end;

implementation

uses RelevancyLib;

var
  NavBar: TRelevancyNavBar;

type
  TRelevancyMsgHandle = class(TBizMessageHandler)
  private
    FForm: TMainForm;
  public
    procedure DoExecute(AMessage: TBizMessage; const AParam: THandleParam;
      var Handled: Boolean); override;
  end;

procedure TRelevancyMsgHandle.DoExecute(AMessage: TBizMessage; const AParam: THandleParam;
      var Handled: Boolean);
var
  lMsg: TRefreshRelevanciesMessage;
begin
  if AMessage is TRefreshRelevanciesMessage then
  begin
    lMsg := AMessage as TRefreshRelevanciesMessage;
    //清除关联条
    lMsg.RelevancyNavBar.Clear;
    //根据ActivePageIndex绑定不同的数据集
    if FForm.PageControl1.ActivePageIndex=0 then
      lMsg.RelevancyNavBar.BindDataSet(FForm.DataSetBroker1.DataSet as TBizDataSet)
    else
      lMsg.RelevancyNavBar.BindDataSet(FForm.DataSetBZSJJ1);

    //根据上面指定的数据集，根据业务关联定义加载关联项
    lMsg.RelevancyNavBar.ReloadRelevancies(FForm.Context, FForm.FuncBroker1.Func.BizClassURL.BizURL.URL);
    //增加自定义的关联项
    lMsg.RelevancyNavBar.AddAction('mytest', FForm.Action1);
    //记录关联条对象，待会儿发消息时候要用到
    if NavBar=nil then NavBar := lMsg.RelevancyNavBar;
    Handled := True;
  end;
end;

procedure TMainForm.BizFormCreate(Sender: TObject);
var
  lmh: TRelevancyMsgHandle;
begin
  lmh := TRelevancyMsgHandle.Create;
  MsgHandler := lmh;
  lmh.FForm := Self;
  //在环境中注册关联条刷新消息处理对象，当关联条需要刷新时候就调用这个对象了
  Context.AddMessageHandler(TRefreshRelevanciesMessage.GetName, lmh);
end;

procedure TMainForm.BizFormDestroy(Sender: TObject);
begin
  //注销消息处理对象并且释放它
  Context.RemoveMessageHandler(TRefreshRelevanciesMessage.GetName, MsgHandler);
  MsgHandler.Free;
end;

procedure TMainForm.PageControl1Change(Sender: TObject);
var
  lmsg: TRefreshRelevanciesMessage;
begin
  //当Page页切换以后，发送一个刷新关联条的消息
  //在消息处理函数中就可以根据当前Page页显示对应数据集的关联项了
  lmsg := TRefreshRelevanciesMessage.Create(NavBar);
  Context.SendMessage(lmsg);
end;

procedure TMainForm.BizFormShow(Sender: TObject);
begin
  DataSetBroker1.DataSet.Open; //显示在Page页的第0页上
  DataSetBZSJJ1.Open;          //显示在Page页的第1页上
end;

procedure TMainForm.Action1Execute(Sender: TObject);
begin
  Dialogs.ShowMessage('action1');
end;

end.

alang

运行效果，Page页的第0页，对应的是 计划信息的计划数据集

alang

运行效果，Page页的第1页，对应的是 客户信息的客户数据集

alang

5楼有一个小技巧：
因为在创建 TRefreshRelevanciesMessage 消息时候，需要传递 RelevancyNavBar，而这个对象是在主界面上的，在当前功能上没有，因此在第一次收到处理消息时候，用 NavBar 变量把这个对象保存起来，这样当发消息时候就可以用这个变量了