📄 basesetup.pas
字号:
unit BaseSetup;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ExtCtrls, StdCtrls, Buttons, dxtree, dxdbtree, Menus,
Mask, DBCtrls;
type
TFrmBaseSetup = class(TForm)
BtnClose: TBitBtn;
Label1: TLabel;
PopupMenu1: TPopupMenu;
NewItme1: TMenuItem;
S1: TMenuItem;
N1: TMenuItem;
D1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
C1: TMenuItem;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
Label14: TLabel;
Label15: TLabel;
EdtIncName: TEdit;
BtnSaveIncName: TBitBtn;
TabSheet2: TTabSheet;
LBDeptName: TListBox;
EdtDeptName: TEdit;
BtnAdd: TBitBtn;
BtnDel: TBitBtn;
TabSheet3: TTabSheet;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label13: TLabel;
dxDBTV: TdxDBTreeView;
EdtWareNo: TDBEdit;
EdtWareName: TDBEdit;
EdtGuige: TDBEdit;
CmbUnit: TDBComboBox;
EdtPrice: TDBEdit;
MemoGoods: TDBMemo;
EdtID: TDBEdit;
CmbType: TDBComboBox;
TabSheet4: TTabSheet;
GroupBox1: TGroupBox;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
EdtOldPwd: TEdit;
EdtNewPwd: TEdit;
EdtCfmPwd: TEdit;
BitBtn1: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure EdtDeptNameChange(Sender: TObject);
procedure LBDeptNameClick(Sender: TObject);
procedure BtnAddClick(Sender: TObject);
procedure BtnDelClick(Sender: TObject);
procedure BtnSaveIncNameClick(Sender: TObject);
procedure EdtIncNameChange(Sender: TObject);
procedure NewItme1Click(Sender: TObject);
procedure S1Click(Sender: TObject);
procedure dxDBTVClick(Sender: TObject);
procedure PopupMenu1Popup(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure C1Click(Sender: TObject);
procedure dxDBTVDragDropTreeNode(Destination, Source: TTreeNode;
var Accept: Boolean);
procedure dxDBTVCustomDraw(Sender: TObject; TreeNode: TTreeNode;
AFont: TFont; var AColor, ABkColor: TColor);
procedure D1Click(Sender: TObject);
procedure EdtWareNoExit(Sender: TObject);
procedure EdtWareNameExit(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure EdtWareNameEnter(Sender: TObject);
private
{ Private declarations }
procedure ReadDeptName;
procedure ReadIncName;
procedure WriteIncName(i:integer);
procedure ReadWareData;
procedure DisabledAddSubItme;
procedure EnabledAddSubItme;
procedure ReadAllClassName;
procedure DeleteClassAllDataFromDatabase;
function DataRepeat(sField,sStr:string):boolean;
function OldpasswordIsRight(sPwd:string):boolean;
public
{ Public declarations }
end;
var
FrmBaseSetup: TFrmBaseSetup;
IsChanged:boolean = False;
IncNameIsEmpty:boolean =False;
TempGoods:string = '' ;
implementation
uses global,dm,logo;
{$R *.dfm}
procedure TFrmBaseSetup.FormCreate(Sender: TObject);
begin
self.Caption :=SFormBaseSetup;
Label1.Caption :=sAppName;
EdtDeptName.Text :='';
BtnDel.Enabled :=False;
EdtOldPwd.Text :='';
EdtNewPwd.Text :='';
EdtCfmPwd.Text :='';
EdtOldPwd.PasswordChar :='*';
EdtNewPwd.PasswordChar :='*';
EdtCfmPwd.PasswordChar :='*';
//TreeView 的设置(注:使用第三方控件ExpressDBTree)
dxDBTV.KeyField :=sFNo;
dxDBTV.ListField :=SFGoodsName;
dxDBTV.DisplayField :=SFGoodsName;
dxDBTV.ParentField :=sFParentNo;
with FrmLogo do
begin
LMsg1.Caption :=sMsgLoadInfo1;
LMsg2.Caption :=sMsgLoadInfo1;
LMsg1.Update;
LMsg2.Update;
end;
ReadDeptName; //Read department Setup
ReadIncName; //Read IncName Setup
ReadWareData; //Read Ware Name Setup
DisabledAddSubItme;
ReadAllClassName;
end;
procedure TFrmBaseSetup.ReadDeptName;
begin
LBDeptName.Items.Clear;
with Dm_Wjckgl.ADOQry do
begin
close;
sql.Text :=format(SSQLTY1,[STDept,SFDept]);
open;
first;
while not eof do
begin
if FieldValues[SFDept]<> null then
LBDeptName.Items.Add(FieldValues[SFDept]);
next;
end;
close;
end;
end;
procedure TFrmBaseSetup.ReadIncName;
begin
EdtIncName.Text :='';
with Dm_Wjckgl.ADOQry do
begin
close;
sql.Text :=format(SSQLTY0,[STCompanyName]);
open;
first;
if FieldValues[SFCompanyName]<> null then
EdtIncName.Text := FieldValues[SFCompanyName];
close;
end;
if Trim(EdtIncName.Text)='' then
IncNameIsEmpty := true
else
IncNameIsEmpty := False;
end;
procedure TFrmBaseSetup.EdtDeptNameChange(Sender: TObject);
begin
//要增加的项目为空时,“增加”按钮不可用
if trim(EdtDeptName.Text)='' then
BtnAdd.Enabled :=False
else
BtnAdd.Enabled :=true;
end;
procedure TFrmBaseSetup.LBDeptNameClick(Sender: TObject);
begin
//如果选择的项目不为空则“删除”按可使用
if LBDeptName.Items[LBDeptName.ItemIndex]='' then
//if (lbdeptname.ItemIndex<0 ) or (LBDeptName.ItemIndex >=LBDeptName.Items.Count) then
BtnDel.Enabled :=False
else
BtnDel.Enabled :=true;
end;
procedure TFrmBaseSetup.BtnAddClick(Sender: TObject);
begin
if LBDeptName.Items.IndexOf(EdtDeptName.Text)<>-1 then
begin
msgbox(sMsgRepeatSaveError,STitleError,1);
exit;
end;
// Write to Database
try
with DM_Wjckgl.ADOQry do
begin
close;
sql.Text :=sSQLInsertDeptName;
parameters.ParamByName('pDept').Value :=EdtDeptName.Text;
Execsql;
end;
LBDeptName.Items.Add(EdtDeptName.Text);
EdtDeptName.Text :='';
IsChanged:=True; //己经对基本信息进行过修改
except
msgbox(sMsgSaveError,STitleError,1);
EdtDeptName.SetFocus;
end;
end;
procedure TFrmBaseSetup.BtnDelClick(Sender: TObject);
begin
// Delete Confirm
if msgbox(sMsgDeleteConfirm ,STitleConfirm ,4)=IDNo then exit;
try
with DM_Wjckgl.ADOQry do
begin
close;
sql.Text :=format(SSQLDeleteData,[STDept,STDept,LBDeptName.Items[LBDeptName.ItemIndex]]);
execsql;
end;
LBDeptName.DeleteSelected;
IsChanged:=True; //己经对基本信息进行过修改
except
msgbox(sMsgDeleteError,STitleError,1);
end;
end;
procedure TFrmBaseSetup.WriteIncName(i:integer);
begin
if trim(EdtIncName.Text)='' then exit;
try
with DM_Wjckgl.ADOQry do
begin
close;
case i of
0:sql.Text := sSQLUpdateIncName;
1:sql.Text := sSqlInsertIncNmae
end;
parameters.ParamByName('pInc').Value :=EdtIncName.Text;
execsql;
end;
msgbox(sMsgSaveOk,STitleHint ,0);
IncNameIsEmpty:=False;
except
msgbox(sMsgSaveError,STitleError,1);
end;
end;
procedure TFrmBaseSetup.BtnSaveIncNameClick(Sender: TObject);
begin
// Save or alter company name
if IncNameIsEmpty then WriteIncName(1) else WriteIncName(0);
end;
procedure TFrmBaseSetup.EdtIncNameChange(Sender: TObject);
begin
if trim(EdtIncName.Text)='' then
BtnSaveIncName.Enabled :=False
else
BtnSaveIncName.Enabled :=true;
end;
procedure TFrmBaseSetup.NewItme1Click(Sender: TObject);
var
sWareType:string;
label A ; //为使用 GOTO语句
begin
A:
sWareType:='';
sWareType:=inputbox(sTitleAdd,sMsgEnterClassName,'');
if trim(sWareType)='' then exit;
// showmessage(copy(sWareType,Length(sWareType)-1,2));
if copy(sWareType,Length(sWareType)-1,2)<>'类' then
sWareType:=sWareType+'类';
if DataRepeat(SFGoodsName,sWareType) then
begin
msgbox(format(sMsgClassRepeat,[sWareType]),STitleError,1);
// exit;
goto A;
end;
with DM_Wjckgl.ADOQry do
begin
close;
sql.Text :=sSQLAddClassName;
parameters.ParamByName('pName').Value := sWareType;
parameters.ParamByName('pNo').Value :=-1;
parameters.ParamByName('pGG').Value :='类';
parameters.ParamByName('pDW').Value :='类';
parameters.ParamByName('pDJ').Value :=0;
parameters.ParamByName('pBZ').Value :='无';
execsql;
end;
// dxDBTV.Items.Add(dxDBTV.Selected,sWareType);
CmbType.Items.Add(sWareType);
ReadWareData;
IsChanged:=True; //己经对基本信息进行过修改
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -