privilegefrm.~pas

群星医药系统源码

        First;
        while not Eof do
        begin
          Node := vTreePriv.AddChild(nil);
          NodeData := vTreePriv.GetNodeData(Node);
          NodeData^.ModuleID := -Fields[0].AsInteger;
          NodeData^.Popedoms := '$';
          NodeData^.MenuName := Fields[1].AsString;
          Next;
        end;
      end;
      Exit;
    end;//end of 建立 "价格体系授权" 树
  end else begin
    ParentData := vTreePriv.GetNodeData(pNode);
    iParentID := ParentData^.ModuleID;
    sPriv := UpperCase(ParentData^.Popedoms);
    if sPriv<>'' then begin//如果是一个确切的功能授权(即最底层子菜单)，则根据其设定的权限项生成子节点
      k := Length(sPriv);
      vTreePriv.ChildCount[pNode] := k;
      Node := pNode.FirstChild;
      for i:=1 to k do begin
        if Node=nil then
          Break;
        vTreePriv.ChildCount[Node] := 0;
        NodeData := vTreePriv.GetNodeData(Node);
        NodeData^.ModuleID := -ParentData^.ModuleID;//最末级节点的ModuleID设为负数，方便判断
        NodeData^.Popedoms := sPriv[i];
        NodeData^.MenuName := GetPrivName(sPriv[i]);
        Node := Node.NextSibling;
      end;
      Exit;
    end;
  end;
  //如果是最底层子菜单项，则上面的处理完成后会跳出，否则将建立下面的子项
  with FDataSet do begin
    FetchParams;
{这里也可以象下面一样动态的建立参数查询：
    Params.CreateParam(ftInteger, 'ParentID', ptInput);
}
    Params.ParamByName('ParentID').Value := iParentID;
    Open;
    k := RecordCount;
    if pNode=nil then begin
      vTreePriv.Clear;
      vTreePriv.RootNodeCount := k;
      Node := vTreePriv.GetFirst;
    end else begin
      if k=0 then
        k := Length(FieldByName('Popedoms').AsString);
      vTreePriv.ChildCount[pNode] := k;
      Node := pNode.FirstChild;
    end;
    while Node<>nil do begin
      vTreePriv.ChildCount[Node] := 0;
      NodeData := vTreePriv.GetNodeData(Node);
      AssignNodeData(NodeData, FDataSet);

      BuildChildNode(Node);
      Next;
      Node := vTreePriv.GetNextSibling(Node);
    end;
  end;
end;

procedure TFmPrivilege.TabSet1Change(Sender: TObject; NewTab: Integer;
  var AllowChange: Boolean);
begin
  if CurrUserID='' then Exit;
  AllowChange := SaveUserPrivChange(false)>=0;
  if not AllowChange then Exit;
  if NewTab=0 then//如果是选中价格体系授权
    TabSet1.Tag := 0 
  else
    TabSet1.Tag := TabModuleIDs[NewTab];
  vTreePriv.BeginUpdate;
  try
    BuildChildNode(nil);
    InitNodeCheckState(nil);
  finally
    vTreePriv.EndUpdate;
  end;
end;

procedure TFmPrivilege.vTreePrivGetNodeDataSize(Sender: TBaseVirtualTree;
  var NodeDataSize: Integer);
begin
  NodeDataSize := SizeOf(TModuleData);
end;

procedure TFmPrivilege.vTreePrivGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
var
  NodeData: PModuleData;
begin
  CellText := '';
  NodeData := Sender.GetNodeData(Node);
  case Column of
    0://ModuleID
      CellText := NodeData^.MenuName;
    1:
      begin//ParentID
        CellText := NodeData^.Popedoms;
      end;
    2: //DispType
      CellText := NodeData^.Remark;
  end;
end;

procedure TFmPrivilege.vTreePrivBeforeItemErase(Sender: TBaseVirtualTree;
  Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect;
  var ItemColor: TColor; var EraseAction: TItemEraseAction);
begin
//同一级的各节点间用颜色背景分隔
  if Odd(Node.Index) then begin
    ItemColor := $FFEEEE;
    EraseAction := eaColor;
  end;
end;

function TFmPrivilege.GetPrivName(PrivChar: Char): String;
var i, k: Integer;
begin
  k := Length(c_PrivChars);
  for i:=0 to k-1 do begin
    if c_PrivChars[i]=PrivChar then begin
      Result := c_PrivNames[i];
      Exit;
    end;
  end;
end;

procedure TFmPrivilege.vTreePrivInitNode(Sender: TBaseVirtualTree;
  ParentNode, Node: PVirtualNode;
  var InitialStates: TVirtualNodeInitStates);
begin
  Node.CheckType := ctCheckBox;
end;

procedure TFmPrivilege.vTreePrivChecking(Sender: TBaseVirtualTree;
  Node: PVirtualNode; var NewState: TCheckState; var Allowed: Boolean);
begin
  if Node.CheckState=csMixedNormal then begin
    if MouseState=mbLeft then
      NewState := csCheckedNormal
    else
      NewState := csUnCheckedNormal;
  end;
  Allowed := not (Node.CheckState in PressedCheckState);
end;

procedure TFmPrivilege.vTreePrivChecked(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
begin
  SetChildNodeCheckState(Node, Node.CheckState);
  ResetNodeCheckState(Node{.Parent});
  vTreePriv.Refresh;
end;

//根据当前节点所有子节点的CheckState重新设置当前节点的CheckState，自动递归
procedure TFmPrivilege.ResetNodeCheckState(Node: PVirtualNode);
var	vNode: PVirtualNode;
    k, j: Integer;
begin
  if Node=nil then Exit;
  j := 0;
  k := Node.ChildCount;//vTreePriv.ChildCount[Node];
  if k>0 then begin
    vNode := Node.FirstChild;
    while vNode<>nil do begin
      case vNode.checkState of
        csCheckedNormal, csCheckedPressed:
          Inc(j);
        csMixedPressed, csMixedNormal:
        begin
          Node.CheckState := csMixedNormal;
          vNode := Node.Parent;
          while vNode<>nil do begin
            vNode.CheckState := csMixedNormal;
            vNode := vNode.Parent;
          end;
          Exit;
        end;
      end;
      vNode := vNode.NextSibling;
    end;
    if j=0 then
      Node.CheckState := csUncheckedNormal
    else if j=k then
      Node.CheckState := csCheckedNormal
    else
      Node.CheckState := csMixedNormal;
  end;
  if (Node.Parent<>nil)and(Node.Parent<>vTreePriv.RootNode) then
    ResetNodeCheckState(Node.Parent);
end;

procedure TFmPrivilege.SetChildNodeCheckState(pNode: PVirtualNode;
  ckState: TCheckState);
var vNode: PVirtualNode;
    k, j: Integer;
begin
  j := 0;
  k := vTreePriv.ChildCount[pNode];
  if k = 0 then Exit;
  vNode := pNode.FirstChild;
  while vNode<>nil do begin
    if not(vNode.CheckState in PressedCheckState) then begin
      vNode.checkState := CkState;
      SetChildNodeCheckState(vNode, CkState);
    end;
    if j>=0 then begin
      case vNode.CheckState of
				csCheckedNormal, csCheckedPressed:
          Inc(j);
        csMixedNormal, csMixedPressed:
          j := -1;
      end;
    end;
    vNode := vNode.NextSibling;
  end;
  if j=-1 then
    pNode.CheckState := csMixedNormal
  else if j=k then
    pNode.CheckState := csCheckedNormal
  else
    pNode.CheckState := csUnCheckedNormal;
end;

procedure TFmPrivilege.dbgUserDblClick(Sender: TObject);
begin
  if not cdsUsers.IsEmpty then begin
    InitCurrUserPriv(cdsUsers.Fields[0].AsString, cdsUsers.Fields[1].AsString, false);
  end;
end;

procedure TFmPrivilege.cdsUsersAfterScroll(DataSet: TDataSet);
var Item: TListItem;
    UserID, UserName: String;
    RoleOfUser: Variant;
    i: Integer;
begin
  if dbgUser.Focused then begin
    UserID := cdsUsers.Fields[0].AsString;
    UserName := cdsUsers.Fields[1].AsString;
    if CurrUserID='' then
      InitCurrUserPriv(UserID, UserName, false);
    plUserRole.Caption := '用户['+UserName+']拥有的角色：';
    lvUserRole.Items.Clear;
//下面的代码是调用应用程序服务器的接口过程用可变的二维数组来获取用户的角色
    SvrSysManage.AppServer.GetRoleOfUser(IFmMain.IFmMainEx.ClientID, UserID, RoleOfUser);
    if (not VarIsNull(RoleOfUser))and(VarArrayDimCount(RoleOfUser)=2) then begin
      for i:=VarArrayLowBound(RoleOfUser, 1) to VarArrayHighBound(RoleOfUser, 1) do begin
        Item := lvUserRole.Items.Add;
        Item.Data   := Pointer(Integer(RoleOfUser[i, 0]));
        Item.Caption:= VarToStr(RoleOfUser[i, 1]);
      end;
    end;
  end;
end;

procedure TFmPrivilege.lvPrivRoleDblClick(Sender: TObject);
var Item: TListItem;
begin
  Item := (Sender as TListView).Selected;
  if Item<>nil then begin
    InitCurrUserPriv(IntToStr(Integer(Item.Data)), Item.Caption, true);
  end;
end;

procedure TFmPrivilege.InitCurrUserPriv(UserID, UserName: String;
  IsRole: Boolean; TabChanged: Boolean);
begin
  if (not bInitComplete)or(UserID='') then Exit;
  if (CurrUserID<>'')then
  begin
    if SaveUserPrivChange(false)=-1 then
      Exit;
  end;
  Enabled := false;
  Cursor := crSQLWait;
  CurrUserID := UserID;
  CurrUserName := UserName;
  bRole := IsRole;
  try
    if bRole then begin
      ImgUser.Picture.Bitmap.Assign(BtnRole.Glyph);
      lbCurrUser.Font.Color := clRed;
      lbCurrUser.Caption := '为角色"'+CurrUserName+'"分配权限：';
      cdsPrivilege := cdsPrivRoleDtl;
    end else begin
      ImgUser.Picture.Bitmap.Assign(BtnUser.Glyph);
      lbCurrUser.Font.Color := clBlue;
      lbCurrUser.Caption := '为用户"'+CurrUserName+'"分配权限：';
      //下面读取用户权限
      cdsUserPriv.Params.ParamByName('UserID').Value := UserID;
      cdsUserPriv.Params.ParamByName('Kind').Value := 0;
      if cdsUserPriv.Active then
        cdsUserPriv.Refresh
      else
        cdsUserPriv.Open;
      cdsPrivilege := cdsUserRealPriv;//end of 读取用户权限
    end;
    //下面读取角色(用户真正拥有)的权限，取决于前面对cdsPrivilege的赋值
    cdsPrivilege.Params.Items[0].Value := UserID;
    if cdsPrivilege.Active then
      cdsPrivilege.Refresh
    else
      cdsPrivilege.Open;//end of 读取角色权限
    if (TabSet1.Tabs.Count>0)and(TabSet1.TabIndex<0) then
      TabSet1.TabIndex := 0
    else begin
      vTreePriv.BeginUpdate;
      try
        InitNodeCheckState(nil);
      finally
        vTreePriv.EndUpdate;
      end;
    end;
  finally
    Enabled := true;
		Cursor := crDefault;
  end;
end;

procedure TFmPrivilege.InitNodeCheckState(pNode: PVirtualNode);
const CkState: Array[0..2] of TCheckState= (csUncheckedNormal,csCheckedNormal,csCheckedPressed);
var n, j, iChecked, iCount, i1, i2, k: Integer;
    str: String;
    bHavMixed: Boolean;
    aNode, vNode: PVirtualNode;
    NodeData: PModuleData;
begin
  if pNode=nil then
    aNode := vTreePriv.GetFirst
  else
    aNode := pNode.FirstChild;
  if TabSet1.Tag=0 then//如果选中的是"价格体系授权"
  begin
    while aNode<>nil do
    begin
      NodeData := vTreePriv.GetNodeData(aNode);
      if cdsPrivilege.Locate('ModuleID', NodeData^.ModuleID, []) then
        str := cdsPrivilege.FieldByName('PrivChar').AsString
      else
        str := '';
      n := AnsiPos(NodeData^.Popedoms, str);
      if n=0 then
        aNode.CheckState := csUnCheckedNormal//无此权限
      else
      begin
        j := AnsiPos(';', str);
        if n<j then
          aNode.CheckState := csCheckedPressed //从属的角色中有此权限
        else
          aNode.CheckState := csCheckedNormal;
      end;
      aNode := aNode.NextSibling;
    end;
    Exit;
  end;
  iChecked := 0;
  iCount := 0;
  bHavMixed := false;
  while aNode<>nil do
  begin
    inc(iCount);
    if (vTreePriv.ChildCount[aNode]=0) then
    begin
      aNode.CheckState := csUncheckedPressed;
    end else
    begin
      NodeData := vTreePriv.GetNodeData(aNode);
      if NodeData^.Kind=-2 then
      begin//连接到功能模块的节点
        if cdsPrivilege.Locate('ModuleID', NodeData^.ModuleID, []) then
          str := cdsPrivilege.FieldByName('PrivChar').AsString
        else
          str := '';
        i1:= 0;
        i2:= 0;
        k := 0;
        vNode := aNode.FirstChild;
        while vNode<>nil do
        begin
          Inc(k);
          NodeData := vTreePriv.GetNodeData(vNode);
          n := AnsiPos(NodeData^.Popedoms, str);
          if n=0 then
            NodeData^.Kind := 0 //无此权限
          else
          begin
            j := AnsiPos(';', str);
            if n<j then
            begin
              inc(i2);
              NodeData^.Kind := 2; //从属的角色中有此权限
            end
            else
            begin
              inc(i1);
              NodeData^.Kind := 1;//直接拥有此权限
            end;
          end;
          vNode.CheckState := CkState[NodeData^.Kind];
          vNode := vNode.NextSibling;
        end;
        if i2=k then
          aNode.CheckState := csCheckedPressed
        else if i1+i2=k then
          aNode.CheckState := csCheckedNormal
        else if i1+i2=0 then
          aNode.CheckState := csUncheckedNormal
        else
          aNode.CheckState := csMixedNormal;
      end else
      begin//没有连接到功能模块的中间层节点(Kind=-1)
        InitNodeCheckState(aNode);
      end;
    end;
    if aNode.CheckState in [csCheckedNormal, csCheckedPressed] then
      inc(iChecked)