cllr.pas
来自「应对服装行业的生产成本控制系统」· PAS 代码 · 共 1,080 行 · 第 1/2 页
PAS
1,080 行
end;
procedure TFrmcllr.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 TFrmcllr.tygKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then tbh.SetFocus;
end;
procedure TFrmcllr.rqKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then tgh.SetFocus;
end;
procedure TFrmcllr.tczKeyPress(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 TFrmcllr.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 ''';
cx:='%';
if commandstring=commandtring1 then
begin
commandstring:=commandstring+' where (dbo.ddb.ddh'+relation+cx+trim(qddh.Text)+cx+''')';
end
else
begin
commandstring:=commandstring+' and (dbo.ddb.ddh'+relation+cx+trim(qddh.Text)+cx+''')';
end;
end
else
begin
qddh.Text:='';
end;
if (trim(qjglx.Text)<>'') and (cjglx.Checked) then
begin
relation:=' like ''';
cx:='%';
if commandstring=commandtring1 then
begin
commandstring:=commandstring+' where (dbo.ddb.jglx'+relation+cx+trim(qjglx.Text)+cx+''')';
end
else
begin
commandstring:=commandstring+' and (dbo.ddb.jglx'+relation+cx+trim(qjglx.Text)+cx+''')';
end;
end
else
begin
qjglx.Text:='';
end;
if (trim(qkhmc.Text)<>'') and (ckhmc.Checked) then
begin
relation:=' like ''';
cx:='%';
if commandstring=commandtring1 then
BEGIN
commandstring:=commandstring+' where (dbo.ddb.khmc'+relation+cx+TRIM(qkhmc.Text)+cx+''')'
END
else
BEGIN
commandstring:=commandstring+' and (dbo.ddb.khmc'+relation+cx+TRIM(qkhmc.Text)+cx+''')'
end;
end
else
begin
qkhmc.Text:='';
end;
if (trim(qcpmc.Text)<>'') and (ccpmc.Checked) then
begin
relation:=' like ''';
cx:='%';
if commandstring=commandtring1 then
BEGIN
commandstring:=commandstring+' where (dbo.ddb.cpmc'+relation+cx+TRIM(qcpmc.Text)+cx+''')'
END
else
BEGIN
commandstring:=commandstring+' and (dbo.ddb.cpmc'+relation+cx+TRIM(qcpmc.Text)+cx+''')'
end;
end
else
begin
qcpmc.Text:='';
end;
if (trim(qcpfl.Text)<>'') and (ccpfl.Checked) then
begin
relation:=' like ''';
cx:='%';
if commandstring=commandtring1 then
BEGIN
commandstring:=commandstring+' where (dbo.ddb.cpfl'+relation+cx+TRIM(qcpfl.Text)+cx+''')'
END
else
BEGIN
commandstring:=commandstring+' and (dbo.ddb.cpfl'+relation+cx+TRIM(qcpfl.Text)+cx+''')'
end;
end
else
begin
qcpfl.Text:='';
end;
if (trim(qcpdw.Text)<>'') and (ccpdw.Checked) then
begin
relation:=' like ''';
cx:='%';
if commandstring=commandtring1 then
BEGIN
commandstring:=commandstring+' where (dbo.ddb.cpdw'+relation+cx+TRIM(qcpdw.Text)+cx+''')'
END
else
BEGIN
commandstring:=commandstring+' and (dbo.ddb.cpdw'+relation+cx+TRIM(qcpdw.Text)+cx+''')'
end;
end
else
begin
qcpdw.Text:='';
end;
if csq.Checked then
begin
if commandstring=commandtring1 then
begin
relation:=' >= ''';
cx:='';
commandstring:=commandstring+' where (dbo.ddb.jdrq'+ relation+FormatDateTime('yyyy-mm-dd',sq.Date)+cx+''')';
end
else
begin
relation:=' >= ''';
cx:='';
commandstring:=commandstring+' and (dbo.ddb.jdrq'+ relation+FormatDateTime('yyyy-mm-dd',sq.Date)+cx+''')';
end;
end;
if csz.Checked then
begin
if commandstring=commandtring1 then
begin
relation:=' < ''';
cx:='';
commandstring:=commandstring+' where (dbo.ddb.jdrq'+ relation+FormatDateTime('yyyy-mm-dd',sz.Date+1)+cx+''')';
end
else
begin
relation:=' < ''';
cx:='';
commandstring:=commandstring+' and (dbo.ddb.jdrq'+ relation+FormatDateTime('yyyy-mm-dd',sz.Date+1)+cx+''')';
end;
end;
if cjq.Checked then
begin
if commandstring=commandtring1 then
begin
relation:=' >= ''';
cx:='';
commandstring:=commandstring+' where (dbo.ddb.jhrq'+ relation+FormatDateTime('yyyy-mm-dd',jq.Date)+cx+''')';
end
else
begin
relation:=' >= ''';
cx:='';
commandstring:=commandstring+' and (dbo.ddb.jhrq'+ relation+FormatDateTime('yyyy-mm-dd',jq.Date)+cx+''')';
end;
end;
if cjz.Checked then
begin
if commandstring=commandtring1 then
begin
relation:=' < ''';
cx:='';
commandstring:=commandstring+' where (dbo.ddb.jhrq'+ relation+FormatDateTime('yyyy-mm-dd',jz.Date+1)+cx+''')';
end
else
begin
relation:=' < ''';
cx:='';
commandstring:=commandstring+' and (dbo.ddb.jhrq'+ relation+FormatDateTime('yyyy-mm-dd',jz.Date+1)+cx+''')';
end;
end;
if (trim(qsl.Text)<>'') and (csl.Checked) then
begin
relation:=' like ''';
cx:='%';
if commandstring=commandtring1 then
begin
commandstring:=commandstring+' where (dbo.ddb.sl'+relation+cx+trim(qsl.Text)+cx+''')';
end
else
begin
commandstring:=commandstring+' and (dbo.ddb.sl'+relation+cx+trim(qsl.Text)+cx+''')';
end;
end
else
begin
qsl.Text:='';
end;
if (trim(qdj.Text)<>'') and (cdj.Checked) then
begin
relation:=' like ''';
cx:='%';
if commandstring=commandtring1 then
begin
commandstring:=commandstring+' where (dbo.ddb.dj'+relation+cx+trim(qdj.Text)+cx+''')';
end
else
begin
commandstring:=commandstring+' and (dbo.ddb.dj'+relation+cx+trim(qdj.Text)+cx+''')';
end;
end
else
begin
qdj.Text:='';
end;
if (trim(qje.Text)<>'') and (cje.Checked) then
begin
relation:=' like ''';
cx:='%';
if commandstring=commandtring1 then
begin
commandstring:=commandstring+' where (dbo.ddb.je'+relation+cx+trim(qje.Text)+cx+''')';
end
else
begin
commandstring:=commandstring+' and (dbo.ddb.je'+relation+cx+trim(qje.Text)+cx+''')';
end;
end
else
begin
qje.Text:='';
end;
commandstring:=commandstring+' order by ddh desc ';
commandstringq:=commandstring;
DataModule1.ClientDataSet17.DisableControls;
DataModule1.ClientDataSet17.Close;
DataModule1.ClientDataSet17.CommandText:=commandstring;
DataModule1.ClientDataSet17.Open;
DataModule1.ClientDataSet17.EnableControls;
bnew.Enabled:=false;
bsave.Enabled:=false;
bcancel.Enabled:=false;
bprint.Enabled:=false;
dbgrid1.Enabled:=true;
help.Caption:=' 查询完毕,要更改记录请用鼠标双击该记录所在的行!';
pz.Enabled:=true;
except
DataModule1.clientdataset17.EnableControls;
showmessage('数据库没有打开!');
end;
end;
procedure TFrmcllr.DBGrid1DblClick(Sender: TObject);
VAR
relation:string;
begin
relation:=' = ''';
try
if DataModule1.ClientDataSet17.Active then
begin
if DataModule1.ClientDataSet17.RecordCount<1 then exit;
bnew.Enabled:=true;
bnew.SetFocus;
bsave.Enabled:=false;
bcancel.Enabled:=false;
bprint.Enabled:=false;
commandstring:='select top 15 * from dbo.cllrb where (dbo.cllrb.ddh'+relation+DataModule1.ClientDataSet17.FieldByName('ddh').AsString+''' )'+' order by ddh,clh desc';
DataModule1.ClientDataSet25.Close;
DataModule1.ClientDataSet25.CommandText:=commandstring;
DataModule1.ClientDataSet25.Open;
end;
help.Caption:=' 要添加记录请点击<新增>按钮!';
dbgrid1.Enabled:=false;
except
dbgrid1.Enabled:=true;
showmessage('表格中数据出现了错误!')
end;
end;
procedure TFrmcllr.tbhKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then tys.SetFocus;
end;
procedure TFrmcllr.tcmKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then tgxmc.SetFocus;
end;
procedure TFrmcllr.txsKeyPress(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 tdj.SetFocus;
end;
procedure TFrmcllr.DBGrid5TitleClick(Column: TColumn);
var i : integer;
begin
for i:= 1 to DBGrid5.Columns.Count do
begin
//恢复所有标题字体为默认
DBGrid5.Columns[i-1].Title.Font.Color := clBlue;
DBGrid5.Columns[i-1].Title.Font.Style := [];
end;
if DataModule1.ClientDataSet25.IndexFieldNames<>(Column.FieldName) then //判断原排序方式
begin
DataModule1.ClientDataSet25.IndexFieldNames:= Column.FieldName;
Column.Title.Font.Color := clRed; //改变标题行字体为红色,表示当前的排序方式为升序
Column.Title.Font.Style := [fsBold];
end;
end;
procedure TFrmcllr.DBGrid5DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
begin
if DataModule1.ClientDataSet25.FieldByName('shbj').AsInteger=1 then
begin
dbgrid5.Canvas.Font.Color:=clred;
dbgrid5.Canvas.Brush.Color:=clyellow;
end
else
begin
dbgrid5.Canvas.Font.Color:=clblue;
dbgrid5.Canvas.Brush.Color:=clwhite;
end;
dbgrid5.DefaultDrawColumnCell(rect,datacol,column,state);
if ((State = [gdSelected]) or (State = [gdSelected, gdFocused])) then
begin
DBGrid5.Canvas.Brush.Color:=clred;
DBGrid5.Canvas.Font.Color:=clWhite;
DBGrid5.DefaultDrawColumnCell(Rect, datacol,column, State);
end;
end;
procedure TFrmcllr.DBGrid2DblClick(Sender: TObject);
begin
if not DataModule1.ClientDataSet23.Active then exit;
if DataModule1.ClientDataSet23.RecordCount>0 then
begin
tgxmc.Text:=DataModule1.ClientDataSet23.FieldByName('gxmc').AsString;
txs.Text:=DataModule1.ClientDataSet23.FieldByName('xs').AsString;
tdj.text:=DataModule1.ClientDataSet23.FieldByName('dj').AsString;
tsl.SetFocus;
end;
end;
procedure TFrmcllr.DBGrid3DblClick(Sender: TObject);
begin
if not DataModule1.ClientDataSet3.Active then exit;
if DataModule1.ClientDataSet3.RecordCount>0 then
begin
tgh.Text:=DataModule1.ClientDataSet3.FieldByName('gh').AsString;
tfb.Text:=DataModule1.ClientDataSet3.FieldByName('fb').AsString;
tfz.Text:=DataModule1.ClientDataSet3.FieldByName('fz').AsString;
tyg.text:=DataModule1.ClientDataSet3.FieldByName('xm').AsString;
tbh.SetFocus;
end;
end;
procedure TFrmcllr.DBGrid6DblClick(Sender: TObject);
begin
if not DataModule1.ClientDataSet24.Active then exit;
if DataModule1.ClientDataSet24.RecordCount>0 then
begin
tbh.Text:=DataModule1.ClientDataSet24.FieldByName('xh').AsString;
tys.Text:=DataModule1.ClientDataSet24.FieldByName('ys').AsString;
tcm.Text:=DataModule1.ClientDataSet24.FieldByName('cm').AsString;
tsl.text:=DataModule1.ClientDataSet24.FieldByName('sl').AsString;
tgxmc.SetFocus;
end;
end;
procedure TFrmcllr.tygChange(Sender: TObject);
var
relation,cx:string;
begin
relation:=' like ''';
cx:='%';
commandstring:='select * from dbo.ygb';
if trim(tyg.Text)<>'' then
begin
commandstring:=commandstring+' where (xm'+relation+cx+trim(tyg.Text)+cx+''')'+' order by xm';;
DataModule1.ClientDataSet3.Close;
DataModule1.ClientDataSet3.CommandText:=commandstring;
DataModule1.ClientDataSet3.Open;
end;
if trim(tyg.Text)='' then
begin
help.Caption:=' 请您输入或选择一位员工!';
exit;
end;
end;
procedure TFrmcllr.tgxmcChange(Sender: TObject);
var
relation,cx:string;
begin
relation:=' like ''';
cx:='%';
commandstring:='select * from dbo.gxb';
if trim(tgxmc.Text)<>'' then
begin
commandstring:=commandstring+' where (gxmc'+relation+cx+trim(tgxmc.Text)+cx+''')';
if DataModule1.ClientDataSet25.Active and (DataModule1.ClientDataSet25.RecordCount>0) then commandstring:=commandstring+' and (ddh'+relation+cx+DataModule1.ClientDataSet25.fieldbyname('ddh').AsString+cx+''')';
commandstring:=commandstring+' order by gxmc';
DataModule1.ClientDataSet23.Close;
DataModule1.ClientDataSet23.CommandText:=commandstring;
DataModule1.ClientDataSet23.Open;
end;
if trim(tgxmc.Text)='' then
begin
help.Caption:=' 请您输入或选择一个工序!';
exit;
end;
end;
procedure TFrmcllr.tbhChange(Sender: TObject);
var
relation,cx,commandstring1:string;
begin
txsChange(nil);
relation:=' like ''';
cx:='%';
commandstring:='select * from dbo.bhb';
commandstring1:=commandstring;
if trim(tbh.Text)<>'' then
begin
commandstring:=commandstring+' where (xh'+relation+cx+trim(tbh.Text)+cx+''')';
if DataModule1.ClientDataSet17.Active and (DataModule1.ClientDataSet17.RecordCount>0) then commandstring:=commandstring+' and (ddh'+relation+cx+DataModule1.ClientDataSet17.fieldbyname('ddh').AsString+cx+''')';
commandstring:=commandstring+' order by xh';
DataModule1.ClientDataSet24.Close;
DataModule1.ClientDataSet24.CommandText:=commandstring;
DataModule1.ClientDataSet24.Open;
exit;
end;
if trim(tsl.Text)<>'' then
begin
commandstring:=commandstring+' where (sl'+relation+cx+trim(tsl.Text)+cx+''')';
if DataModule1.ClientDataSet17.Active and (DataModule1.ClientDataSet17.RecordCount>0) then commandstring:=commandstring+' and (ddh'+relation+cx+DataModule1.ClientDataSet17.fieldbyname('ddh').AsString+cx+''')';
commandstring:=commandstring+' order by xh';
DataModule1.ClientDataSet24.Close;
DataModule1.ClientDataSet24.CommandText:=commandstring;
DataModule1.ClientDataSet24.Open;
exit;
end;
if DataModule1.ClientDataSet17.Active and (DataModule1.ClientDataSet17.RecordCount>0) then commandstring:=commandstring+' where (ddh'+relation+cx+DataModule1.ClientDataSet17.fieldbyname('ddh').AsString+cx+''')';
commandstring:=commandstring+' order by xh';
DataModule1.ClientDataSet24.Close;
DataModule1.ClientDataSet24.CommandText:=commandstring;
DataModule1.ClientDataSet24.Open;
if trim(tbh.Text)='' then
begin
help.Caption:=' 请您输入或选择一个包号!';
exit;
end;
end;
procedure TFrmcllr.bnewClick(Sender: TObject);
begin
bsave.Enabled:=true;
bcancel.Enabled:=true;
bprint.Enabled:=false;
bnew.Enabled:=false;
bquery.Enabled:=true;
pz.Enabled:=true;
rq.SetFocus;
try
if not DataModule1.ClientDataSet11.Active then DataModule1.clientdataset11.Active:=true;
form1.dorandombh;
DataModule1.clientdataset11.Refresh;
clh:=floattostr(DataModule1.clientdataset11.FieldByName('clh').AsFloat)+form1.randombh+form1.tbh.Text;
help.Caption:=' 请您输入数据!';
except
showmessage('数据库没有打开!')
end;
end;
procedure TFrmcllr.SpeedButton3Click(Sender: TObject);
begin
frmyg.showmodal;
tyg.Text:=form1.yg;
form1.yg:='';
end;
procedure TFrmcllr.tgxmcKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then txs.SetFocus;
end;
procedure TFrmcllr.txsChange(Sender: TObject);
begin
if trim(txs.Text)='' then txs.Text:='0';
if trim(tdj.Text)='' then tdj.Text:='0';
if trim(tsl.Text)='' then tsl.Text:='0';
if (trim(tsl.Text)<>'') and (trim(tdj.Text)<>'') and (trim(txs.Text)<>'') then
begin
tcz.Text:=formatfloat('0.00',strtofloat(tsl.Text)*strtofloat(tdj.Text)*strtofloat(txs.Text));
end;
end;
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?