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

📄 userlimitform.pas

📁 胜天财务进销存2003源代码,SQLSERVER版,目前最完整的财务进销存系统.
💻 PAS
字号:
unit UserLimitForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ListForm, dxBar, dxBarExtItems, KsHooks, KsForms, KsSkinForms,
  KsControls, KsPanels, KsSkinPanels, dxExEdtr, dxCntner, dxTL, dxDBCtrl,
  dxDBTL, ExtCtrls, KsTabs, KsSkinTabs, DB, ADODB, SysPublic, KsCheckBoxs,
  KsSkinCheckBoxs, StdCtrls;

type
  TfrmUserLimit = class(TfrmListForm)
    PageControl: TSeSkinPageControl;
    Splitter1: TSplitter;
    DataSet: TADODataSet;
    dsSource: TDataSource;
    treeMain: TdxDBTreeList;
    bbPassword: TdxBarLargeButton;
    procedure treeMainGetImageIndex(Sender: TObject; Node: TdxTreeListNode;
      var Index: Integer);
    procedure treeMainGetSelectedIndex(Sender: TObject;
      Node: TdxTreeListNode; var Index: Integer);
    procedure bbRefreshClick(Sender: TObject);
    procedure treeMainChangeNode(Sender: TObject; OldNode,
      Node: TdxTreeListNode);
    procedure bbAllSelectClick(Sender: TObject);
    procedure bbAlldelClick(Sender: TObject);
    procedure bbSaveClick(Sender: TObject);
    procedure bbSelectClick(Sender: TObject);
    procedure bbDelClick(Sender: TObject);
    procedure bbPasswordClick(Sender: TObject);
    procedure PageControlEnter(Sender: TObject);
  private
    { Private declarations }
    bReturn: Boolean;
    lUserID1, lTreeOldID: Integer;
    procedure CheckBoxClickEx(Sender: TObject);
    procedure LoadMenu(dxBar: TdxBarManager);
    function GetPosName(sName: string): string;
    procedure CreateCheckBox(Comp1: TComponent; lX, lY, lTag: integer; sName,
      sCaption: string);
    function SaveLimitstr(sUserID, sLimitStr: string): Boolean;
    procedure SetCheckBox(sLimitStr: string);
    function GetCheckBox: string;
    procedure LoadGrid;
    procedure MainShow;
    procedure LoadData;
  public
    { Public declarations }
  end;

function UserLimitShow(lUserID: Integer): Boolean; //用户权限设置
function LoadLimitStr(lID: Integer): string; //读权限字符串
procedure SetMainMenu(dxBar: TdxBarManager); //通过当前权限设置主菜单
function CheckLimit(lMode: Integer): boolean; //检查用户权限
procedure SetStartAccountMenu(dxBar: TdxBarManager); //修改期初前后菜单

implementation
uses DBData, MainWindow, ChangePassForm;
{$R *.dfm}

function UserLimitShow(lUserID: Integer): Boolean;
var
  frmUserLimit: TfrmUserLimit;
begin
  frmUserLimit := TfrmUserLimit.Create(Application);
  with frmUserLimit do
  begin
    lUserID1 := lUserID;
    MainShow;
    Result := bReturn;
    Free;
  end;
end;

function LoadLimitStr(lID: Integer): string;
begin
  Result := FieldIdToNameEx('UserLimit', InttoStr(lID), 'UserID', 'LimitStr');
end;

procedure SetMainMenu(dxBar: TdxBarManager);
var
  i, lCate: integer;
  sLimit, s: string;
begin
  dxBar.LockUpdate := True;
  sLimit := LoadLimitStr(LoginEmployeID);
  if FieldIdToName('Employe', IntToStr(LoginEmployeID), 'Admin') = '1' then
    for i := 0 to 50 do
      sLimit := sLimit + '11111';
  if sLimit = '' then Exit;
  for i := 0 to dxBar.ItemCount - 1 do
  begin
    if (dxBar.Items[i] is TdxBarSubItem) and (dxBar.Items[i].Category = 0) then
    begin
      if (dxBar.Items[i].Name = 'MainSubItem12') then Continue; //[帮助]永远显示
      dxBar.Items[i].Visible := ivNever;
    end;
  end;

  for i := 0 to dxBar.ItemCount - 1 do
  begin
    if dxBar.Items[i] is TdxBarButton then
    begin
      lCate := dxBar.Items[i].Category - 1;
      s := copy(sLimit, dxBar.Items[i].Index, 1);
      if StrToInt2(s) > 0 then
      begin
        dxBar.Items[i].Visible := ivAlways;
        if dxBar.Items[lCate].Visible = ivNever then dxBar.Items[lCate].Visible := ivAlways;
      end
      else
        dxBar.Items[i].Visible := ivNever;
      if dxBar.Items[i].Category = 12 then dxBar.Items[i].Visible := ivAlways; //[帮助]永远显示
    end;
  end;
  dxBar.LockUpdate := False;
end;

procedure SetStartAccountMenu(dxBar: TdxBarManager); //修改期初前后菜单
  procedure HideMainItem;
  var
    i: Integer;
  begin
    dxBar.LockUpdate := True;
    with dxBar do
      for i := 0 to ItemCount - 1 do
      begin
        if (Items[i] is TdxBarSubItem) and (Items[i].Category = 0) then
        begin
          if (Items[i].Name = 'MainSubItem1') or (Items[i].Name = 'MainSubItem2') or
            (Items[i].Name = 'MainSubItem5') or (Items[i].Name = 'MainSubItem8') or
            (Items[i].Name = 'MainSubItem9') or (Items[i].Name = 'MainSubItem11') or
            (Items[i].Name = 'MainSubItem12') then Continue; //永远显示
          Items[i].Visible := ivNever;
        end;
      end;
    dxBar.LockUpdate := False;
  end;
  procedure HideMenuButton;
  var
    i: Integer;
  begin
    dxBar.LockUpdate := True;
    for i := 0 to dxBar.ItemCount - 1 do
    begin
      if dxBar.Items[i] is TdxBarButton then
      begin
        dxBar.Items[i].Visible := ivNever;
        case dxBar.Items[i].Category of
          1, 2, 11, 12: dxBar.Items[i].Visible := ivAlways; //永远显示;
        end;
        case dxBar.Items[i].Tag of
          BASE_FIXED_SORT, BASE_FIXED_MODE, BASE_FIXED_USE, BASE_FIXED_ADD,
            BASE_WAGE_KIND, BASE_WAGE_PROCEDURE, BASE_WAGE_ITEM,
            WARE_STOCK_EDIT, WARE_STOCK_PRICE_EDIT:
            dxBar.Items[i].Visible := ivAlways; //永远显示;
        end;
      end;
    end;
    dxBar.LockUpdate := False;
  end;
  procedure EnabledMenuButton;
  begin
    dxBar.GetItemByName('dxBarButton116').Enabled := not bStartAccount; //启用账套
  end;
begin
  if not bStartAccount then
  begin
    HideMainItem;
    HideMenuButton;
  end;
  EnabledMenuButton;
end;

function CheckLimit(lMode: Integer): boolean;
var
  i: integer;
  dxBar: TdxBarManager;
begin
  Result := False;
  dxBar := frmMainWindow.dxBarManager1;
  for i := 0 to dxBar.ItemCount - 1 do
  begin
    if (dxBar.Items[i] is TdxBarButton)
      and (dxBar.Items[i].Tag = lMode)
      and (dxBar.Items[i].Visible = ivAlways) then
    begin
      Result := True;
      Break;
    end;
  end;
end;

procedure TfrmUserLimit.MainShow;
begin
  LoadGrid;
  LoadData;
  if not CheckLimit(USER_LIMIT_FORM) then
  begin
    ShowMsg('对不起,你没有权限使用此功能!');
    Exit;
  end;
  ShowModal;
end;

procedure TfrmUserLimit.LoadGrid;
begin
  bReturn := False;
  Caption := '用户权限设置';
  if lUserID1 > 0 then
    treeMain.Visible := False
  else
  begin
    treeMain.Visible := True;
    StrToTreeField(treeMain, 'Name', '员工名称', '');
  end;
  LoadMenu(frmMainWindow.dxBarManager1);
end;

procedure TfrmUserLimit.LoadData;
var
  sSql: string;
begin
  sSql := 'SELECT ID,TreeParent,Name FROM Employe where Admin<>1';
  DataSet.LockType := ltReadOnly;
  OpenDataSet(DataSet, sSql);
  SetCheckBox(LoadLimitStr(DataSet.FieldByName('ID').AsInteger));
  if DataSet.RecordCount < 1 then
  begin
    bbPassword.Enabled := False;
  end;
end;

function TfrmUserLimit.GetPosName(sName: string): string;
var
  s: string;
begin
  s := Trim(sName);
  if pos('(', s) > 0 then
    s := copy(s, 0, pos('(', s) - 1);
  Result := s;
end;

function TfrmUserLimit.SaveLimitstr(sUserID, sLimitStr: string): Boolean;
var
  sSql: string;
begin
  sSql := ' SELECT * FROM UserLimit where UserID=' + sUserID;
  if GetDataSetEmpty(sSql) then
    sSql := 'INSERT INTO UserLimit (UserID,LimitStr)VALUES(' + sUserID + ',''' +
      sLimitStr + ''')'
  else
    sSql := ' update UserLimit Set LimitStr=''' + sLimitStr + ''' Where UserID='
      + sUserID;
  Result := ExecSql(sSql);
end;

procedure TfrmUserLimit.SetCheckBox(sLimitStr: string);
var
  i: Integer;
  s: string;
begin
  for i := 0 to ComponentCount - 1 do
  begin
    if (Components[i] is TSeSkinCheckBox) then
    begin
      s := copy(sLimitStr, TSeSkinCheckBox(Components[i]).Tag, 1);
      if StrToInt2(Trim(s)) > 0 then
        TSeSkinCheckBox(Components[i]).Checked := True
      else
        TSeSkinCheckBox(Components[i]).Checked := False;
    end;
  end;
end;

function TfrmUserLimit.GetCheckBox: string;
var
  i, lTag: integer;
  s, s1: string;
begin
  for i := 0 to 50 do
    s := s + '00000';
  s1 := s;
  for i := 0 to ComponentCount - 1 do
  begin
    if (Components[i] is TSeSkinCheckBox) then
    begin
      lTag := TSeSkinCheckBox(Components[i]).Tag;
      if TSeSkinCheckBox(Components[i]).Checked then
        s[lTag] := '1'
      else
        s[lTag] := '0';
    end;
  end;
  if s1 = s then
    s := '';
  Result := s;
end;

procedure TfrmUserLimit.CheckBoxClickEx(Sender: TObject);
begin
  bbSave.Enabled := True;
end;

procedure TfrmUserLimit.CreateCheckBox(Comp1: TComponent; lX, lY, lTag: integer;
  sName, sCaption: string);
var
  Checkbox1: TSeSkinCheckBox;
begin
  CheckBox1 := TSeSkinCheckBox.Create(self);
  CheckBox1.Left := lX;
  CheckBox1.Top := lY;
  CheckBox1.Width := 120;
  CheckBox1.Tag := lTag;
  CheckBox1.Name := sName;
  CheckBox1.Caption := sCaption;
  CheckBox1.Parent := TWinControl(Comp1);
  CheckBox1.OnClick := CheckBoxClickEx;
end;

procedure TfrmUserLimit.LoadMenu(dxBar: TdxBarManager);
var
  i, l, lX, lY, j, k, lIndex: integer;
  Compt: TComponent;
  sCap: string;
begin
  for i := 0 to dxBar.Categories.Count - 1 do
    PageControl.Tabs.Add(GetPosName(dxBar.Categories.Strings[i]));
  for i := 0 to dxBar.Categories.Count - 1 do
  begin
    j := 0;
    k := 0;
    for l := 0 to dxBar.ItemCount - 1 do
    begin
      if dxBar.Items[l] is TdxBarButton then
      begin
        if dxBar.Items[l].Category = i then
        begin
          lX := j * 120 + 20;
          lY := k * 30 + 5;
          Compt := PageControl.Pages[dxBar.Items[l].Category];
          sCap := GetPosName(dxBar.Items[l].Caption);
          lIndex := dxBar.Items[l].Index;
          CreateCheckBox(Compt, lX, lY, lIndex, 'Chx' + IntToStr(lIndex), sCap);
          if j >= 3 then
          begin
            j := 0;
            Inc(k)
          end
          else
            Inc(j);
        end;
      end;
    end;
  end;
  PageControl.Pages[0].PageVisible := False;
  PageControl.Pages[12].PageVisible := False;
  PageControl.TabIndex := 0;
end;

procedure TfrmUserLimit.treeMainGetImageIndex(Sender: TObject;
  Node: TdxTreeListNode; var Index: Integer);
const
  ImagesIndex: array[Boolean] of Integer = (16, 17);
begin
  inherited;
  if Node.HasChildren then
    Index := ImagesIndex[Node.Expanded]
  else
    Index := 16;
end;

procedure TfrmUserLimit.treeMainGetSelectedIndex(Sender: TObject;
  Node: TdxTreeListNode; var Index: Integer);
const
  ImagesIndex: array[Boolean] of Integer = (16, 17);
begin
  inherited;
  if Node.HasChildren then
    Index := ImagesIndex[Node.Expanded]
  else
    Index := 16;
end;

procedure TfrmUserLimit.bbRefreshClick(Sender: TObject);
begin
  inherited;
  DataSet.Filter := '';
end;

procedure TfrmUserLimit.treeMainChangeNode(Sender: TObject; OldNode,
  Node: TdxTreeListNode);
begin
  inherited;
  SaveLimitstr(IntToStr(lTreeOldID), GetCheckBox);
  lTreeOldID := DataSet.FieldByName('ID').AsInteger;
  SetCheckBox(LoadLimitStr(lTreeOldID));
end;

procedure TfrmUserLimit.bbAllSelectClick(Sender: TObject);
var
  i: integer;
begin
  inherited;
  for i := 0 to ComponentCount - 1 do
  begin
    if (Components[i] is TSeSkinCheckBox) then
    begin
      TSeSkinCheckBox(Components[i]).Checked := True
    end;
  end;
end;

procedure TfrmUserLimit.bbAlldelClick(Sender: TObject);
var
  i: integer;
begin
  inherited;
  for i := 0 to ComponentCount - 1 do
  begin
    if (Components[i] is TSeSkinCheckBox) then
    begin
      TSeSkinCheckBox(Components[i]).Checked := False;
    end;
  end;
end;

procedure TfrmUserLimit.bbSaveClick(Sender: TObject);
begin
  inherited;
  SaveLimitstr(IntToStr(DataSet.FieldByName('ID').AsInteger), GetCheckBox);
  bbSave.Enabled := False;
end;

procedure TfrmUserLimit.bbSelectClick(Sender: TObject);
var
  i: integer;
  dxBar: TdxBarManager;
begin
  inherited;
  dxBar := frmMainWindow.dxBarManager1;
  for i := 0 to ComponentCount - 1 do
  begin
    if (Components[i] is TSeSkinCheckBox) and
      (dxBar.Items[Components[i].Tag].Category = PageControl.ActivePageIndex)
      then
    begin
      TSeSkinCheckBox(Components[i]).Checked := True
    end;
  end;
end;

procedure TfrmUserLimit.bbDelClick(Sender: TObject);
var
  i: integer;
  dxBar: TdxBarManager;
begin
  inherited;
  dxBar := frmMainWindow.dxBarManager1;
  for i := 0 to ComponentCount - 1 do
  begin
    if (Components[i] is TSeSkinCheckBox) and
      (dxBar.Items[Components[i].Tag].Category = PageControl.ActivePageIndex)
      then
    begin
      TSeSkinCheckBox(Components[i]).Checked := False;
    end;
  end;
end;

procedure TfrmUserLimit.bbPasswordClick(Sender: TObject);
var
  lEID: Integer;
begin
  inherited;
  lEID := DataSet.FieldByName('ID').AsInteger;
  ChangePassShow(lEID, 1);
end;

procedure TfrmUserLimit.PageControlEnter(Sender: TObject);
begin
  inherited;
  bbSave.Enabled := True;
end;

end.

⌨️ 快捷键说明

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