📄 userlimitform.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 + -