📄 baseproducttype.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 + -