📄 dhcl.pas
字号:
unit dhcl;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ComCtrls, Grids, DBGrids, ExtCtrls, DBCtrls,
DB, ADODB, DBClient;
type
TFrmdhcl = class(TForm)
Pz: TPanel;
Label25: TLabel;
Label28: TLabel;
Label29: TLabel;
Label41: TLabel;
help: TLabel;
GroupBox4: TGroupBox;
tclfl: TEdit;
tbz: TEdit;
txh: TEdit;
tcldw: TEdit;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
tsl: TEdit;
DBGrid1: TDBGrid;
Pd: TPanel;
pq: TPanel;
csq: TCheckBox;
cddh: TCheckBox;
qddh: TEdit;
cjglx: TCheckBox;
csz: TCheckBox;
sz: TDateTimePicker;
qjglx: TEdit;
ckhmc: TCheckBox;
qkhmc: TEdit;
ccpmc: TCheckBox;
qcpmc: TEdit;
csl: TCheckBox;
ccpfl: TCheckBox;
qsl: TEdit;
qcpfl: TEdit;
ccpdw: TCheckBox;
cdj: TCheckBox;
qcpdw: TEdit;
qdj: TEdit;
sq: TDateTimePicker;
cwgzt: TCheckBox;
cje: TCheckBox;
qwgzt: TEdit;
qje: TEdit;
Cjq: TCheckBox;
Cjz: TCheckBox;
jz: TDateTimePicker;
jq: TDateTimePicker;
GroupBox1: TGroupBox;
DBGrid5: TDBGrid;
tclmc: TEdit;
DBGrid4: TDBGrid;
bnew: TBitBtn;
bsave: TBitBtn;
bcancel: TBitBtn;
bprint: TBitBtn;
breturn: TBitBtn;
Bquery: TBitBtn;
Bdelete: TBitBtn;
OpenDialog1: TOpenDialog;
bprintc: TBitBtn;
procedure tslKeyPress(Sender: TObject; var Key: Char);
procedure txhKeyPress(Sender: TObject; var Key: Char);
procedure bcancelClick(Sender: TObject);
procedure bprintClick(Sender: TObject);
procedure breturnClick(Sender: TObject);
procedure DBGrid4DblClick(Sender: TObject);
procedure bsaveClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
procedure BqueryClick(Sender: TObject);
procedure DBGrid1DblClick(Sender: TObject);
procedure tclmcKeyPress(Sender: TObject; var Key: Char);
procedure tclflKeyPress(Sender: TObject; var Key: Char);
procedure tcldwKeyPress(Sender: TObject; var Key: Char);
procedure tclmcChange(Sender: TObject);
procedure BdeleteClick(Sender: TObject);
procedure bprintcClick(Sender: TObject);
procedure bnewClick(Sender: TObject);
procedure DBGrid1TitleClick(Column: TColumn);
procedure DBGrid5TitleClick(Column: TColumn);
procedure tbzKeyPress(Sender: TObject; var Key: Char);
procedure DBGrid5DblClick(Sender: TObject);
private
{ Private declarations }
rzczy,rzsj,rzjsj,rzcsj:string;
errzt: integer;
errcode:boolean;
commandstring,commandstringq: string;
function check():boolean;
function save():boolean;
function errdelete():boolean;
public
{ Public declarations }
end;
var
Frmdhcl: TFrmdhcl;
implementation
uses unit28, Unit1, Unit16, func;
{$R *.dfm}
procedure TFrmdhcl.tslKeyPress(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 TFrmdhcl.txhKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then tclmc.SetFocus;
end;
function TFrmdhcl.check:boolean;
begin
result:=true;
if trim(txh.Text)='' then
begin
showmessage('请您输入序号!');
result:=false;
txh.SetFocus;
exit;
end;
if trim(tclmc.Text)='' then
begin
showmessage('请您选择材料名称,如果没有出现在列表中,请您添加进来!');
result:=false;
tclmc.SetFocus;
exit;
end;
if trim(tclfl.Text)='' then
begin
showmessage('请选择一个材料分类,如果没有出现在列表中,请添加!');
result:=false;
tclfl.SetFocus;
exit;
end;
if trim(tcldw.Text)='' then
begin
showmessage('请选择一个材料单位,如果没有出现在列表中,请添加!');
result:=false;
tcldw.SetFocus;
exit;
end;
if trim(tsl.Text)='' then
begin
showmessage('请输入材料数量!');
result:=false;
tsl.SetFocus;
exit;
end;
end;
function TFrmdhcl.save:boolean;
begin
try
txh.Text:=trim(txh.Text);
tclmc.Text:=trim(tclmc.text);
tclfl.Text:=trim(tclfl.Text);
tcldw.Text:=trim(tcldw.Text);
tsl.Text:=trim(tsl.Text);
tbz.Text:=trim(tbz.Text);
errcode:=true;
errzt:=1;
if not DataModule1.ClientDataSet21.Locate('xh',txh.Text,[]) then
begin
DataModule1.clientdataset21.Edit;
DataModule1.ClientDataSet21.First;
DataModule1.clientdataset21.Insert;
DataModule1.clientdataset21.FieldByName('ddh').AsString:=DataModule1.clientdataset17.FieldByName('ddh').AsString;
DataModule1.clientdataset21.FieldByName('xh').AsString:=txh.Text;
DataModule1.clientdataset21.FieldByName('clmc').AsString:=tclmc.Text;
DataModule1.clientdataset21.FieldByName('clmc').AsString:=tclmc.Text;
DataModule1.clientdataset21.FieldByName('clfl').AsString:=tclfl.Text;
DataModule1.clientdataset21.FieldByName('cldw').AsString:=tcldw.Text;
DataModule1.clientdataset21.FieldByName('sl').AsString:=tsl.Text;
DataModule1.clientdataset21.FieldByName('bz').AsString:=tbz.Text;
DataModule1.clientdataset21.FieldByName('czy').AsString:=trim(form1.StatusBar1.Panels[4].text);
DataModule1.clientdataset21.ApplyUpdates(-1);
end;
errcode:=false;
errzt:=0;
except
errcode:=true;
errzt:=1;
showmessage('数据库没有打开!');
end;
end;
procedure TFrmdhcl.bcancelClick(Sender: TObject);
var
i,i1:integer;
begin
bnew.Enabled:=false;
bsave.Enabled:=false;
bcancel.Enabled:=false;
bprint.Enabled:=false;
bquery.Enabled:=true;
txh.Text:='';
tclmc.Text:='';
tclfl.Text:='';
tcldw.Text:='';
tsl.Text:='';
tbz.Text:='';
help.Caption:=' 继续录入请您重新选择订单号!';
dbgrid1.Enabled:=true;
end;
procedure TFrmdhcl.bprintClick(Sender: TObject);
begin
help.Caption:=' 暂不提供打印功能!';
end;
procedure TFrmdhcl.breturnClick(Sender: TObject);
begin
try
rzcsj:=datetimetostr(now);
form16.WriteTorz(rzczy,rzsj,rzjsj,rzcsj);
DataModule1.ClientDataSet17.IndexFieldNames:='';
DataModule1.ClientDataSet21.IndexFieldNames:='';
if DataModule1.clientdataset17.Active then DataModule1.ClientDataSet17.Active:=false;
if DataModule1.clientdataset21.Active then DataModule1.ClientDataSet21.Active:=false;
except
showmessage('数据库没有打开!');
end;
close;
end;
procedure TFrmdhcl.DBGrid4DblClick(Sender: TObject);
begin
if not DataModule1.ClientDataSet15.Active then exit;
if DataModule1.ClientDataSet15.RecordCount>0 then
begin
tclmc.Text:=DataModule1.ClientDataSet15.FieldByName('clmc').AsString;
tclfl.Text:=DataModule1.ClientDataSet15.FieldByName('clfl').AsString;
tcldw.text:=DataModule1.ClientDataSet15.FieldByName('cldw').AsString;
tsl.SetFocus;
end;
end;
procedure TFrmdhcl.bsaveClick(Sender: TObject);
begin
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;
if DataModule1.ClientDataSet21.Locate('xh',txh.Text,[]) then
begin
help.Caption:=' 该序号已经存在,请您修改序号后保存!';
exit;
end;
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(' 数据库在保存主记录时失败,请您稍后重新保存!');
errdelete;
bsave.Enabled:=true;
bcancel.Enabled:=true;
exit;
end;
help.Caption:=' 记录单货材料组成操作成功!' ;
txh.Text:='';
tclmc.Text:='';
tclfl.Text:='';
tcldw.Text:='';
tsl.Text:='';
tbz.Text:='';
bprint.Enabled:=true;
bnew.Enabled:=true;
bnew.SetFocus;
pz.Enabled:=false;
except
bsave.Enabled:=true;
bcancel.Enabled:=true;
showmessage(' 记录单货材料组成时出现了系统无法识别的错误,请您主动辨别该错误!');
end;
end;
function tFrmdhcl.errdelete:boolean;
var
relation,cx:string;
begin
relation:=' = ''';
cx:='';
try
commandstring:='delete from dbo.dhclb';
commandstring:=commandstring+' where (dbo.dhclb.ddh'+relation+cx+DataModule1.ClientDataSet17.fieldbyname('ddh').AsString+cx+''')';
commandstring:=commandstring+' and (dbo.dhclb.xh'+relation+cx+txh.Text+cx+''')';
DataModule1.ClientDataSet21.CommandText:=commandstring;
DataModule1.ClientDataSet21.Execute;
except
showmessage('数据库没有打开')
end;
end;
procedure TFrmdhcl.FormActivate(Sender: TObject);
var
commandstring,relation,cx,str:string;
begin
rzjsj:=datetimetostr(now);
rzczy:=form1.StatusBar1.Panels[4].Text;
rzsj:='单货材料组成追加信息录入';
sq.DateTime:=date-30;
sz.DateTime:=date;
jq.DateTime:=date;
jz.DateTime:=date+30;
help.Caption:='';
bquery.Enabled:=true;
bnew.Enabled:=false;
bsave.Enabled:=false;
bcancel.Enabled:=false;
bprint.Enabled:=false;
bdelete.Enabled:=false;
dbgrid1.Enabled:=true;
pz.Enabled:=false;
help.Caption:=' 请您点击< 查询>按钮开始查询订单记录!';
end;
procedure TFrmdhcl.FormClose(Sender: TObject; var Action: TCloseAction);
begin
try
DataModule1.ClientDataSet17.IndexFieldNames:='';
DataModule1.ClientDataSet21.IndexFieldNames:='';
if DataModule1.clientdataset17.Active then DataModule1.ClientDataSet17.Active:=false;
if DataModule1.clientdataset21.Active then DataModule1.ClientDataSet21.Active:=false;
if rzcsj<>'' then exit;
rzcsj:=datetimetostr(now);
form16.WriteTorz(rzczy,rzsj,rzjsj,rzcsj);
except
showmessage('数据库没有打开!');
end;
close;
end;
procedure TFrmdhcl.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
if DataModule1.ClientDataSet17.FieldByName('shbj').AsInteger=1 then
begin
dbgrid1.Canvas.Font.Color:=clred;
dbgrid1.Canvas.Brush.Color:=clyellow;
end
else
begin
dbgrid1.Canvas.Font.Color:=clblue;
dbgrid1.Canvas.Brush.Color:=clwhite;
end;
dbgrid1.DefaultDrawColumnCell(rect,datacol,column,state);
if ((State = [gdSelected]) or (State = [gdSelected, gdFocused])) then
begin
DBGrid1.Canvas.Brush.Color:=clred;
DBGrid1.Canvas.Font.Color:=clWhite;
DBGrid1.DefaultDrawColumnCell(Rect, datacol,column, State);
end;
end;
procedure TFrmdhcl.BqueryClick(Sender: TObject);
var
commandtring1,relation,cx:string;
begin
relation:=' like ''';
cx:='%';
commandstring:='select * from dbo.ddb';
commandtring1:='select * from dbo.ddb';
try
if (trim(qddh.Text)<>'') and (cddh.Checked) then
begin
relation:=' like ''';
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -