roleset.~pa

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

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
  TFormRoleSet = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    MFirst: TMenuItem;
    MPiror: TMenuItem;
    MNext: TMenuItem;
    MLast: TMenuItem;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    btnInsert: TToolButton;
    btnPost: TToolButton;
    btnModify: TToolButton;
    StatusBar1: 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;
    N12: TMenuItem;
    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 ShowHint(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
  FormRoleSet: TFormRoleSet;
const
  {Declare constants we're interested in}
  eKeyViol = 9729;
  eRequiredFieldMissing = 9732;
  eForeignKey = 9733;
  eDetailsExist = 9734;

implementation
uses DataDb;
{$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 TFormRoleSet.btnInsertClick(Sender: TObject);
begin
    NavRole.BtnClick(nbInsert);
    EdRoleName.SetFocus;
end;
procedure TFormRoleSet.ShowHint(Sender: TObject);
begin
    if Length(Application.hint)>0 then
    begin
        Statusbar1.SimplePanel :=True;
        Statusbar1.SimpleText :=Application.Hint;
    end else
    begin
        Statusbar1.SimplePanel :=False;
    end;

end;
procedure TFormRoleSet.btnPostClick(Sender: TObject);
begin
    if not (tblRole.State in [dsEdit,dsInsert]) then tblRole.Edit;
    NavRole.BtnClick(nbPost);
    AuthChange:=False;
end;

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

procedure TFormRoleSet.btndeleteClick(Sender: TObject);
begin
    if Application.MessageBox('是否删除该角色？','提示',mb_yesno)=mrno then exit;
    NavRole.BtnClick(nbDelete);
end;

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

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

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

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

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

procedure TFormRoleSet.FormCreate(Sender: TObject);
var

    ARecord: PAuthList;
begin
    Application.OnHint :=ShowHint;
    AuthList := TList.Create;
    QryAuth.Close;
    QryAuth.Open;
    while not QryAuth.Eof do
    begin
        New(ARecord);
        ARecord^.BitNo :=QryAuth.fieldbyName('BitNo').Asstring;
        ARecord^.Name :=QryAuth.Fieldbyname('Explain').Asstring;
        AuthList.Add(ARecord);
        QryAuth.Next ;
    end;
    tblRole.Close;
    tblRole.open;


end;

procedure TFormRoleSet.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 TFormRoleSet.FormClose(Sender: TObject;
  var Action: TCloseAction);
var
    i:integer;
    ARecord:PAuthList;
begin
    for i:=0 to AuthList.Count -1 do
    begin
        ARecord:=AuthList.Items[i];
        Dispose(ARecord);
    end;
    AuthList.Free;
    tblRole.close;
    QryAuth.close;
end;

procedure TFormRoleSet.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 TFormRoleSet.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 TFormRoleSet.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;

    //if not (tblRole.State in [dsInsert,dsEdit]) then tblrole.Edit;
end;
procedure TFormRoleSet.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 TFormRoleSet.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 TFormRoleSet.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 TFormRoleSet.tblRoleNewRecord(DataSet: TDataSet);
begin
    tblRole.FieldByName('RoleAuth').AsString:=FillWidth('0',100);
end;

procedure TFormRoleSet.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 TFormRoleSet.tblRoleBeforeScroll(DataSet: TDataSet);
begin
    
    if AuthChange=True then
    begin
        btnPost.Click;
    end;
end;

end.