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

📄 baseproducttype.pas

📁 产品信息系统!关于产品基础信息的系统!功能强大!
💻 PAS
字号:
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.

⌨️ 快捷键说明

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