baseproducttype.pas

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

unit BaseProductType;

interface

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

type
  TfrmBaseProductType = class(TfrmBaseInfoBase)
    Splitter1: TSplitter;
    Panel1: TPanel;
    QBaseInfofCode: TWideStringField;
    QBaseInfofTypeName: TWideStringField;
    QBaseInfofNotes: TWideStringField;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    DBEdit1: TDBEdit;
    DBEdit2: TDBEdit;
    DBMemo1: TDBMemo;
    QBaseInfofID: TAutoIncField;
    dxDBTreeList1: TdxDBTreeList;
    QBaseInfofParentID: TIntegerField;
    dxDBTreeList1fCode: TdxDBTreeListColumn;
    dxDBTreeList1fName: TdxDBTreeListColumn;
    bbtParent: TBitBtn;
    bbtSelf: TBitBtn;
    bbtChild: TBitBtn;
    acParent: TAction;
    acSelf: TAction;
    acChild: TAction;
    QBaseInfofParentCode: TWideStringField;
    Label4: TLabel;
    DBText1: TDBText;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure QBaseInfoBeforePost(DataSet: TDataSet);
    procedure dsBaseInfoStateChange(Sender: TObject);
    procedure acParentExecute(Sender: TObject);
    procedure dxDBTreeList1ChangeNode(Sender: TObject; OldNode,
      Node: TdxTreeListNode);
    procedure acSelfExecute(Sender: TObject);
    procedure acChildExecute(Sender: TObject);
    procedure QBaseInfoAfterInsert(DataSet: TDataSet);
    procedure QBaseInfofCodeValidate(Sender: TField);
    procedure acDeleteExecute(Sender: TObject);
  private
    { Private declarations }
    iParentID, iSelfID: Integer;
    sParentCode, sSelfCode: string;
  public
    { Public declarations }
  end;

var
  frmBaseProductType: TfrmBaseProductType;

implementation

{$R *.dfm}

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

procedure TfrmBaseProductType.QBaseInfoBeforePost(DataSet: TDataSet);
begin
  inherited;
  if (QBaseInfo.FieldbyName('fCode').asString = '') then
  begin
    showmessage('产品类别编号不能为空，请重新输入！');
    abort;
  end;
  if (QBaseInfo.FieldbyName('fName').asString = '') then
  begin
    showmessage('产品类别名称不能为空，请重新输入！');
    abort;
  end;
end;

procedure TfrmBaseProductType.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 TfrmBaseProductType.acParentExecute(Sender: TObject);
begin
  inherited;
  QBaseInfo.Append;
  QBaseInfo.FieldbyName('fParentID').asInteger := 0;
  QBaseInfo.FieldbyName('fParentCode').asString := '';
end;

procedure TfrmBaseProductType.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 TfrmBaseProductType.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 TfrmBaseProductType.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 TfrmBaseProductType.QBaseInfoAfterInsert(DataSet: TDataSet);
begin
  inherited;
  DBEdit1.SetFocus;
end;

procedure TfrmBaseProductType.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', QBaseInfo.FieldbyName('fCode').asString) then
  begin
    showmessage('产品类别编码重复，请重新输入');
    abort;
  end;
end;

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

end;

end.