?? group.pas
字號:
{*******************************************************}
{ }
{ }
{ }
{ 中軟金馬公司版權(quán)所有。2002.12前 }
{ }
{ 編制:中軟金馬郵資票品項目開發(fā)組 }
{ }
{ }
{*******************************************************}
(*
本模塊在省級系統(tǒng)管理里面調(diào)用。
*)
{
有關(guān)表:
組別表、人員組別表、模塊組別關(guān)系表
人員表、模塊表
數(shù)據(jù)來源:
組戶:組別表
成員:人員組別表
非成員:人員表
有權(quán)模塊:模塊組別關(guān)系表
無權(quán)模塊:模塊表
功能:
算法:
更新有關(guān)表: 組別表、人員表、模塊組別關(guān)系表
備注:
}
unit Group;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
FormBase, StdCtrls, Buttons, DBCtrls, Mask, BoxProcs, CheckLst,
Db, DBTables, ComCtrls, Menus;
type
TfrmGroup = class(TFFormBase)
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
DBEdit1: TDBEdit;
DBEdit2: TDBEdit;
ListBox1: TListBox;
Label7: TLabel;
ListBox2: TListBox;
Label8: TLabel;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
BitBtn6: TBitBtn;
Label4: TLabel;
DBEdit3: TDBEdit;
qrytemp: TQuery;
PgCtl_mk: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
TabSheet6: TTabSheet;
Label5: TLabel;
Label6: TLabel;
s_csh: TListBox;
BitBtn7: TBitBtn;
BitBtn8: TBitBtn;
d_csh: TCheckListBox;
Label9: TLabel;
Label10: TLabel;
s_jyp: TListBox;
BitBtn9: TBitBtn;
BitBtn10: TBitBtn;
d_jyp: TCheckListBox;
Label11: TLabel;
Label12: TLabel;
s_txp: TListBox;
BitBtn11: TBitBtn;
BitBtn12: TBitBtn;
d_txp: TCheckListBox;
Label13: TLabel;
Label14: TLabel;
s_yp: TListBox;
BitBtn13: TBitBtn;
BitBtn14: TBitBtn;
d_yp: TCheckListBox;
Label15: TLabel;
Label16: TLabel;
s_grp: TListBox;
BitBtn15: TBitBtn;
BitBtn16: TBitBtn;
d_grp: TCheckListBox;
Label17: TLabel;
Label18: TLabel;
s_kc: TListBox;
BitBtn17: TBitBtn;
BitBtn18: TBitBtn;
d_kc: TCheckListBox;
Label3: TLabel;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
TabSheet7: TTabSheet;
Label19: TLabel;
d_zhcx: TCheckListBox;
BitBtn19: TBitBtn;
BitBtn20: TBitBtn;
Label20: TLabel;
s_zhcx: TListBox;
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn7Click(Sender: TObject);
procedure BitBtn8Click(Sender: TObject);
procedure BitBtn9Click(Sender: TObject);
procedure BitBtn11Click(Sender: TObject);
procedure BitBtn13Click(Sender: TObject);
procedure BitBtn15Click(Sender: TObject);
procedure BitBtn17Click(Sender: TObject);
procedure BitBtn10Click(Sender: TObject);
procedure BitBtn12Click(Sender: TObject);
procedure BitBtn14Click(Sender: TObject);
procedure BitBtn16Click(Sender: TObject);
procedure BitBtn18Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure BitBtn19Click(Sender: TObject);
procedure BitBtn20Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
procedure InitData;
procedure MoveAdd(sLstBox: TListBox; dLstBox: TCheckListBox);
procedure SetCustomListBox(Sender: TObject; p_b_SelectAll: boolean);
public
V_ZBDM: TstringList; //登陸用戶所屬組別
{ Public declarations }
end;
function ShowGroup: Boolean;
var
frmGroup: TfrmGroup;
implementation
uses datas,Pub, UserList;
{$R *.DFM}
function ShowGroup: Boolean;
begin
Application.CreateForm(TfrmGroup, frmGroup);
with frmGroup do
try
result := ShowModal = MB_OK;
finally
Destroy;
frmGroup := nil;
end;
end;
procedure TfrmGroup.BitBtn3Click(Sender: TObject);
var
clb: TCheckListBox;
i: integer;
begin
clb := TCheckListBox.Create(self);
try
clb.Parent := self;
clb.Visible := false;
clb.Clear;
for i := 0 to d_csh.Items.Count - 1 do
begin
clb.Items.Add(d_csh.Items.Strings[i]);
clb.Checked[clb.Items.Count - 1] := d_csh.Checked[i]
end;
for i := 0 to d_jyp.Items.Count - 1 do
begin
clb.Items.Add(d_jyp.Items.Strings[i]);
clb.Checked[clb.Items.Count - 1] := d_jyp.Checked[i]
end;
for i := 0 to d_txp.Items.Count - 1 do
begin
clb.Items.Add(d_txp.Items.Strings[i]);
clb.Checked[clb.Items.Count - 1] := d_txp.Checked[i]
end;
for i := 0 to d_yp.Items.Count - 1 do
begin
clb.Items.Add(d_yp.Items.Strings[i]);
clb.Checked[clb.Items.Count - 1] := d_yp.Checked[i]
end;
for i := 0 to d_grp.Items.Count - 1 do
begin
clb.Items.Add(d_grp.Items.Strings[i]);
clb.Checked[clb.Items.Count - 1] := d_grp.Checked[i]
end;
for i := 0 to d_kc.Items.Count - 1 do
begin
clb.Items.Add(d_kc.Items.Strings[i]);
clb.Checked[clb.Items.Count - 1] := d_kc.Checked[i]
end;
for i := 0 to d_zhcx.Items.Count - 1 do
begin
clb.Items.Add(d_zhcx.Items.Strings[i]);
clb.Checked[clb.Items.Count - 1] := d_zhcx.Checked[i]
end;
with frmUserList do
begin
if not SaveGroup(ListBox1.Items, clb) then
CHQMsgBox('請先確定該權(quán)限組沒有隸屬成員,并且不包含任何模塊權(quán)限!');
end;
finally
clb.Free;
end;
end;
procedure TfrmGroup.BitBtn4Click(Sender: TObject);
begin
inherited;
frmUserList.qryGroup.CancelUpdates;
Close;
end;
procedure TfrmGroup.BitBtn5Click(Sender: TObject);
begin
inherited;
frmUserList.qryGroup.Append;
BoxMoveAllItems(ListBox1, ListBox2);
BoxMoveAllItems(d_csh, s_csh);
BoxMoveAllItems(d_jyp, s_jyp);
BoxMoveAllItems(d_txp, s_txp);
BoxMoveAllItems(d_yp, s_yp);
BoxMoveAllItems(d_grp, s_grp);
BoxMoveAllItems(d_kc, s_kc);
BoxMoveAllItems(d_zhcx, s_zhcx);
bitbtn3.Enabled := True;
DBEdit1.SetFocus;
end;
procedure TfrmGroup.BitBtn6Click(Sender: TObject);
const
DSQL = 'Delete From TGS_RYZBDZB Where ZBDM = ''%s''';
D2SQL = 'Delete From TGS_RYB Where YGDM = ''%s''';
SSQL = 'SELECT YGDM FROM TGS_RYZBDZB WHERE ZBDM = ''%s''';
D3SQL = 'Delete From TGS_MKZBGXB Where ZBDM = ''%s''';
begin
inherited;
with frmUserList.qryGroup do
if CHQMsgBox(MSG_DELETE, 2) = IDYES then
begin
begin
data.dm.StartTransaction;
try
SetData(Format(DSQL, [FieldByName('ZBDM').Asstring]));
SetData(Format(D3SQL, [FieldByName('ZBDM').Asstring]));
Delete;
except
data.dm.rollback;
if errMsg = '' then
raise
else
raise exception.Create(errMsg)
end;
CommitUpdates;
data.dm.commit;
end;
frmUserList.qryGroup.AfterScroll(nil);
InitData;
end;
end;
procedure TfrmGroup.FormCreate(Sender: TObject);
begin
inherited;
V_ZBDM := TStringList.Create;
with qrytemp do
begin
Close;
Sql.Clear;
Sql.Add('select ZBDM from TGS_RYZBDZB where YGDM=''' + VG_UserID + '''');
Open;
while not Eof do
begin
v_ZBDM.Add(Fields[0].AsString);
next;
end;
end;
frmUserList.qryGroup.AfterScroll(nil);
InitData;
PgCtl_mk.ActivePageIndex := 0;
end;
procedure TfrmGroup.BitBtn1Click(Sender: TObject);
begin
if ListBox2.Items.Count = 0 then
exit;
if (Copy(ListBox2.Items[ListBox2.ItemIndex], 1, Pos(' ', ListBox2.Items[ListBox2.ItemIndex]) - 1) = '1') or
(Copy(ListBox2.Items[ListBox2.ItemIndex], 1, Pos(' ', ListBox2.Items[ListBox2.ItemIndex]) - 1) = VG_UserID) then
exit;
BoxMoveSelectedItems(ListBox2, ListBox1);
end;
procedure TfrmGroup.BitBtn2Click(Sender: TObject);
begin
if ListBox1.Items.Count = 0 then
exit;
if (Copy(ListBox1.Items[ListBox1.ItemIndex], 1, Pos(' ', ListBox1.Items[ListBox1.ItemIndex]) - 1) = '1') or
(Copy(ListBox1.Items[ListBox1.ItemIndex], 1, Pos(' ', ListBox1.Items[ListBox1.ItemIndex]) - 1) = VG_UserID) then
exit;
BoxMoveSelectedItems(ListBox1, ListBox2);
end;
procedure TfrmGroup.MoveAdd(sLstBox: TListBox; dLstBox: TCheckListBox);
var
i: integer;
begin
BoxMoveSelectedItems(sLstBox, dLstBox);
for i := 0 to dLstBox.Items.Count - 1 do
dLstBox.Checked[i] := True;
end;
procedure TfrmGroup.InitData;
const
NSQL = 'Select YGDM||'' ''||YGMC From TGS_RYB Where YGDM not in (Select ygdm From tgs_RYZBDZB where zbdm = ''%s'') order by YGDM';
INSQL = 'Select Y.YGDM||'' ''||Y.YGMC From TGS_RYZBDZB R, TGS_RYB Y Where R.YGDM =Y.YGDM AND ZBDM = ''%s'' order by Y.YGDM';
MNSQL = 'SELECT MKDM||'' ''||MKMC FROM TGS_MKB Where MKDM not in (Select MKDM From TGS_MKZBGXB where ZBDM = ''%s'') order by MKDM';
MINSQL = 'SELECT K.MKDM||'' ''||K.MKMC, M.QX FROM TGS_MKZBGXB M, TGS_MKB K WHERE M.MKDM = K.MKDM AND M.ZBDM = ''%s'' order by K.MKDM';
var
clb: TCheckListBox;
lb: TListBox;
procedure DoClearCheckedList(IsD: boolean = true);
begin
if IsD then
begin
d_csh.Items.Clear;
d_jyp.Items.Clear;
d_txp.Items.Clear;
d_yp.Items.Clear;
d_grp.Items.Clear;
d_kc.Items.Clear;
d_zhcx.Items.Clear;
end
else
begin
s_csh.Items.Clear;
s_jyp.Items.Clear;
s_txp.Items.Clear;
s_yp.Items.Clear;
s_grp.Items.Clear;
s_kc.Items.Clear;
s_zhcx.Items.Clear;
end;
end;
begin
InitList(ListBox2.Items, Format(NSQL, [frmUserList.qryGroup.FieldByName('ZBDM').Asstring]));
InitList(ListBox1.Items, Format(INSQL, [frmUserList.qryGroup.FieldByName('ZBDM').Asstring]));
GetData(Format(MNSQL, [frmUserList.qryGroup.FieldByName('ZBDM').Asstring]));
with data.qrytmp do
begin
DoClearCheckedList(false);
First;
while not Eof do
begin
lb := nil;
case strToint(Copy(Fields[0].Asstring, 1, 1)) of
1: lb := s_csh;
2: lb := s_jyp;
3: lb := s_txp;
4: lb := s_yp;
5: lb := s_grp;
6: lb := s_kc;
9: lb := s_zhcx;
end;
if lb <> nil then
begin
if lb.Items.IndexOf(Fields[0].Asstring) < 0 then
begin
lb.Items.Add(Fields[0].Asstring);
end;
end
else
begin
CHQMsgBox('數(shù)據(jù)有錯!');
Break;
end;
Next;
end;
Close;
end;
GetData(Format(MINSQL, [frmUserList.qryGroup.FieldByName('ZBDM').Asstring]));
with data.qrytmp do
begin
DoClearCheckedList;
First;
while not Eof do
begin
clb := nil;
case strToint(Copy(Fields[0].Asstring, 1, 1)) of
1: clb := d_csh;
2: clb := d_jyp;
3: clb := d_txp;
4: clb := d_yp;
5: clb := d_grp;
6: clb := d_kc;
7: clb := d_zhcx;
9: clb := d_zhcx;
end;
if clb <> nil then
begin
clb.Items.Add(Fields[0].Asstring);
clb.Checked[clb.Items.Count - 1] := iif(Fields[1].Asstring = '1', True, False);
end
else
begin
CHQMsgBox('數(shù)據(jù)有錯!');
Break;
end;
Next;
end;
Close;
end;
end;
procedure TfrmGroup.BitBtn7Click(Sender: TObject);
begin
MoveAdd(s_csh, d_csh);
end;
procedure TfrmGroup.BitBtn9Click(Sender: TObject);
begin
MoveAdd(s_jyp, d_jyp);
end;
procedure TfrmGroup.BitBtn11Click(Sender: TObject);
begin
MoveAdd(s_txp, d_txp);
end;
procedure TfrmGroup.BitBtn13Click(Sender: TObject);
begin
MoveAdd(s_yp, d_yp);
end;
procedure TfrmGroup.BitBtn15Click(Sender: TObject);
begin
MoveAdd(s_grp, d_grp);
end;
procedure TfrmGroup.BitBtn17Click(Sender: TObject);
begin
MoveAdd(s_kc, d_kc);
end;
procedure TfrmGroup.BitBtn8Click(Sender: TObject);
begin
BoxMoveSelectedItems(d_csh, s_csh);
end;
procedure TfrmGroup.BitBtn10Click(Sender: TObject);
begin
BoxMoveSelectedItems(d_jyp, s_jyp);
end;
procedure TfrmGroup.BitBtn12Click(Sender: TObject);
begin
BoxMoveSelectedItems(d_txp, s_txp);
end;
procedure TfrmGroup.BitBtn14Click(Sender: TObject);
begin
BoxMoveSelectedItems(d_yp, s_yp);
end;
procedure TfrmGroup.BitBtn16Click(Sender: TObject);
begin
BoxMoveSelectedItems(d_grp, s_grp);
end;
procedure TfrmGroup.BitBtn18Click(Sender: TObject);
begin
BoxMoveSelectedItems(d_kc, s_kc);
end;
procedure TfrmGroup.N1Click(Sender: TObject);
begin
inherited;
SetCustomListBox(Sender, true);
end;
procedure TfrmGroup.N2Click(Sender: TObject);
begin
inherited;
SetCustomListBox(Sender, false);
end;
procedure TfrmGroup.SetCustomListBox(Sender: TObject; p_b_SelectAll: boolean);
begin
{ i := TCustomListBox(Sender).Items.Count;
for i:= 0 to TCustomListBox(Sender).Items.Count -1 do
begin
TCustomListBox(Sender).Selected[i] := p_b_SelectAll;
end;}
end;
procedure TfrmGroup.BitBtn19Click(Sender: TObject);
begin
MoveAdd(s_zhcx, d_zhcx);
end;
procedure TfrmGroup.BitBtn20Click(Sender: TObject);
begin
BoxMoveSelectedItems(d_zhcx, s_zhcx);
end;
procedure TfrmGroup.FormShow(Sender: TObject);
begin
inherited;
frmUserList.qryGroup.AfterScroll(nil);
end;
procedure TfrmGroup.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
if V_ZBDM <> nil then
V_ZBDM.Free;
end;
end.
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -