📄 wnusermanager.pas
字号:
unit WnUserManager;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Mask, DBCtrls, Db, DBTables, Grids, DBGrids, Menus, ComCtrls,
ExtCtrls, ImgList,Variants;
const
cNoUsePostNo = 'NoUse';
type
TFmUserManager = class(TForm)
mmTest: TMainMenu;
N1: TMenuItem;
miUserDefine: TMenuItem;
Panel1: TPanel;
combPrograms: TComboBox;
Label1: TLabel;
N3: TMenuItem;
miAddPost: TMenuItem;
miDelPost: TMenuItem;
miModiPost: TMenuItem;
Panel2: TPanel;
Splitter1: TSplitter;
Panel3: TPanel;
gbPosts: TGroupBox;
dbgPosts: TDBGrid;
pcRightAndUser: TPageControl;
tsRight: TTabSheet;
tvGrant: TTreeView;
tsUser: TTabSheet;
dbgUser: TDBGrid;
N7: TMenuItem;
miAddPostUser: TMenuItem;
miDelPostUser: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
dsPosts: TDataSource;
dsUserPost: TDataSource;
ilTreeView: TImageList;
PopupMenu1: TPopupMenu;
PopupMenu2: TPopupMenu;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
procedure miUserDefineClick(Sender: TObject);
procedure N12Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure combProgramsChange(Sender: TObject);
procedure dsPostsDataChange(Sender: TObject; Field: TField);
procedure miAddPostClick(Sender: TObject);
procedure miDelPostClick(Sender: TObject);
procedure miModiPostClick(Sender: TObject);
procedure miAddPostUserClick(Sender: TObject);
procedure miDelPostUserClick(Sender: TObject);
procedure tvGrantMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
public
CurrentProgramId : Integer;
CurrentCenterCode : string;
slProgramId : TStringList;
InputProgramId : Integer;
procedure InitGrant;
procedure DisplayGrant(PostNo : String);
procedure ChangeRight(postno : string);
procedure ChangeGrant(item : TTreeNode;postno : string);
procedure ChangeParent(Item :TTreeNode;postno:string);
{ Public declarations }
end;
var
FirstLogin : Boolean=True;
FmUserManager: TFmUserManager;
implementation
uses WnAddUsers,DnUserManager,WnAddPost,UnDlgShell,WnAddPostUser;
{$R *.DFM}
procedure TFmUserManager.miUserDefineClick(Sender: TObject);
begin
FmAddUsers := TFmAddUsers.Create(Self);
try
FmAddUsers.CurrentCenterCode := CurrentCenterCode;
FmAddUsers.ShowModal;
finally
FmAddUsers.Free;
end;
end;
procedure TFmUserManager.N12Click(Sender: TObject);
begin
Close;
end;
procedure TFmUserManager.N2Click(Sender: TObject);
begin
//Collect(1);
end;
procedure TFmUserManager.FormShow(Sender: TObject);
begin
slProgramId := TStringList.Create;
try
with dmUserManager.qryPrograms do
begin
Open;
First;
While not eof do
begin
slProgramId.Add(FieldByName('programid').AsString);
combPrograms.Items.Add(FieldByName('programname').AsString);
Next;
end;
end;
finally
if dmUserManager.qryPrograms.Active then
dmUserManager.qryPrograms.Close;
end;
combPrograms.ItemIndex := 0;
combProgramsChange(Sender);
end;
procedure TFmUserManager.combProgramsChange(Sender: TObject);
begin
//改变当前程序代码
CurrentProgramId := StrToInt(slProgramId.Strings[combPrograms.ItemIndex]);
//显示相应程序的岗位
with dmUserManager.qryPosts do begin
if Active then
Close;
Prepare;
ParamByName('programid').AsInteger := CurrentProgramId;
ParamByName('centercode').AsString := CurrentCenterCode;
Open;
end;
//建立相应程序的权限树。
InitGrant;
//显示相应岗位的权限
DisplayGrant(dmUserManager.qryPosts.FieldByName('postno').AsString);
tvGrant.FullExpand;
end;
procedure TFmUserManager.dsPostsDataChange(Sender: TObject; Field: TField);
begin
if dsPosts.DataSet.IsEmpty then
begin
with dmUserManager.qryUserPost do
begin
if Active then
Close;
Prepare;
ParamByName('ProgramId').AsInteger := 100;
ParamByName('PostNo').AsString := cNoUsePostNo;
ParamByName('CenterCode').AsString := CurrentCenterCode;
Open;
end;
DisplayGrant(cNoUsePostNo);
Exit;
end;
//显示相应岗位的权利
if not (dsPosts.DataSet.State in [dsedit,dsinsert]) then
DisplayGrant(dmUserManager.qryPosts.FieldByName('postno').AsString);
//显示岗位操作员
with dmUserManager.qryUserPost do
begin
if Active then
Close;
Prepare;
ParamByName('programid').AsInteger := CurrentProgramId;
ParamByName('postno').AsString := dmUserManager.qryPosts.FieldByName('postno').AsString;
ParamByName('CenterCode').AsString := CurrentCenterCode;
Open;
end;
end;
procedure TFmUserManager.InitGrant;
var
parents:array[0..99] of TTreeNode;
level : Integer;
aNode : TTreeNode;
begin
level := 0;
with dmUserManager.qryMenus,tvGrant do
begin
if Active then
Close;
Prepare;
ParamByName('programid').AsInteger := CurrentProgramId;
Open;
First;
Items.Clear;
aNode := tvGrant.Items.AddChild(nil,combPrograms.Text);
Parents[0] := aNode;
aNode.SelectedIndex := 2;
aNode.ImageIndex := 2;
while not eof do
begin
Level := FieldByName('classno').AsInteger;
aNode := Items.AddChild(Parents[Level-1],FieldByName('menuname').AsString);
aNode.SelectedIndex := 1;
aNode.ImageIndex := 1;
Parents[Level] := aNode;
Next;
end;
Close;
end;
end;
procedure TFmUserManager.miAddPostClick(Sender: TObject);
begin
FmAddPost := TFmAddPost.Create(Self);
try
FmAddPost.AddPost;
finally
FmAddPost.Free;
end;
end;
procedure TFmUserManager.miDelPostClick(Sender: TObject);
begin
if (not dmUserManager.qryPosts.Active) or (dmUserManager.qryPosts.IsEmpty) then
Exit;
if Ask('是否删除当前选中的岗位') then
begin
dmUserManager.UserManager.StartTransaction;
try
with dmUserManager do
begin
DelUserPost.Prepare;
DelUserPost.ParamByName('postno').AsString := qryPosts.FieldByName('postno').AsString;
DelUserPost.ParamByName('centercode').AsString := CurrentCenterCode;
DelUserPost.ExecSQL;
DelPostMenus.Prepare;
DelPostMenus.ParamByName('postno').AsString := qryPosts.FieldByName('postno').AsString;
DelPostMenus.ParamByName('centercode').AsString := CurrentCenterCode;
DelPostMenus.ExecSQL;
qryPosts.Delete;
qryPosts.ApplyUpdates;
UserManager.Commit;
qryPosts.CommitUpdates;
end;
except
on E : exception do
begin
dmUserManager.UserManager.Rollback;
ShowError(e.Message);
end;
//ShowError('数据库出错导致删除失败');
end;
end;
end;
procedure TFmUserManager.miModiPostClick(Sender: TObject);
begin
FmAddPost := TFmAddPost.Create(Self);
try
FmAddPost.ModiPost;
finally
FmAddPost.Free;
end;
end;
procedure TFmUserManager.miAddPostUserClick(Sender: TObject);
begin
//增加岗位操作员
with dmUserManager do
begin
if not qryPosts.Active then
Exit;
if qryPosts.IsEmpty then
Exit;
end;
FmAddPostuser := TFmAddPostuser.Create(Self);
try
FmAddPostuser.ShowModal;
dmUserManager.qryUserPost.Close;
dmUserManager.qryUserPost.Open;
finally
FmAddPostuser.Free;
end;
end;
procedure TFmUserManager.miDelPostUserClick(Sender: TObject);
begin
//删除岗位操作员
if dsUserPost.DataSet.IsEmpty then
Exit;
with dmUserManager.delProgramPostUser do
begin
ParamByName('programid').AsInteger := CurrentProgramId;
ParamByName('userno').AsString := dmUserManager.qryUserPost.FieldByName('userno').AsString;
ParamByName('centercode').AsString := CurrentCenterCode;
ExecSQL;
end;
with dmUserManager.qryUserPost do
begin
Close;
Open;
end;
end;
procedure TFmUserManager.DisplayGrant(PostNo: String);
var
I : integer;
begin
with dmUserManager.qryPostMenus,tvGrant do
begin
if Active then
Close;
Prepare;
ParamByName('postno').AsString := PostNo;
ParamByName('centercode').AsString := CurrentCenterCode;
Open;
for I:= 1 to Items.Count - 1 do
begin
if Locate('postno;menuno',vararrayof([Postno,I]),[]) then
begin
Items[I].SelectedIndex := 1;
Items[I].ImageIndex := 1;
end else
begin
Items[I].SelectedIndex := 0;
Items[I].ImageIndex := 0;
end;
end;
Refresh;
end;
end;
procedure TFmUserManager.ChangeRight(postno:string);
var
I : Integer;
ANode : TTreeNode;
begin
if tvGrant.Selected.AbsoluteIndex = 0 then
Exit;
with tvGrant,dmUserManager do
begin
tvGrant.Update;
Selected.SelectedIndex := (Selected.SelectedIndex +1 ) mod 2;
Selected.ImageIndex := (Selected.ImageIndex + 1 ) mod 2;
I := Selected.AbsoluteIndex;
if (Selected.ImageIndex = 0) and (qryPostMenus.Locate('postno;menuno',vararrayof([postno,i]),[]))then
begin
qryPostMenus.Delete;
qryPostMenus.ApplyUpdates;
end;
if Selected.ImageIndex = 1 then
begin
if not qryPostMenus.Locate('centercode;postno;menuno',vararrayof([CurrentCenterCode,postno,i]),[]) then
begin
qryPostMenus.AppendRecord([CurrentCenterCode,postno,I]);
qryPostMenus.ApplyUpdates;
end;
//递归根结点
ANode := tvGrant.Selected.Parent;
ChangeParent(ANode,postno);
end;
end;
//调用递归程序;
ChangeGrant(tvGrant.Selected,postno);
end;
procedure TFmUserManager.ChangeGrant(item: TTreeNode; postno: string);
var
i,imenuno : Integer;
begin
//递归结点子项。
tvGrant.Update;
with dmUserManager.qryPostMenus do
begin
for i := 0 to item.Count - 1 do
begin
if (item.SelectedIndex=0) and (item.Item[I].SelectedIndex=1) then
begin
imenuno := item.Item[I].AbsoluteIndex;
if Locate('postno;menuno',vararrayof([postno,imenuno]),[]) then
begin
Delete;
ApplyUpdates;
//CommitUpdates;
end;
end;
if (item.SelectedIndex=1) and (item.Item[I].SelectedIndex=0) then
begin
imenuno := item.Item[I].AbsoluteIndex;
if not Locate('postno;menuno',vararrayof([postno,imenuno]),[]) then
begin
AppendRecord([CurrentCenterCode,postno,imenuno]);
ApplyUpdates;
//CommitUpdates;
end;
end;
item.Item[I].SelectedIndex := item.SelectedIndex;
item.Item[I].ImageIndex := item.ImageIndex;
ChangeGrant(item.Item[I],postno);
end;
end;
tvGrant.Refresh;
end;
procedure TFmUserManager.tvGrantMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
ClickedItem : THitTests;
begin
with dmUserManager do
begin
if not qryPosts.Active then
Exit;
if qryPosts.IsEmpty then
Exit;
end;
if button<>mbleft then
Exit;
ClickedItem := tvGrant.GetHitTestInfoAt(x,y);
//if (htOnLabel in ClickedItem) or
if htOnIcon in clickedItem then
begin
tvGrant.Selected := tvGrant.GetNodeAt(x,y);
if tvGrant.Focused then
ChangeRight(dmUserManager.qryPosts.FieldByName('postno').AsString);
end;
end;
procedure TFmUserManager.FormClose(Sender: TObject;
var
Action: TCloseAction);
begin
with dmUserManager do
begin
if qryUsers.Active then
qryUsers.Close;
if qryAvailUsers.Active then
qryAvailUsers.Close;
if qryMenus.Active then
qryMenus.Close;
if qryPostMenus.Active then
qryPostMenus.Close;
if qryPosts.Active then
qryPosts.Close;
if qryPrograms.Active then
qryPrograms.Close;
if qryUserPost.Active then
qryUserPost.Close;
end;
end;
procedure TFmUserManager.ChangeParent(Item: TTreeNode; postno: string);
var
I : Integer;
begin
if Item.AbsoluteIndex= 0 then
Exit;
with dmUserManager,tvGrant do
begin
Item.ImageIndex := 1;
Item.SelectedIndex := 1;
I := Item.AbsoluteIndex;
if not qryPostMenus.Locate('postno;menuno',vararrayof([postno,i]),[]) then
begin
qryPostMenus.AppendRecord([CurrentCenterCode,postno,I]);
qryPostMenus.ApplyUpdates;
end;
ChangeParent(Item.Parent,postno);
end;
end;
procedure TFmUserManager.FormKeyPress(Sender: TObject; var Key: Char);
begin
if key = #27 then
begin
FmUserManager.Close;
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -