sys_accessctrl.pas

一个MRPII系统源代码版本

      Close;
      sql.clear;
      sql.Add('insert SysMenuAccesslog (EmployeeCode,action,Ctrl_EmployeeCode'+
               ',acttime) Values (:EmployeeCode,:action,:Ctrl_EmployeeCode'+
               ',getdate())');
      Parameters.ParambyName('EmployeeCode').Value:=getCode(cmbbx_user.text);
      Parameters.ParambyName('action').Value:='复制'+SourceOid+'用户的'+getCode(cmbbx_Module.text)+
                                     '模块权限给'+getCode(cmbbx_user.text)+'用户';
      Parameters.ParambyName('Ctrl_EmployeeCode').Value:=userCode+' '+userName;
      execsql;
    end;
    openqr_menu;
    emptygrid;
    fillgrid;
  end;
end;

procedure TFrm_Sys_AccessCtrl.openqr_menu;
begin
  with AdoQry_tmp2 do
  begin
    Close;
    sql.clear;
    sql.Add('select a.*,b.SysMenuCode '+
            'from SysMenuAccessCtrl a, '+
            '     SysMenu b ');
    sql.Add('where a.SysMenuid=b.SysMenuId '+
            '  and a.EmployeeCode=:uid ');
    sql.Add('  and b.SysModuleCode=:modid ');
    sql.Add('Order by b.SysMenuCode ');
    Parameters.ParambyName('uid').Value:=getCode(cmbbx_user.text);
    Parameters.ParambyName('modid').Value:=getCode(cmbbx_Module.text);
    open;
  end;
end;

procedure TFrm_Sys_AccessCtrl.insertrec;
begin
  with AdoQry_tmp1 do
  begin
    Close;
    sql.clear;
    sql.Add('insert into '+p_table);
    sql.Add(  ' (EmployeeCode,'+p_menuidfieldName+',CanAccess)');
    sql.Add(  ' Values ');
    sql.Add(  ' (:uid,:menid,:Access)');
    Parameters.ParambyName('uid').Value:=getCode(cmbbx_user.Text);
    Parameters.ParambyName('menid').Value:=GetSysMenuId(grid1.cells[0,grid1.row]);
    if grid1.cells[2,grid1.row]='是' then
      Parameters.ParambyName('Access').Value:=1
    else if grid1.cells[2,grid1.row]='否' then
      Parameters.ParambyName('Access').Value:=0
    else Parameters.ParambyName('Access').Value:=0;
    execsql;
     Close;
     sql.clear;
     sql.Add('insert SysMenuAccesslog (EmployeeCode,SysMenuid,action,Ctrl_EmployeeCode'+
             ',acttime) Values (:EmployeeCode,:SysMenuid,:action,:Ctrl_EmployeeCode'+
             ',getdate())');
    Parameters.ParambyName('EmployeeCode').Value:=getCode(cmbbx_user.text);
    Parameters.ParambyName('SysMenuid').Value:=GetSysMenuId(grid1.Cells[0,grid1.row]);
    if bint=1 then
      Parameters.ParambyName('action').Value:='授予'
     else
      Parameters.ParambyName('action').Value:='取消';
    Parameters.ParambyName('Ctrl_EmployeeCode').Value:=userCode+' '+userName;
    execsql;
  end;
end;

//按空格键相当于双击
procedure TFrm_Sys_AccessCtrl.Grid1KeyPress(Sender: TObject; var Key: ChAr);
begin
  inherited;
  if (key>='!') and (key<='}') then
    edt_quickid.text:=edt_quickid.text+key;
  if key=' ' then Grid1DblClick(grid1);
end;

//控制键盘的行为
procedure TFrm_Sys_AccessCtrl.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
//  inherited;
  if (key=ord('P')) and (shift-[sSalt]-[ssshift]+[sSCtrl]=shift) then
  begin
    if tb_givemodule.enabled then
      tb_givemoduleclick(sender);
    exit;
  end;
  if (key=ord('C')) and (shift-[sSalt]-[ssshift]+[sSCtrl]=shift) then
  begin
    if tlbtn_Copy.enabled then
      tlbtn_Copyclick(sender);
    exit;
  end;
  case key of
    vk_eScApe:
      tlbtn_exitclick(sender);
    vk_return:
    begin
      if (activecontrol is tstringgrid) then exit;
      if ((activecontrol is tcombobox) and ((sSalt in shift) or (activecontrol as tcombobox).droppeddown)) then
        exit;
      SelectNext(ActiveControl As Twincontrol,True,True);
      key:=0;
    end;
    vk_up,vk_Down:
    begin
      if (ActiveControl is Tstringgrid)or(sSalt in shift)or((ActiveControl is Tcombobox)and((ActiveControl as Tcombobox).droppeddown)) then
        exit;
      SelectNext(ActiveControl As Twincontrol,key=vk_Down,True);
      key:=0;
    end;
  end
end;

procedure TFrm_Sys_AccessCtrl.FormKeyPress(Sender: TObject; var Key: ChAr);
begin
  inherited;
  if (word(key)=vk_return) then
    key:=#0;
end;

//为避免改变条件，自动改变checkbox的状态时，触发该事件，
//只有条件选择完毕后checkbox才有效，也只有它有效时，才
//执行修改用户是否可用模块的程序
procedure TFrm_Sys_AccessCtrl.ckbx_usermoduleClick(Sender: TObject);
begin
  if ckbx_usermodule.enabled then
  begin
    with AdoQry_tmp1 do
    begin
      if ckbx_usermodule.Checked then  //给用户增加新模块
      begin
        Close;
        sql.clear;
        sql.Add('insert into '+p_Moduletable);
        sql.Add(' (EmployeeCode,SysModuleCode) Values (:uid,:modid)');
        Parameters.ParambyName('uid').Value:=getCode(cmbbx_user.Text);
        Parameters.ParambyName('modid').Value:=getCode(cmbbx_Module.Text);
        execsql;
      end
      else   //删除用户对该模块的使用权
      begin
        Close;
        sql.clear;
        sql.Add('delete from '+p_Moduletable);
        sql.Add(  ' where EmployeeCode=:uid and SysModuleCode=:modid');
        Parameters.ParambyName('uid').Value:=getCode(cmbbx_user.Text);
        Parameters.ParambyName('modid').Value:=getCode(cmbbx_Module.Text);
        execsql;
      end;
    end;
  end;
  inherited;
end;

procedure TFrm_Sys_AccessCtrl.btn_okClick(Sender: TObject);
begin

  inherited;

  if (cmbbx_Dept.text='') or
     (cmbbx_user.text='') or
     (cmbbx_Module.text='') then
  begin
    DispInfo('  请选择必要的条件!  ',1);
    exit;
  end;

  with AdoQry_tmp1 do
  begin
    Close;
    sql.clear;
    sql.Add('select '+
            '  EmployeeCode  as userid,'+
            '  SysModuleCode as moduleid '+
            'from SysModuleAccessCtrl ');
    sql.Add('where EmployeeCode=:uid '+
            '  and SysModuleCode=:modid');
    Parameters.ParambyName('uid').Value:=getCode(cmbbx_user.text);
    Parameters.ParambyName('modid').Value:=getCode(cmbbx_Module.text);
    open;
    if eof then
    begin
      ckbx_usermodule.Checked :=False;
    end
    else
    begin
      ckbx_usermodule.Checked :=True;
    end;
  end;

  user:=cmbbx_user.text;
  module:=cmbbx_Module.text;
  Dept:=cmbbx_Dept.text;

  btn_ok.enabled:=False;
  if not fReadOnly then
  begin
    ckbx_usermodule.enabled:=True;
    tlbtn_Copy.enabled:=True;
    tb_givemodule.Enabled :=tlbtn_Copy.Enabled ;    
  end;
  if not gridempty then
    emptygrid;
  fillgrid;

end;

//进入grid，则恢复原条件的状态
procedure TFrm_Sys_AccessCtrl.Grid1Enter(Sender: TObject);
begin
  inherited;
  if user='' then
    exit;
  btn_ok.enabled:=False;
  if not fReadOnly then
  begin
    ckbx_usermodule.enabled:=True;
    tlbtn_Copy.enabled:=True;
    tb_givemodule.Enabled :=tlbtn_Copy.Enabled ;    
  end;
  cmbbx_Dept.Itemindex:=cmbbx_Dept.Items.indexof(Dept);
  cmbbx_user.Itemindex:=cmbbx_user.Items.indexof(user);
  cmbbx_Module.Itemindex:=cmbbx_Module.Items.indexof(module);
end;

//控制grid的显示
procedure TFrm_Sys_AccessCtrl.Grid1DrawCell(Sender: TObject; ACol,
  Arow: Integer; Rect: TRect; State: TGridDrawState);
var
    flags:word;
    s:string;
begin
  with (Sender as TstringGrid).Canvas do
  begin
    Font.Color := clBlack;
    if gdFixed in State then
      Brush.Color := clBtnFace
    else if gdSelected in State then
    begin
      brush.color:=clnavy;
      Font.Color := clwhite;
    end
    else if Arow mod 2 <> 0 then
      Brush.Color := clwindow
    else
      Brush.Color := clwindow;

    font.Name:=Frm_Sys_AccessCtrl.font.Name;
    font.size:=Frm_Sys_AccessCtrl.font.size;

    FillRect(Rect);
    InflateRect(Rect, -2, -2);
    if (Arow=0) or (acol=3) or (acol=2) then
      flags := dt_Center or dt_Bottom
    else
      flags := dt_Left or dt_VCenter;

    s:=grid1.cells[acol,Arow];
    DrawText(Handle, pchAr(s), Length(s), Rect, flags);

  end;
end;

//grid中按left且是最左列回到cmbbx_user
procedure TFrm_Sys_AccessCtrl.Grid1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var i:integer;
begin
  inherited;
  if (key=vk_left) and (grid1.col=0) then
    cmbbx_user.setfocus;
  if (edt_quickid.text<>'') then
  begin
    if (key=vk_Back) then
      edt_quickid.text:=copy(edt_quickid.text,1,length(edt_quickid.text)-1)
    else if (key=vk_return) then
    begin
      for i:=0 to grid1.rowCount-1 do
      begin
        if grid1.cells[0,i]='mn'+edt_quickid.text then
        begin
          edt_quickid.text:='';
          grid1.row:=i;
          exit;
        end;
      end;
    end;
  end;
end;

function TFrm_Sys_AccessCtrl.GetSysMenuId(SysMenuCode: string): integer;
begin
  with AdoQry_Tmp3 do
  begin
    Close;
    sql.clear;
    sql.Add('select SysMenuId '+
            'From SysMenu '+
            'Where SysMenuCode='''+SysMenuCode+''' '+
            '  and SysModuleCode='''+getCode(cmbbx_Module.text)+''' ');
    open;
    if not eof then Result:=fieldbyname('SysMenuId').AsInteger
    else Result:=0;
    Close;
  end;
end;

procedure TFrm_Sys_AccessCtrl.InitForm(AdoConnection: TAdoConnection;
  ReadOnly: boolean);
begin
  AdoQry_Tmp1.Connection:=AdoConnection;
  AdoQry_Tmp2.Connection:=AdoConnection;
  AdoQry_Tmp3.Connection:=AdoConnection;
  fReadOnly:=ReadOnly;
end;

function TFrm_Sys_AccessCtrl.FoundAccess(SysMenuId: integer): integer;
begin
  with AdoQry_Tmp3 do
  begin
    Close;
    sql.clear;
    sql.Add('select CanAccess '+
            'From SysMenuAccessCtrl '+
            'Where SysMenuId='+IntToStr(SysMenuid)+' and '+
               ' EmployeeCode='''+GetCode(Cmbbx_user.text)+'''') ;
    open;
    if not eof then Result:=fieldbyname('CanAccess').AsInteger
    else Result:=-1;
    Close;
  end;
end;
procedure TFrm_Sys_AccessCtrl.setSysParam(Param1:string;Param2:string;Param3:string;Param4:string);
begin
  userCode:=Param1;
end;
procedure TFrm_Sys_AccessCtrl.tb_givemoduleClick(Sender: TObject);
begin
  inherited;
  Frm_Sys_GiveAccess:=TFrm_Sys_GiveAccess.Create(self);
  Frm_Sys_GiveAccess.SetSysParam(userCode,'','','');
  Frm_Sys_GiveAccess.InitForm(AdoQry_tmp1.Connection,userCode);

  if Frm_Sys_GiveAccess.ShowModal=mrOk then
  begin
    fillgrid ;
    with AdoQry_tmp1 do
    begin
      Close;
      sql.clear;
      sql.Add('select * from SysModuleAccessCtrl where EmployeeCode='''+
              getCode(cmbbx_user.text)+''' and SysModuleCode='''+getCode(cmbbx_Module.text)+'''');
      open;
      if not eof then
      begin
       ckbx_usermodule.Enabled :=False;
       ckbx_usermodule.Checked :=True;
       ckbx_usermodule.Enabled :=True;
      end
      else
      ckbx_usermodule.Checked :=False;              
    end;
  end;
  Frm_Sys_GiveAccess.Release ;
end;

end.