roleset.pas

来自「一个电力企业的后台管理程序」· PAS 代码 · 共 458 行

unit RoleSet;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DBTables, Db, Grids, DBGrids, ExtCtrls, ImgList, ActnList, DBCtrls,
  StdCtrls, Mask, Buttons, ComCtrls, ToolWin, Menus;
type
  PAuthList = ^AuthList;
  AuthList = record
    BitNo: string;
    Name: string;
  end;
  
type
  TForm_RoleSet = class(TForm)
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    btnInsert: TToolButton;
    btnPost: TToolButton;
    btnModify: TToolButton;
    stb_Main: TStatusBar;
    DBGrid1: TDBGrid;
    Splitter1: TSplitter;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    btnToShAuth: TSpeedButton;
    btnTohAuth: TSpeedButton;
    btnToSnhAuth: TSpeedButton;
    btnTonhAuth: TSpeedButton;
    EdRoleName: TDBEdit;
    lbhauth: TListBox;
    lbnhauth: TListBox;
    Panel4: TPanel;
    Panel5: TPanel;
    NavRole: TDBNavigator;
    btndelete: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    btnquit: TToolButton;
    ActionList1: TActionList;
    ActInsert: TAction;
    ActPost: TAction;
    ActModify: TAction;
    ActDelete: TAction;
    ImageList1: TImageList;
    ActQuit: TAction;
    ActFirst: TAction;
    ActPrior: TAction;
    ActNext: TAction;
    ActLast: TAction;
    Label2: TLabel;
    EdRoleNote: TDBEdit;
    DsRole: TDataSource;
    tblRole: TTable;
    QryAuth: TQuery;
    procedure btnInsertClick(Sender: TObject);
    procedure btnPostClick(Sender: TObject);
    procedure btnModifyClick(Sender: TObject);
    procedure btndeleteClick(Sender: TObject);
    procedure btnquitClick(Sender: TObject);
    procedure MFirstClick(Sender: TObject);
    procedure MPirorClick(Sender: TObject);
    procedure MNextClick(Sender: TObject);
    procedure MLastClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure tblRoleBeforeInsert(DataSet: TDataSet);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure tblRoleAfterScroll(DataSet: TDataSet);
    procedure btnTonhAuthClick(Sender: TObject);
    procedure btnTohAuthClick(Sender: TObject);
    procedure btnToShAuthClick(Sender: TObject);
    procedure btnToSnhAuthClick(Sender: TObject);
    procedure tblRoleBeforePost(DataSet: TDataSet);
    procedure tblRoleNewRecord(DataSet: TDataSet);
    procedure tblRolePostError(DataSet: TDataSet; E: EDatabaseError;
      var Action: TDataAction);
    procedure tblRoleBeforeScroll(DataSet: TDataSet);
  private
    { Private declarations }
      AuthList: TList;
      AuthStr:String;
      AuthChange:Boolean;
  public
    { Public declarations }
  end;

  function FillWidth(Ch:Char;Num:integer):String;
  function SetBit(Str:string;Pos:integer;Ch:Char):string;
  
var
  Form_RoleSet: TForm_RoleSet;
const
  {Declare constants we're interested in}
  eKeyViol = 9729;
  eRequiredFieldMissing = 9732;
  eForeignKey = 9733;
  eDetailsExist = 9734;

implementation
uses SystemPH;
{$R *.DFM}
function FillWidth(Ch:Char;Num:integer):String;
var
  i:integer;
  ReStr:string;
begin
  ReStr:='';
  for i:=0 to Num do
  begin
      ReStr:=ReStr+Ch;
  end;
  Result:=ReStr;
end;

function SetBit(Str:string;Pos:integer;Ch:Char):string;
var
 ReStr:string;
begin
  ReStr:=Str;
  ReStr[Pos]:=Ch;
  ReSult:=ReStr;
end;

procedure TForm_RoleSet.btnInsertClick(Sender: TObject);
begin
  tblRole.Append;
  tblRole.FieldByName('RoleName').asstring:=' ';
  tblRole.Post;
  tblRole.Edit;
  EdRoleName.SetFocus;
end;

procedure TForm_RoleSet.btnPostClick(Sender: TObject);
begin
  if not (tblRole.State in [dsEdit,dsInsert]) then tblRole.Edit;
  NavRole.BtnClick(nbPost);
  AuthChange:=False;
  stb_Main.Panels[0].Text:='系统中共有'
                          +inttostr(tblRole.RecordCount)
                          +'个角色.';

end;

procedure TForm_RoleSet.btnModifyClick(Sender: TObject);
begin
  NavRole.BtnClick(nbEdit);
end;

procedure TForm_RoleSet.btndeleteClick(Sender: TObject);
begin
  if Application.MessageBox('是否删除该角色？','提示',mb_yesno)=mrno then exit;
  NavRole.BtnClick(nbDelete);
      stb_Main.Panels[0].Text:='系统中共有'
                          +inttostr(tblRole.RecordCount)
                          +'个角色.';
end;

procedure TForm_RoleSet.btnquitClick(Sender: TObject);
begin
  Close;
end;

procedure TForm_RoleSet.MFirstClick(Sender: TObject);
begin
  NavRole.BtnClick(nbFirst);
end;

procedure TForm_RoleSet.MPirorClick(Sender: TObject);
begin
  NavRole.BtnClick(nbPrior);
end;

procedure TForm_RoleSet.MNextClick(Sender: TObject);
begin
  NavRole.BtnClick(nbNext);
end;

procedure TForm_RoleSet.MLastClick(Sender: TObject);
begin
  NavRole.BtnClick(nbLast);
end;

procedure TForm_RoleSet.FormCreate(Sender: TObject);
var
  ARecord: PAuthList;
begin
  AuthList := TList.Create;
  QryAuth.Close;
  QryAuth.Open;
  while not QryAuth.Eof do
  begin
    New(ARecord);
    ARecord^.BitNo :=QryAuth.fieldbyName('AuthBit').Asstring;
    ARecord^.Name :=QryAuth.Fieldbyname('Explain').Asstring;
    AuthList.Add(ARecord);
    QryAuth.Next ;
  end;
  tblRole.Close;
  tblRole.open;
  stb_Main.Panels[0].Text:='系统中共有'
                          +inttostr(tblRole.RecordCount)
                          +'个角色.';
end;

procedure TForm_RoleSet.tblRoleBeforeInsert(DataSet: TDataSet);
var
  i:integer;
  ARecord:PAuthList;
begin
  lbhAuth.Items.Clear;
  LbnhAuth.Items.Clear;
  for i:=0 to AuthList.Count -1 do
  begin
    ARecord:=AuthList.Items[i];
    LbnhAuth.Items.Add(ARecord^.Name);
  end;
end;

procedure TForm_RoleSet.FormClose(Sender: TObject;
  var Action: TCloseAction);
var
  i:integer;
  ARecord:PAuthList;
begin
  //if screen.FormCount=2 then
  WebIsHide(0);
  for i:=0 to AuthList.Count -1 do
  begin
    ARecord:=AuthList.Items[i];
    Dispose(ARecord);
  end;
  AuthList.Free;
  tblRole.close;
  QryAuth.close;
  Action:=CaFree;
  Form_RoleSet:=nil;
end;

procedure TForm_RoleSet.tblRoleAfterScroll(DataSet: TDataSet);
var
  i,j:integer;
  ARecord:PAuthList;
begin
  lbhAuth.Items.Clear;
  lbnhAuth.Items.Clear;
  AuthStr:=tblRole.FieldbyName('RoleAuth').Asstring;
  if Trim(AuthStr)='' then AuthStr:=FillWidth('0',100);
  for i:=1 to Length(AuthStr) do
  begin
    //查出当前权限位的内容
    for j:=0 to AuthList.Count -1 do
    begin
      ARecord:=AuthList.Items[j];
      if ARecord^.BitNo =IntToStr(i) then break;
    end;

    if j<AuthList.Count then  //找到当前权限位的情况下
    begin
      if Copy(AuthStr,i,1)='1' then     //为'1'时放入已赋予权限列表
        LbhAuth.Items.Add(ARecord^.Name)
      else                              //不为'1'时放入未赋予权限列表
        lbnhAuth.Items.Add(ARecord^.Name);
    end;
  end;
  if lbhAuth.Items.Count >0 then
  begin
    btnToSnhAuth.Enabled :=True;
    btnTonhAuth.Enabled :=True;
  end else
  begin
    btnToSnhAuth.Enabled :=False;
    btnTonhAuth.Enabled :=False;
  end;
  if lbnhAuth.Items.Count >0 then
  begin
    btnToShAuth.Enabled :=True;
    btnTohAuth.Enabled :=True;
  end else
  begin
    btnToShAuth.Enabled :=False;
    btnTohAuth.Enabled :=False;
  end;
end;

procedure TForm_RoleSet.btnTonhAuthClick(Sender: TObject);
var
  i:integer;
begin
  for i:=0 to lbhAuth.Items.Count -1 do
    lbnhAuth.Items.Add(lbhAuth.Items.Strings[i]);

  lbhAuth.Items.Clear ;
  AuthChange:=True;
  if lbhAuth.Items.Count =0 then
  begin
    btnToSnhAuth.Enabled :=False;
    btnTonhAuth.Enabled :=False;
  end;
  if lbnhAuth.Items.Count >0 then
  begin
    btnToShAuth.Enabled :=True;
    btnTohAuth.Enabled :=True;
  end;
end;

procedure TForm_RoleSet.btnTohAuthClick(Sender: TObject);
var
  i:integer;
begin
  for i:=0 to lbnhAuth.Items.Count -1 do
    lbhAuth.Items.Add(lbnhAuth.Items.Strings[i]);

  lbnhAuth.Items.Clear ;
  AuthChange:=True;
  if lbnhAuth.Items.Count =0 then
  begin
    btnToShAuth.Enabled :=False;
    btnTohAuth.Enabled :=False;
  end;
  if lbhAuth.Items.Count >0 then
  begin
    btnToSnhAuth.Enabled :=True;
    btnTonhAuth.Enabled :=True;
  end;
end;

procedure TForm_RoleSet.btnToShAuthClick(Sender: TObject);
var
    i:integer;
begin
    for i:=0 to LbnhAuth.Items.Count -1 do
    begin
        if LbnhAuth.Selected[i] then
        begin
            lbhAuth.Items.Add(LbnhAuth.Items.Strings[i]);
            lbnhAuth.Items.Delete(i);
            AuthChange:=True;
            if lbnhAuth.Items.Count =0 then
            begin
                btnToShAuth.Enabled :=False;
                btnTohAuth.Enabled :=False;
            end;
            if lbhAuth.Items.Count >0 then
            begin
                btnToSnhAuth.Enabled :=True;
                btnTonhAuth.Enabled :=True;

            end;
            break;

        end;

    end;
end;

procedure TForm_RoleSet.btnToSnhAuthClick(Sender: TObject);
var
    i:integer;
begin
    for i:=0 to LbhAuth.Items.Count -1 do
    begin
        if LbhAuth.Selected[i] then
        begin
            lbnhAuth.Items.Add(LbhAuth.Items.Strings[i]);
            lbhAuth.Items.Delete(i);

            AuthChange:=True;
            if lbhAuth.Items.Count =0 then
            begin
                btnToSnhAuth.Enabled :=False;
                btnTonhAuth.Enabled :=False;
            end;
            if lbnhAuth.Items.Count >0 then
            begin
                btnToShAuth.Enabled :=True;
                btnTohAuth.Enabled :=True;
            end;

            break;
        end;

    end;
end;

procedure TForm_RoleSet.tblRoleBeforePost(DataSet: TDataSet);
var
    i,j,Pos:integer;
    RoleNote,TempStr:string;
    ARecord:PAuthList;
begin
    RoleNote:='';
    AuthStr:=FillWidth('0',100);
    for i:=0 to LbhAuth.Items.Count -1 do
    begin
        TempStr:=LbhAuth.Items.Strings[i];
        //在权限列表中找到权限名称
        for j:=0 to AuthList.Count - 1 do
        begin
            ARecord:=AuthList.Items[j];
            if ARecord^.Name = TempStr then break;
        end;
        //把AuthStr中的第（按权限名称找到的权限）位,置为'1'
        if j<AuthList.Count then
        begin
            Pos:=StrToInt(ARecord^.BitNo);
            AuthStr:=SetBit(AuthStr,Pos,'1');
        end;
        RoleNote:=RoleNote+LbhAuth.Items.Strings[i]+'、';
    end;
    Delete(RoleNote,Length(RoleNote)-1,2);
    tblRole.FieldByName('RoleAuth').Asstring:=AuthStr;
    tblRole.FieldByName('RoleNote').AsString:=RoleNote;
end;

procedure TForm_RoleSet.tblRoleNewRecord(DataSet: TDataSet);
begin
    tblRole.FieldByName('RoleAuth').AsString:=FillWidth('0',100);
end;

procedure TForm_RoleSet.tblRolePostError(DataSet: TDataSet;
  E: EDatabaseError; var Action: TDataAction);
var
  iDBIError: Integer;
begin
  if (E is EDBEngineError) then
  begin
    iDBIError := (E as EDBEngineError).Errors[0].Errorcode;
    case iDBIError of
      eRequiredFieldMissing:
        {The EmpNo field is defined as being required.}
        begin
          MessageDlg('角色名称不能为空！', mtWarning, [mbOK], 0);
          Abort;
        end;
      eKeyViol:
        {The primary key is OrderNo}
        begin
          MessageDlg('角色名称重复，请换一个名称！', mtWarning,
            [mbOK], 0);
          Abort;
        end;
    end;
  end;
end;

procedure TForm_RoleSet.tblRoleBeforeScroll(DataSet: TDataSet);
begin

    if AuthChange=True then
    begin
        btnPost.Click;
    end;
end;

end.