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

📄 group.pas

📁 省级集邮品管理ERP
💻 PAS
字号:
{*******************************************************}
{                                                       }
{                                                       }
{                                                       }
{            中软金马公司版权所有。2002.12前            }
{                                                       }
{            编制:中软金马邮资票品项目开发组           }
{                                                       }
{                                                       }
{*******************************************************}
(*
本模块在省级系统管理里面调用。

*)

{
有关表:
  组别表、人员组别表、模块组别关系表
  人员表、模块表
数据来源:
  组户:组别表
  成员:人员组别表
  非成员:人员表
  有权模块:模块组别关系表
  无权模块:模块表
功能:
算法:
更新有关表: 组别表、人员表、模块组别关系表
备注:
}
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('请先确定该权限组没有隶属成员,并且不包含任何模块权限!');
    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('数据有错!');
        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('数据有错!');
        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.

⌨️ 快捷键说明

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