我的主窗体的完整代码如下：
unit MyMainForm;
interface
uses
Business.System, Business.Forms, Business.Model, Business.Model.Org,
RelevancyLib{需要引入 协同系统\关联\业务关联库};
type
TMyMainForm = class(TForm)
tvFuncTree: TTreeView;
pnlMain: TPanel;
PageControl1: TPageControl;
tabRelevancy: TTabSheet;
TabSheet2: TTabSheet;
Splitter1: TSplitter;
Splitter2: TSplitter;
procedure BizFormShow(Sender: TObject);
procedure tvFuncTreeClick(Sender: TObject);
private
{private declarations}
FCurrentFunc: TFunc;
FRelevancyNavBar: TRelevancyNavBar;
function FindContext(ANode: TTreeNode): TContext;
procedure SetCurrentFunc(Value: TFunc);
procedure CopyTreeToNode(srcTree: TTreeView; dstNode: TTreeNode);
procedure CopyNodeToNode(srcNode, dstNode: TTreeNode);
procedure ShowFuncTree;
procedure ReloadRelevancyNavBar;
procedure DefaultRefreshRelevancies(ANavBar: TRelevancyNavBar);
procedure RunFunc(ANode: TTreeNode; AFuncURL: String);
public
{public declarations}
constructor Create(AContext: TContext);
destructor Destroy; override;
property CurrentFunc: TFunc read FCurrentFunc write SetCurrentFunc;
end;
implementation
uses
SystemCore, SystemUtils, ComponentsLib;
{ 需要引入
系统空间\系统运行库\系统核心库
系统空间\系统运行库\系统函数库
系统空间\用户界面基础\界面库\组件库
}
// 获取岗位的显示名称
function GetPositionStr(Value: TOperatorPosition): String;
begin
Result := StringUtils.Copy(Bizsys.ObjectInfo(Value.PersonMember.BizURL).DisplayNamePath, 11, 100);
Exit;
Result := SysUtils.Format('部门:%s(%s)', [
Org.OrgSys.OrgSystem.FindUnit(Value.DeptID, '', '').DisplayName,
OrgSys.OrgSystem.GetMemberDisplayName(Value.PersonMember)] );
end;
// BizTreeView缺省是不展开的，在点击节点时候再动态加载展开的
// 此处需要复制节点到功能树，因此需要代码展开BizTreeView
procedure ExpandBizTree(ATreeView: TBizTreeView);
var
lNode: TTreeNode;
begin
lNode := ATreeView.Items.GetFirstNode;
while lNode<>nil do
begin
lNode.Expand(True);
lNode := lNode.getNextSibling
end;
end;
procedure AddFolders(AURLs: TStrings);
var
i, j, k: Integer;
lURLs: TStrings;
lURL: String;
begin
lURLs := TStringList.Create;
try
for i:=0 to AURLs.Count-1 do
begin
lURL := AURLs;
while (lURL<>'') and not SysUtils.SameText(lURL, 'Biz:') do
begin
lURLs.Add(lURL);
try
lURL := BizSys.BizSystem.FileName2URL(FileSys.FileUtils.GetDirectory(BizSys.BizSystem.URL2FileName(lURL)));
except
Break;
end;
end;
end;
AURLs.AddStrings(lURLs);
finally
lURLs.Free;
end;
end;
constructor TMyMainForm.Create(AContext: TContext);
begin
inherited;
// 业务关联条
FRelevancyNavBar := TRelevancyManager.CreateRelevancyNavBar(Self, tabRelevancy);
FRelevancyNavBar.FuncManager := TSystemCore.FuncManager;
FRelevancyNavBar.DefaultStyles.Background.BackColor := 15855854;
FRelevancyNavBar.DefaultStyles.Background.BackColor2 := 15855854;
FRelevancyNavBar.Align := TAlign.alClient;
end;
destructor TMyMainForm.Destroy;
begin
FreeAndNil(FRelevancyNavBar);
inherited;
end;
procedure TMyMainForm.BizFormShow(Sender: TObject);
begin
ShowFuncTree;
end;
// 以下是显示功能权限树
procedure TMyMainForm.CopyTreeToNode(srcTree: TTreeView; dstNode: TTreeNode);
var
lNode: TTreeNode;
begin
lNode := srcTree.Items.GetFirstNode;
while lNode<>nil do
begin
CopyNodeToNode(lNode, dstNode);
lNode := lNode.getNextSibling;
end;
end;
procedure TMyMainForm.CopyNodeToNode(srcNode, dstNode: TTreeNode);
var
lDstNode: TTreeNode;
lSrcNode: TTreeNode;
begin
lSrcNode := srcNode;
lDstNode := TTreeView(dstNode.TreeView).Items.AddChildObject(DstNode, lSrcNode.Text, lSrcNode.Data);
lDstNode.Assign(lSrcNode);
lSrcNode := SrcNode.getFirstChild;
while lSrcNode<>nil do
begin
CopyNodeToNode(lSrcNode, lDstNode);
lSrcNode := SrcNode.GetNextChild(lSrcNode);
end;
end;
procedure TMyMainForm.ShowFuncTree;
var
i: Integer;
lNode: TTreeNode;
lFuncURLs: TStringList;
tv: TUserBizTreeView;
begin
tvFuncTree.Items.Clear;
for i:=0 to TSystemCore.Operator.PositionCount-1 do
begin
lNode := tvFuncTree.Items.AddChildObject(nil, GetPositionStr(TSystemCore.Operator.Positions), TSystemCore.Operator.Positions);
if TSystemCore.Operator.DefaultPosition=TSystemCore.Operator.Positions then
lNode.Text := '缺省岗位:'+lNode.Text;
if TOrgUtils.IsDeputized(TSystemCore.Operator.Positions) then
lNode.Text := '代理岗位:'+lNode.Text;
lFuncURLs := TStringList.Create;
// 得到岗位的功能权限列表
TContextUtils.GetAllocatedFuncs(TSystemCore.Operator.Positions.Context, lFuncURLs);
tv := TUserBizTreeView.Create(nil);
try
tv.ShowOptions := [TBizObjectKind.boBizServer, TBizObjectKind.boSpace,
TBizObjectKind.boFolder, TBizObjectKind.boBizFuncSpace, TBizObjectKind.boFunc];
tv.Parent := Self;
tv.ReloadTree;
tv.IncludeFiles.Clear;
// 把功能权限列表的URL转换成FileName的形式
TSystemUtils.URLs2Files(lFuncURLs, tv.IncludeFiles);
tv.UseIncludeFiles := True;
ExpandBizTree(tv);
CopyTreeToNode(TTreeView(tv), lNode);
tvFuncTree.Images := tv.Images;
finally
tv.Free;
end;
lFuncURLs.Free;
end;
end;
// 根据节点查找岗位环境
function TMyMainForm.FindContext(ANode: TTreeNode): TContext;
var
lNode: TTreeNode;
begin
Result := nil;
lNode := ANode;
while (lNode<>nil) do
begin
if (lNode.Data<>nil) and (lNode.Data is TOperatorPosition) then
begin
Result := (lNode.Data as TOperatorPosition).Context;
Break;
end;
lNode := lNode.Parent;
end;
end;
// 运行功能
procedure TMyMainForm.tvFuncTreeClick(Sender: TObject);
var
lNode: TTreeNode;
begin
lNode := tvFuncTree.Selected;
if lNode=nil then Exit;
if lNode.Data is TOperatorFuncItem then
RunFunc(lNode, (lNode.Data as TOperatorFuncItem).FuncURL.URL)
else if lNode.Data is TOrgFuncAllocItem then
RunFunc(lNode, (lNode.Data as TOrgFuncAllocItem).FuncURL)
else if (lNode.Data is TBizNode) and (TBizNode(lNode.Data).NodeKind = TBizObjectKind.boFunc) then
RunFunc(lNode, (lNode.Data as TBizNode).BizURL.URL);
end;
procedure TMyMainForm.RunFunc(ANode: TTreeNode; AFuncURL: String);
var
lContext: TContext;
begin
if FCurrentFunc<>nil then
TSystemCore.FuncManager.TerminateFunc(FCurrentFunc, False);
lContext := FindContext(ANode);
CurrentFunc := TSystemCore.FuncManager.RunFunc(lContext, '', AFuncURL, '', nil, False);
end;
procedure TMyMainForm.SetCurrentFunc(Value: TFunc);
begin
if FCurrentFunc=Value then Exit;
FCurrentFunc := Value;
if FCurrentFunc.MainForm<>nil then
begin
FCurrentFunc.MainForm.BorderIcons := [];
FCurrentFunc.MainForm.Caption := '';
FCurrentFunc.MainForm.Align := TAlign.alClient;
FCurrentFunc.MainForm.BorderStyle := TFormBorderStyle.bsNone;
FCurrentFunc.MainForm.FormStyle := TFormStyle.fsNormal;
FCurrentFunc.MainForm.Parent := pnlMain;
ReloadRelevancyNavBar;
end;
end;
//业务关联相关
procedure TMyMainForm.ReloadRelevancyNavBar;
var
lRelevancyViewNavBar: TRelevancyViewNavBar;
lRefreshRelevanciesMessage: TRefreshRelevanciesMessage;
lReloadRelevanciesMessage: TReloadRelevanciesMessage;
begin
if TRelevancyManager.IsShowRelevancyNavBar(Context, FCurrentFunc.BizClassURL.BizURL.URL) then
begin
FRelevancyNavBar.Clear;
lRefreshRelevanciesMessage := TRefreshRelevanciesMessage.Create(FRelevancyNavBar);
try
if not FCurrentFunc.Context.SendMessage(lRefreshRelevanciesMessage) then
DefaultRefreshRelevancies(FRelevancyNavBar);
finally
lRefreshRelevanciesMessage.Free;
end;
if FCurrentFunc <> nil then
begin
lRelevancyViewNavBar := TRelevancyViewNavBar.Create(FRelevancyNavBar);
lReloadRelevanciesMessage := TReloadRelevanciesMessage.Create(lRelevancyViewNavBar);
try
FCurrentFunc.Context.SendMessage(lReloadRelevanciesMessage);
finally
lReloadRelevanciesMessage.Free;
end;
end;
end;
end;
//加载缺省的业务关联
procedure TMyMainForm.DefaultRefreshRelevancies(ANavBar: TRelevancyNavBar);
var
I, J: Integer;
lInfo: TInfo;
begin
for I := 0 to FCurrentFunc.Context.ChildCount - 1 do
if FCurrentFunc.Context.Children[I].Owner is TInfo then
begin
lInfo := FCurrentFunc.Context.Children[I].Owner as TInfo;
for J := 0 to lInfo.DataSetCount - 1 do
begin
if lInfo.DataSets[J].Active then
ANavBar.BindDataSet(lInfo.DataSets[J]);
end;
end;
ANavBar.ReloadRelevancies(FCurrentFunc.Context, FCurrentFunc.BizClassURL.BizURL.URL);
end;
end. |
楼主
发表于 2008-6-24 11:26:39