basedepartment.pas

来自「产品信息系统!关于产品基础信息的系统!功能强大!」· PAS 代码 · 共 193 行

unit BaseDepartment;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, BaseInfoBase, DB, ADODB, ActnList, ComCtrls, ToolWin, StdCtrls,
  ExtCtrls, Grids, DBGrids, Mask, DBCtrls, wwDialog, wwidlg, dxExEdtr,
  Buttons, dxTL, dxDBCtrl, dxCntner, dxDBTL;

type
  TfrmBaseDepartment = class(TfrmBaseInfoBase)
    Splitter1: TSplitter;
    Panel1: TPanel;
    QBaseInfofCode: TWideStringField;
    QBaseInfofDeptName: TWideStringField;
    QBaseInfofDeptManager: TWideStringField;
    QBaseInfofAddress: TWideStringField;
    QBaseInfofTel: TWideStringField;
    QBaseInfofFax: TWideStringField;
    QBaseInfofEmail: TWideStringField;
    QBaseInfofStatus: TBooleanField;
    QBaseInfofNotes: TWideStringField;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label10: TLabel;
    DBEdit1: TDBEdit;
    DBEdit2: TDBEdit;
    DBEdit3: TDBEdit;
    DBEdit4: TDBEdit;
    DBEdit5: TDBEdit;
    DBEdit6: TDBEdit;
    DBEdit7: TDBEdit;
    DBEdit9: TDBEdit;
    DBCheckBox1: TDBCheckBox;
    QBaseInfofID: TAutoIncField;
    QBaseInfofParentID: TIntegerField;
    QBaseInfofParentCode: TWideStringField;
    dxDBTreeList1: TdxDBTreeList;
    dxDBTreeList1fCode: TdxDBTreeListColumn;
    dxDBTreeList1fName: TdxDBTreeListColumn;
    bbtParent: TBitBtn;
    bbtSelf: TBitBtn;
    bbtChild: TBitBtn;
    acParent: TAction;
    acSelf: TAction;
    acChild: TAction;
    procedure QBaseInfoBeforePost(DataSet: TDataSet);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure QBaseInfofCodeValidate(Sender: TField);
    procedure dsBaseInfoStateChange(Sender: TObject);
    procedure acParentExecute(Sender: TObject);
    procedure acSelfExecute(Sender: TObject);
    procedure acChildExecute(Sender: TObject);
    procedure dxDBTreeList1ChangeNode(Sender: TObject; OldNode,
      Node: TdxTreeListNode);
    procedure QBaseInfoAfterInsert(DataSet: TDataSet);
    procedure acDeleteExecute(Sender: TObject);
  private
    iParentID, iSelfID: Integer;
    sParentCode, sSelfCode: string;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmBaseDepartment : TfrmBaseDepartment;

implementation

{$R *.dfm}

procedure TfrmBaseDepartment.QBaseInfoBeforePost(DataSet: TDataSet);
begin
  inherited;
  if (QBaseInfo.FieldbyName('fCode').asString = '') then
  begin
    showmessage('部门编号不能为空，请重新输入！');
    abort;
  end;
end;

procedure TfrmBaseDepartment.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  inherited;
  frmBaseDepartment := nil;
end;

procedure TfrmBaseDepartment.QBaseInfofCodeValidate(Sender: TField);
var
  sParentCode, sCode: string;
begin
  inherited;
  sParentCode := QBaseInfo.FieldbyName('fParentCode').asString;
  sCode := QBaseInfo.FieldbyName('fCode').asString;
  if sParentCode <> copy(sCode, 1, Length(sParentCode)) then
    raise Exception.create('子类的代码必须继承父类的代码');

  if not IsUnique('Code', Sender.asString) then
  begin
    showmessage('部门编码重复，请重新输入');
    abort;
  end;
end;

procedure TfrmBaseDepartment.dsBaseInfoStateChange(Sender: TObject);
var
  i                 : Integer;
begin
  inherited;
  acParent.Enabled := acNew.Enabled;
  acSelf.Enabled := acNew.Enabled;
  acChild.Enabled := acNew.Enabled;
  dxDBTreeList1.Enabled := not acSave.Enabled;
  if acSave.Enabled then
    dxDBTreeList1.OptionsDB := dxDBTreeList1.OptionsDB - [etoCanNavigation]
  else if not (etoCanNavigation in dxDBTreeList1.OptionsDB) then
    dxDBTreeList1.OptionsDB := dxDBTreeList1.OptionsDB + [etoCanNavigation];

  with Panel2 do
    for i := 0 to ControlCount - 1 do
      if Controls[i] is TDBEdit then
        (Controls[i] as TDBEdit).ReadOnly := not acSave.Enabled
      else if Controls[i] is TDBMemo then
        (Controls[i] as TDBMemo).ReadOnly := not acSave.Enabled;
end;

procedure TfrmBaseDepartment.acParentExecute(Sender: TObject);
begin
  inherited;
  QBaseInfo.Append;
  QBaseInfo.FieldbyName('fParentID').asInteger := 0;
  QBaseInfo.FieldbyName('fParentCode').asString := '';
end;

procedure TfrmBaseDepartment.acSelfExecute(Sender: TObject);
begin
  inherited;
  QBaseInfo.Append;
  QBaseInfo.FieldbyName('fParentID').asInteger := iParentID;
  QBaseInfo.FieldbyName('fParentCode').asString := sParentCode;
  QBaseInfo.FieldbyName('fCode').asString := sParentCode + '-';
  DBEdit1.SelStart := Length(DBEdit1.text);
end;

procedure TfrmBaseDepartment.acChildExecute(Sender: TObject);
begin
  inherited;
  QBaseInfo.Append;
  QBaseInfo.FieldbyName('fParentID').asInteger := iSelfID;
  QBaseInfo.FieldbyName('fParentCode').asString := sSelfCode;
  QBaseInfo.FieldbyName('fCode').asString := sSelfCode + '-';
  DBEdit1.SelStart := Length(DBEdit1.text);
end;

procedure TfrmBaseDepartment.dxDBTreeList1ChangeNode(Sender: TObject;
  OldNode, Node: TdxTreeListNode);
begin
  inherited;
  if not (QBaseInfo.State in [dsInsert, dsEdit]) then
  begin
    iParentID := QBaseInfo.FieldbyName('fParentID').asInteger;
    iSelfID := QBaseInfo.FieldbyName('fID').asInteger;
    sParentCode := QBaseInfo.FieldbyName('fParentCode').asString;
    sSelfCode := QBaseInfo.FieldbyName('fCode').asString;
  end;
end;

procedure TfrmBaseDepartment.QBaseInfoAfterInsert(DataSet: TDataSet);
begin
  inherited;
  DBEdit1.SetFocus;
end;

procedure TfrmBaseDepartment.acDeleteExecute(Sender: TObject);
begin
  if dxDBTreeList1.FocusedNode.Count > 0 then
    raise Exception.create('请先删除子类');
  inherited;

end;

end.