glfywh.pas
来自「应对服装行业的生产成本控制系统」· PAS 代码 · 共 845 行 · 第 1/2 页
PAS
845 行
unit glfywh;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ComCtrls, Grids, DBGrids, ExtCtrls, DBCtrls,
DB, ADODB, DBClient;
type
TFrmglfywh = class(TForm)
Pz: TPanel;
help: TLabel;
GroupBox4: TGroupBox;
DBGrid1: TDBGrid;
Label25: TLabel;
Label26: TLabel;
Label28: TLabel;
Label29: TLabel;
Label41: TLabel;
SpeedButton2: TSpeedButton;
Label1: TLabel;
Label4: TLabel;
Label5: TLabel;
rq: TDateTimePicker;
tbxr: TEdit;
tzy: TEdit;
tbh: TEdit;
tbz: TEdit;
tje: TEdit;
Label8: TLabel;
tddh: TEdit;
Label6: TLabel;
fb: TDBLookupComboBox;
SpeedButton1: TSpeedButton;
fylb: TEdit;
pq: TPanel;
cqrq: TCheckBox;
cje: TCheckBox;
czrq: TCheckBox;
zrq: TDateTimePicker;
qje: TEdit;
cbxr: TCheckBox;
qbxr: TEdit;
cfz: TCheckBox;
qfz: TEdit;
czy: TCheckBox;
qzy: TEdit;
cfylb: TCheckBox;
cbz: TCheckBox;
qfylb: TEdit;
qbz: TEdit;
qrq: TDateTimePicker;
Cczy: TCheckBox;
qczy: TEdit;
cfb: TCheckBox;
qfb: TEdit;
cddh: TCheckBox;
qddh: TEdit;
Pd: TPanel;
brework: TBitBtn;
bsave: TBitBtn;
bcancel: TBitBtn;
bprint: TBitBtn;
breturn: TBitBtn;
Bdelete: TBitBtn;
Bquery: TBitBtn;
bsh: TBitBtn;
fz: TDBLookupComboBox;
DBGrid4: TDBGrid;
procedure tjeKeyPress(Sender: TObject; var Key: Char);
procedure tbhKeyPress(Sender: TObject; var Key: Char);
procedure rqKeyPress(Sender: TObject; var Key: Char);
procedure tksKeyPress(Sender: TObject; var Key: Char);
procedure tbxrKeyPress(Sender: TObject; var Key: Char);
procedure tzyKeyPress(Sender: TObject; var Key: Char);
procedure fylbKeyPress(Sender: TObject; var Key: Char);
procedure tbzKeyPress(Sender: TObject; var Key: Char);
procedure bcancelClick(Sender: TObject);
procedure bprintClick(Sender: TObject);
procedure breturnClick(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure DBGrid4DblClick(Sender: TObject);
procedure DBGrid1TitleClick(Column: TColumn);
procedure bsaveClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure BqueryClick(Sender: TObject);
procedure breworkClick(Sender: TObject);
procedure BdeleteClick(Sender: TObject);
procedure bshClick(Sender: TObject);
procedure DBGrid1DblClick(Sender: TObject);
procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure fbKeyPress(Sender: TObject; var Key: Char);
procedure tddhKeyPress(Sender: TObject; var Key: Char);
procedure SpeedButton1Click(Sender: TObject);
procedure fylbChange(Sender: TObject);
procedure fzKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
rzczy,rzsj,rzjsj,rzcsj:string;
errzt: integer;
errcode:boolean;
commandstring,commandstringq: string;
function check():boolean;
function save():boolean;
public
{ Public declarations }
end;
var
Frmglfywh: TFrmglfywh;
implementation
uses unit28, Unit1, Unit16, fylb, xtfz;
{$R *.dfm}
procedure TFrmglfywh.tjeKeyPress(Sender: TObject; var Key: Char);
begin
if not (key in['0'..'9',#8,#13,'.','-']) then
begin
key:=#0;
help.caption:=' 请输入数字!';
end;
if key=#13 then tbz.SetFocus;
end;
procedure TFrmglfywh.tbhKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then rq.SetFocus;
end;
procedure TFrmglfywh.rqKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then fb.SetFocus;
end;
procedure TFrmglfywh.tksKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then tbxr.SetFocus;
end;
procedure TFrmglfywh.tbxrKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then tzy.SetFocus;
end;
procedure TFrmglfywh.tzyKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then fylb.SetFocus;
end;
procedure TFrmglfywh.fylbKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then tje.SetFocus;
end;
procedure TFrmglfywh.tbzKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then bsave.SetFocus;
end;
function TFrmglfywh.check:boolean;
begin
result:=true;
if trim(fb.Text)='' then
begin
showmessage('请选择一个分部,如果没有出现在列表中,请您添加进来!');
result:=false;
fb.SetFocus;
exit;
end;
if trim(tddh.Text)='' then
begin
showmessage('请选择一个订单号,如果没有出现在列表中,请您添加进来!');
result:=false;
tddh.SetFocus;
exit;
end;
if trim(fylb.Text)='' then
begin
showmessage('请您选择费用类别!');
result:=false;
fylb.SetFocus;
exit;
end;
if trim(tje.Text)='' then
begin
showmessage('金额不能为空!');
result:=false;
tje.SetFocus;
exit;
end;
end;
function TFrmglfywh.save:boolean;
var
relation,cx,dx,sqlstr:string;
begin
try
relation:=' = ''';
cx:='';
dx:= ' ''';
tbh.Text:=trim(tbh.Text);
tbxr.Text:=trim(tbxr.text);
tzy.Text:=trim(tzy.Text);
tje.Text:=trim(tje.Text);
tddh.Text:=trim(tddh.Text);
tbz.Text:=trim(tbz.Text);
errcode:=true;
errzt:=1;
DataModule1.ClientDataSet26.DisableControls;
sqlstr:='update dbo.scfyb set rq'+relation+datetimetostr(rq.Date)+dx+' ,bxr'+relation+tbxr.Text+dx+' ,fb'+relation+fb.Text+dx+' ,fz'+relation+fz.Text+dx+' ,zy'+relation+tzy.Text+dx+' ,fylb'+relation+fylb.Text+dx+' ,je'+relation+tje.Text+dx+' ,bz'+relation+tbz.Text;
sqlstr:=sqlstr+dx+' ,czy'+relation+form1.StatusBar1.Panels[4].text+dx;
sqlstr:=sqlstr+' where (fyh' +relation+cx+tbh.Text+cx+''')';
DataModule1.ClientDataSet26.CommandText:=sqlstr;
DataModule1.ClientDataSet26.Execute;
DataModule1.ClientDataSet26.Close;
DataModule1.ClientDataSet26.CommandText:=commandstringq;
DataModule1.ClientDataSet26.Open;
DataModule1.ClientDataSet26.EnableControls;
DataModule1.ClientDataSet26.Locate('fyh',tbh.Text,[]);
errcode:=false;
errzt:=0;
except
DataModule1.clientDataSet26.EnableControls;
errcode:=true;
errzt:=1;
showmessage('数据库没有打开!');
end;
end;
procedure TFrmglfywh.bcancelClick(Sender: TObject);
var
i,i1:integer;
begin
try
bsave.Enabled:=false;
brework.Enabled:=false;
bdelete.Enabled:=false;
bsh.Enabled:=false;
bcancel.Enabled:=false;
bprint.Enabled:=false;
dbgrid1.Enabled:=true;
fz.KeyValue:='';
tbxr.Text:='';
tzy.Text:='';
tje.Text:='';
tbz.Text:='';
help.Caption:=' 要修改记录请选择费用记录!';
except
showmessage('数据库没有打开!')
end;
end;
procedure TFrmglfywh.bprintClick(Sender: TObject);
begin
help.Caption:=' 暂不提供打印功能!';
end;
procedure TFrmglfywh.breturnClick(Sender: TObject);
begin
try
rzcsj:=datetimetostr(now);
form16.WriteTorz(rzczy,rzsj,rzjsj,rzcsj);
DataModule1.ClientDataSet17.IndexFieldNames:='';
if DataModule1.ClientDataSet17.Active then DataModule1.ClientDataSet12.Active:=false;
DataModule1.ClientDataSet26.IndexFieldNames:='';
if DataModule1.ClientDataSet26.Active then DataModule1.ClientDataSet12.Active:=false;
if DataModule1.clientdataset1.Active then DataModule1.ClientDataSet1.Active:=false;
if DataModule1.clientdataset2.Active then DataModule1.ClientDataSet2.Active:=false;
if DataModule1.clientdataset16.Active then DataModule1.ClientDataSet16.Active:=false;
except
showmessage('数据库没有打开!');
end;
close;
end;
procedure TFrmglfywh.SpeedButton2Click(Sender: TObject);
begin
fz.KeyValue:='';
end;
procedure TFrmglfywh.DBGrid4DblClick(Sender: TObject);
begin
if not DataModule1.ClientDataSet16.Active then exit;
if DataModule1.ClientDataSet16.RecordCount>0 then
begin
fylb.Text:=DataModule1.ClientDataSet16.FieldByName('fylb').AsString;
tje.SetFocus;
end;
end;
procedure TFrmglfywh.DBGrid1TitleClick(Column: TColumn);
var i : integer;
begin
for i:= 1 to DBGrid1.Columns.Count do
begin
//恢复所有标题字体为默认
DBGrid1.Columns[i-1].Title.Font.Color := clBlue;
DBGrid1.Columns[i-1].Title.Font.Style := [];
end;
if DataModule1.ClientDataSet26.IndexFieldNames<>(Column.FieldName) then //判断原排序方式
begin
DataModule1.ClientDataSet26.IndexFieldNames:= Column.FieldName;
Column.Title.Font.Color := clRed; //改变标题行字体为红色,表示当前的排序方式为升序
Column.Title.Font.Style := [fsBold];
end;
end;
procedure TFrmglfywh.bsaveClick(Sender: TObject);
var
datestr:string;
begin
datestr:=frmxtfz.checkfzrq(formatdatetime('yyyy-mm-dd',rq.date));
if datestr<>'' then
begin
help.Caption:=' 封账日期为'+datestr+'您不能修改封账日期前的数据';
exit;
end;
if not bsave.Enabled then exit;
bsave.Enabled:=false;
bcancel.Enabled:=false;
errcode:=true;
errzt:=1;
if not check then
begin
bsave.Enabled:=true;
bcancel.Enabled:=true;
exit;
end;
form1.fylb:=trim(fylb.Text);
frmfylb.checkfylb(form1.fylb);
if form1.fylb='' then
begin
bsave.Enabled:=true;
bcancel.Enabled:=true;
fylb.SetFocus;
help.Caption:=' 该费用类别不存在,请您输入正确的费用类别!';
exit;
end;
form1.fylb:='';
try
save;
if errcode or (errzt<>0) then save;
if errcode or (errzt<>0) then save;
if errcode or (errzt<>0) then save;
if errcode or (errzt<>0) then
begin
showmessage(' 数据库在保存记录时失败,请您稍后重新保存!');
bsave.Enabled:=true;
bcancel.Enabled:=true;
exit;
end;
help.Caption:=' 记录费用修改操作成功!' ;
fz.KeyValue:='';
tbxr.Text:='';
tzy.Text:='';
tje.Text:='';
tbz.Text:='';
brework.Enabled:=false;
bdelete.Enabled:=false;
bsh.Enabled:=true;
bprint.Enabled:=true;
dbgrid1.Enabled:=true;
except
bsave.Enabled:=true;
bcancel.Enabled:=true;
showmessage(' 记录费用时出现了系统无法识别的错误,请您主动辨别该错误!');
end;
end;
procedure TFrmglfywh.FormActivate(Sender: TObject);
begin
rzjsj:=datetimetostr(now);
rzczy:=form1.StatusBar1.Panels[4].Text;
rzsj:='记录费用维护';
rq.DateTime:=date;
help.Caption:='';
bquery.Enabled:=true;
brework.Enabled:=false;
bsave.Enabled:=false;
bdelete.Enabled:=false;
bsh.Enabled:=false;
bcancel.Enabled:=false;
bprint.Enabled:=false;
pz.Enabled:=true;
fz.KeyValue:='';
tbxr.Text:='';
tzy.Text:='';
tje.Text:='';
tbz.Text:='';
try
DataModule1.ClientDataSet1.Close;
DataModule1.ClientDataSet1.CommandText:='select * from fbb order by xh';
DataModule1.ClientDataSet1.Open;
DataModule1.ClientDataSet2.Close;
DataModule1.ClientDataSet2.CommandText:='select * from fzb order by xh';
DataModule1.ClientDataSet2.Open;
except
showmessage('数据库没有打开!')
end;
help.Caption:=' 请您点击<新增>按钮开始记录数据!';
pz.Enabled:=false;
end;
procedure TFrmglfywh.FormClose(Sender: TObject; var Action: TCloseAction);
begin
try
DataModule1.ClientDataSet26.IndexFieldNames:='';
if DataModule1.ClientDataSet26.Active then DataModule1.ClientDataSet12.Active:=false;
DataModule1.ClientDataSet17.IndexFieldNames:='';
if DataModule1.ClientDataSet17.Active then DataModule1.ClientDataSet17.Active:=false;
if DataModule1.clientdataset1.Active then DataModule1.ClientDataSet1.Active:=false;
if DataModule1.clientdataset2.Active then DataModule1.ClientDataSet2.Active:=false;
if DataModule1.clientdataset16.Active then DataModule1.ClientDataSet16.Active:=false;
if rzcsj<>'' then exit;
rzcsj:=datetimetostr(now);
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?