⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 wnusermanager.pas

📁 个人写的一个操作员管理部分
💻 PAS
字号:
unit WnUserManager;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Mask, DBCtrls, Db, DBTables, Grids, DBGrids, Menus, ComCtrls,
  ExtCtrls, ImgList,Variants;
  
const
  cNoUsePostNo = 'NoUse';

type
  TFmUserManager = class(TForm)
    mmTest: TMainMenu;
    N1: TMenuItem;
    miUserDefine: TMenuItem;
    Panel1: TPanel;
    combPrograms: TComboBox;
    Label1: TLabel;
    N3: TMenuItem;
    miAddPost: TMenuItem;
    miDelPost: TMenuItem;
    miModiPost: TMenuItem;
    Panel2: TPanel;
    Splitter1: TSplitter;
    Panel3: TPanel;
    gbPosts: TGroupBox;
    dbgPosts: TDBGrid;
    pcRightAndUser: TPageControl;
    tsRight: TTabSheet;
    tvGrant: TTreeView;
    tsUser: TTabSheet;
    dbgUser: TDBGrid;
    N7: TMenuItem;
    miAddPostUser: TMenuItem;
    miDelPostUser: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    dsPosts: TDataSource;
    dsUserPost: TDataSource;
    ilTreeView: TImageList;
    PopupMenu1: TPopupMenu;
    PopupMenu2: TPopupMenu;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    procedure miUserDefineClick(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure combProgramsChange(Sender: TObject);
    procedure dsPostsDataChange(Sender: TObject; Field: TField);
    procedure miAddPostClick(Sender: TObject);
    procedure miDelPostClick(Sender: TObject);
    procedure miModiPostClick(Sender: TObject);
    procedure miAddPostUserClick(Sender: TObject);
    procedure miDelPostUserClick(Sender: TObject);
    procedure tvGrantMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
  private

    { Private declarations }
  public
    CurrentProgramId : Integer;
    CurrentCenterCode : string;
    slProgramId : TStringList;
    InputProgramId : Integer;
    procedure InitGrant;
    procedure DisplayGrant(PostNo : String);
    procedure ChangeRight(postno : string);
    procedure ChangeGrant(item : TTreeNode;postno : string);
    procedure ChangeParent(Item :TTreeNode;postno:string);
    { Public declarations }
  end;

var
  FirstLogin : Boolean=True;
  FmUserManager: TFmUserManager;

implementation
  uses WnAddUsers,DnUserManager,WnAddPost,UnDlgShell,WnAddPostUser;
{$R *.DFM}
procedure TFmUserManager.miUserDefineClick(Sender: TObject);
begin
  FmAddUsers := TFmAddUsers.Create(Self);
  try
    FmAddUsers.CurrentCenterCode := CurrentCenterCode;
    FmAddUsers.ShowModal;
  finally
    FmAddUsers.Free;
  end;
end;

procedure TFmUserManager.N12Click(Sender: TObject);
begin
  Close;
end;

procedure TFmUserManager.N2Click(Sender: TObject);
begin
  //Collect(1);
end;

procedure TFmUserManager.FormShow(Sender: TObject);
begin
  slProgramId := TStringList.Create;
  try
    with dmUserManager.qryPrograms do
    begin
      Open;
      First;
      While not eof do
      begin
        slProgramId.Add(FieldByName('programid').AsString);
        combPrograms.Items.Add(FieldByName('programname').AsString);
        Next;
      end;
    end;
  finally
    if dmUserManager.qryPrograms.Active then
      dmUserManager.qryPrograms.Close;
  end;
  combPrograms.ItemIndex := 0;
  combProgramsChange(Sender);
end;

procedure TFmUserManager.combProgramsChange(Sender: TObject);
begin
  //改变当前程序代码
  CurrentProgramId := StrToInt(slProgramId.Strings[combPrograms.ItemIndex]);
  //显示相应程序的岗位
  with dmUserManager.qryPosts do begin
    if Active then
      Close;
    Prepare;
    ParamByName('programid').AsInteger := CurrentProgramId;
    ParamByName('centercode').AsString := CurrentCenterCode;
    Open;
  end;
  //建立相应程序的权限树。
  InitGrant;
  //显示相应岗位的权限
  DisplayGrant(dmUserManager.qryPosts.FieldByName('postno').AsString);
  tvGrant.FullExpand;
end;

procedure TFmUserManager.dsPostsDataChange(Sender: TObject; Field: TField);
begin
  if dsPosts.DataSet.IsEmpty then
  begin
    with dmUserManager.qryUserPost do
    begin
      if Active then
        Close;
      Prepare;
      ParamByName('ProgramId').AsInteger := 100;
      ParamByName('PostNo').AsString  := cNoUsePostNo;
      ParamByName('CenterCode').AsString := CurrentCenterCode;
      Open;
    end;
    DisplayGrant(cNoUsePostNo);
    Exit;
  end;

  //显示相应岗位的权利
  if not (dsPosts.DataSet.State in [dsedit,dsinsert]) then
    DisplayGrant(dmUserManager.qryPosts.FieldByName('postno').AsString);

  //显示岗位操作员
  with dmUserManager.qryUserPost do
  begin
    if Active then
      Close;
    Prepare;
    ParamByName('programid').AsInteger := CurrentProgramId;
    ParamByName('postno').AsString := dmUserManager.qryPosts.FieldByName('postno').AsString;
    ParamByName('CenterCode').AsString := CurrentCenterCode;
    Open;
  end;
end;

procedure TFmUserManager.InitGrant;
var
  parents:array[0..99] of TTreeNode;
  level : Integer;
  aNode : TTreeNode;
begin
  level := 0;
  with dmUserManager.qryMenus,tvGrant do
  begin
    if Active then
      Close;
    Prepare;
    ParamByName('programid').AsInteger := CurrentProgramId;
    Open;
    First;
    Items.Clear;
    aNode := tvGrant.Items.AddChild(nil,combPrograms.Text);
    Parents[0] := aNode;
    aNode.SelectedIndex := 2;
    aNode.ImageIndex := 2;
    while not eof do
    begin
      Level := FieldByName('classno').AsInteger;
      aNode := Items.AddChild(Parents[Level-1],FieldByName('menuname').AsString);
      aNode.SelectedIndex := 1;
      aNode.ImageIndex := 1;
      Parents[Level] := aNode;
      Next;
    end;
    Close;
  end;
end;

procedure TFmUserManager.miAddPostClick(Sender: TObject);
begin
  FmAddPost := TFmAddPost.Create(Self);
  try
    FmAddPost.AddPost;
  finally
    FmAddPost.Free;
  end;
end;

procedure TFmUserManager.miDelPostClick(Sender: TObject);
begin
  if (not dmUserManager.qryPosts.Active) or (dmUserManager.qryPosts.IsEmpty) then
    Exit;
  if Ask('是否删除当前选中的岗位') then
  begin
    dmUserManager.UserManager.StartTransaction;
    try
      with dmUserManager do
      begin
        DelUserPost.Prepare;
        DelUserPost.ParamByName('postno').AsString := qryPosts.FieldByName('postno').AsString;
        DelUserPost.ParamByName('centercode').AsString := CurrentCenterCode;
        DelUserPost.ExecSQL;
        DelPostMenus.Prepare;
        DelPostMenus.ParamByName('postno').AsString := qryPosts.FieldByName('postno').AsString;
        DelPostMenus.ParamByName('centercode').AsString := CurrentCenterCode;
        DelPostMenus.ExecSQL;
        qryPosts.Delete;
        qryPosts.ApplyUpdates;
        UserManager.Commit;
        qryPosts.CommitUpdates;
      end;
    except

      on  E : exception do
      begin
        dmUserManager.UserManager.Rollback;
        ShowError(e.Message);
      end;

      //ShowError('数据库出错导致删除失败');
    end;
  end;
end;

procedure TFmUserManager.miModiPostClick(Sender: TObject);
begin
  FmAddPost := TFmAddPost.Create(Self);
  try
    FmAddPost.ModiPost;
  finally
    FmAddPost.Free;
  end;
end;

procedure TFmUserManager.miAddPostUserClick(Sender: TObject);
begin
  //增加岗位操作员
  with dmUserManager do
   begin
     if not qryPosts.Active then
       Exit;
     if qryPosts.IsEmpty then
       Exit;
   end;
  FmAddPostuser := TFmAddPostuser.Create(Self);
  try
    FmAddPostuser.ShowModal;
    dmUserManager.qryUserPost.Close;
    dmUserManager.qryUserPost.Open;
  finally
    FmAddPostuser.Free;
  end;
end;

procedure TFmUserManager.miDelPostUserClick(Sender: TObject);
begin
  //删除岗位操作员
  if dsUserPost.DataSet.IsEmpty then
    Exit;
  with dmUserManager.delProgramPostUser do
  begin
    ParamByName('programid').AsInteger := CurrentProgramId;
    ParamByName('userno').AsString := dmUserManager.qryUserPost.FieldByName('userno').AsString;
    ParamByName('centercode').AsString := CurrentCenterCode; 
    ExecSQL;
  end;
  with dmUserManager.qryUserPost do
  begin
    Close;
    Open;
  end;
end;

procedure TFmUserManager.DisplayGrant(PostNo: String);
var
  I : integer;
begin
  with dmUserManager.qryPostMenus,tvGrant do
  begin
    if Active then
      Close;
    Prepare;
    ParamByName('postno').AsString := PostNo;
    ParamByName('centercode').AsString := CurrentCenterCode;
    Open;
    for I:= 1  to Items.Count - 1 do
    begin
      if Locate('postno;menuno',vararrayof([Postno,I]),[]) then
      begin
        Items[I].SelectedIndex := 1;
        Items[I].ImageIndex := 1;
      end else
      begin
        Items[I].SelectedIndex := 0;
        Items[I].ImageIndex := 0;
      end;
    end;
    Refresh;
  end;
end;

procedure TFmUserManager.ChangeRight(postno:string);
var
  I : Integer;
  ANode : TTreeNode;
begin
  if tvGrant.Selected.AbsoluteIndex = 0 then
    Exit;
  with tvGrant,dmUserManager do
  begin
    tvGrant.Update;
    Selected.SelectedIndex := (Selected.SelectedIndex +1 ) mod 2;
    Selected.ImageIndex := (Selected.ImageIndex + 1 ) mod 2;
    I := Selected.AbsoluteIndex;
    if (Selected.ImageIndex = 0) and (qryPostMenus.Locate('postno;menuno',vararrayof([postno,i]),[]))then
    begin
      qryPostMenus.Delete;
      qryPostMenus.ApplyUpdates;
    end;
    if Selected.ImageIndex = 1 then
    begin
      if not qryPostMenus.Locate('centercode;postno;menuno',vararrayof([CurrentCenterCode,postno,i]),[]) then
      begin
        qryPostMenus.AppendRecord([CurrentCenterCode,postno,I]);
        qryPostMenus.ApplyUpdates;
      end;
      //递归根结点
      ANode := tvGrant.Selected.Parent;
      ChangeParent(ANode,postno);
    end;
  end;
  //调用递归程序;
  ChangeGrant(tvGrant.Selected,postno);
end;

procedure TFmUserManager.ChangeGrant(item: TTreeNode; postno: string);
var
  i,imenuno : Integer;
begin
  //递归结点子项。
  tvGrant.Update;
  with dmUserManager.qryPostMenus do
  begin
    for i := 0 to item.Count - 1  do
    begin
      if (item.SelectedIndex=0) and (item.Item[I].SelectedIndex=1) then
      begin
        imenuno := item.Item[I].AbsoluteIndex;
        if Locate('postno;menuno',vararrayof([postno,imenuno]),[]) then
        begin
          Delete;
          ApplyUpdates;
          //CommitUpdates;
        end;
      end;
      if (item.SelectedIndex=1) and (item.Item[I].SelectedIndex=0) then
      begin
        imenuno := item.Item[I].AbsoluteIndex;
        if not Locate('postno;menuno',vararrayof([postno,imenuno]),[]) then
        begin
          AppendRecord([CurrentCenterCode,postno,imenuno]);
          ApplyUpdates;
          //CommitUpdates;
        end;
      end;
      item.Item[I].SelectedIndex := item.SelectedIndex;
      item.Item[I].ImageIndex := item.ImageIndex;
      ChangeGrant(item.Item[I],postno);
    end;
  end;
  tvGrant.Refresh;
end;

procedure TFmUserManager.tvGrantMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var
  ClickedItem : THitTests;
begin
   with dmUserManager do
   begin
     if not qryPosts.Active then
       Exit;
     if qryPosts.IsEmpty then
       Exit;
   end;
   if button<>mbleft then
     Exit;
   ClickedItem := tvGrant.GetHitTestInfoAt(x,y);
   //if (htOnLabel  in ClickedItem) or
   if   htOnIcon in clickedItem   then
   begin
     tvGrant.Selected := tvGrant.GetNodeAt(x,y);
    if tvGrant.Focused then
      ChangeRight(dmUserManager.qryPosts.FieldByName('postno').AsString);
   end;
end;

procedure TFmUserManager.FormClose(Sender: TObject;
var
  Action: TCloseAction);
begin
  with dmUserManager do
  begin
    if qryUsers.Active then
      qryUsers.Close;
    if qryAvailUsers.Active then
      qryAvailUsers.Close;
    if qryMenus.Active then
      qryMenus.Close;
    if qryPostMenus.Active then
      qryPostMenus.Close;
    if qryPosts.Active then
      qryPosts.Close;
    if qryPrograms.Active then
      qryPrograms.Close;
    if qryUserPost.Active then
      qryUserPost.Close;
  end;

end;

procedure TFmUserManager.ChangeParent(Item: TTreeNode; postno: string);
var
  I : Integer;
begin
  if Item.AbsoluteIndex= 0 then
    Exit;
  with dmUserManager,tvGrant do
  begin
    Item.ImageIndex := 1;
    Item.SelectedIndex := 1;
    I := Item.AbsoluteIndex;
    if not qryPostMenus.Locate('postno;menuno',vararrayof([postno,i]),[]) then
    begin
      qryPostMenus.AppendRecord([CurrentCenterCode,postno,I]);
      qryPostMenus.ApplyUpdates;
    end;
    ChangeParent(Item.Parent,postno);
  end;
end;

procedure TFmUserManager.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if key = #27 then
  begin
    FmUserManager.Close;
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -