📄 quote.pas
字号:
unit Quote;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, BasicFind, Menus, ActnList, ImgList, StdCtrls, RzLstBox,
RzBckgnd, RzButton, RzEdit, RzLabel, Mask, RzRadChk, RzPanel, ExtCtrls,
Grids, DBGridEh, RzTabs, RzDBEdit, TeEngine, Series, TeeProcs, Chart,
DBChart, DB, DBCtrls, RzDBCmbo, RzCmboBx, ppDB, ppBands, ppCache,
ppClass, ppProd, ppReport, ppRelatv, ppDBPipe, ppComm, ppEndUsr, RzDBLbl,
RzStatus, RzDBStat, RzGrids;
type
TfrmQuote = class(TfrmBasicFind)
actExcelFind: TAction;
RzPageControl1: TRzPageControl;
TabSheet1: TRzTabSheet;
RzPanel8: TRzPanel;
Splitter1: TSplitter;
ppCraftXB: TppDBPipeline;
ppCraft: TppDBPipeline;
RzPanel9: TRzPanel;
RzLabel8: TRzLabel;
edtNewFk: TRzEdit;
btnOK: TRzBitBtn;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
Label16: TLabel;
RzSeparator2: TRzSeparator;
RzSeparator4: TRzSeparator;
RzSeparator5: TRzSeparator;
RzSeparator6: TRzSeparator;
Label17: TLabel;
Label18: TLabel;
Label19: TLabel;
Label20: TLabel;
RzSeparator7: TRzSeparator;
RzSeparator8: TRzSeparator;
RzSeparator9: TRzSeparator;
RzSeparator10: TRzSeparator;
RzSeparator11: TRzSeparator;
RzSeparator12: TRzSeparator;
RzSeparator13: TRzSeparator;
RzSeparator14: TRzSeparator;
Shape1: TShape;
Bevel1: TBevel;
sgPrice: TRzStringGrid;
Label21: TLabel;
Label22: TLabel;
Label23: TLabel;
Label24: TLabel;
Label25: TLabel;
RzSeparator15: TRzSeparator;
Label26: TLabel;
Label27: TLabel;
Shape2: TShape;
lbPTPrice: TLabel;
lbTSPrice: TLabel;
RzSeparator1: TRzSeparator;
RzSeparator16: TRzSeparator;
RzSeparator17: TRzSeparator;
lbHcljg1: TLabel;
lbHcljg2: TLabel;
lbHcljg3: TLabel;
lbHcljg4: TLabel;
lbGG: TLabel;
lbZZ: TLabel;
lbCpfk: TLabel;
lbSxfk: TLabel;
lbZwm: TLabel;
RzSeparator18: TRzSeparator;
RzLabel9: TRzLabel;
lbCpmc: TRzLabel;
lbZjl: TLabel;
lbWxys: TLabel;
lbSxzl: TLabel;
lbCpzl: TLabel;
lbZsl: TLabel;
lbHclsl: TLabel;
lbShl: TLabel;
lbWc: TLabel;
lbWs: TLabel;
Label42: TLabel;
Label43: TLabel;
lbBz: TLabel;
lbHcl1: TLabel;
lbHcl2: TLabel;
lbHcl3: TLabel;
lbHcl4: TLabel;
dbgridList: TDBGridEh;
lbBcgf: TLabel;
lbQtfy: TLabel;
Label28: TLabel;
edtQtfy: TRzEdit;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure actExcelFindExecute(Sender: TObject);
procedure dbgridListTitleBtnClick(Sender: TObject; ACol: Integer; Column: TColumnEh);
procedure dbgridListDrawColumnCell(Sender: TObject; const Rect: TRect;
DataCol: Integer; Column: TColumnEh; State: TGridDrawState);
procedure btnOKClick(Sender: TObject);
procedure sgPriceDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
private
{ Private declarations }
procedure doMyOpen(Sender: TObject; var _EventNote, _State: String); override;
procedure doAfterScroll(DataSet: TDataSet);
procedure ShowPrice(DataSet: TDataSet; FK_Test: Double); //显示价格
procedure ClearShow; //清理界面显示
procedure ButtonState(_IsActive, _IsEmpty, _IsModify, _IsCheck :Boolean); override;
public
{ Public declarations }
end;
var
frmQuote: TfrmQuote;
implementation
uses dm32, MyPublic, dmc32;
{$R *.dfm}
procedure TfrmQuote.ClearShow;
var i: integer;
begin
//清理界面
for i:=0 to self.ComponentCount-1 do
if Self.Components[i] is TLabel then
if Pos('Label', Self.Components[i].Name) = 0 then
(Self.Components[i] as TLabel).Caption := '';
sgPrice.RowCount := 2;
for i:= 1 to sgPrice.ColCount -1 do
sgPrice.Cells[i, 1] := '';
end;
procedure TfrmQuote.actExcelFindExecute(Sender: TObject);
begin
RzEdit1.SetFocus;
end;
procedure TfrmQuote.FormCreate(Sender: TObject);
begin
inherited;
FindFields[1] := 'CPMC LIKE ''%'+REPLACEKEY+'%''';
FindFields[2] := 'CPYS='''+REPLACEKEY+'''';
FindFields[3] := 'CPZZ='''+REPLACEKEY+'''';
FindFields[4] := 'BZ LIKE ''%'+REPLACEKEY+'%''';
FindFields[5] := 'SZBS='''+REPLACEKEY+'''';
FindFields[6] := 'SZYM='''+REPLACEKEY+'''';
FindFields[7] := 'KH='+REPLACEKEY;
FindFields[8] := 'CPGG LIKE ''%'+REPLACEKEY+'%''';
FindFields[13] :='SRRQ';
FindSQL[2] := 'SELECT CODE +'' = ''+ NAME AS LISTFIELD FROM CODER WHERE ISOK ='+ IntToStr(SHBZ_OK) +' AND FZLX=''BASE_YSMC''';
FindSQL[3] := 'SELECT CODE +'' = ''+ NAME AS LISTFIELD FROM CODER WHERE ISOK ='+ IntToStr(SHBZ_OK) +' AND FZLX=''BASE_CPZZ''';
UseDataset := dm.qryCraft;
with dm.qryCraft do
begin
AfterScroll := doAfterScroll;
end;
//打开数据集
dmc.OpenCpys(True);
dmc.OpenCpzz(True);
dmc.OpenHcllx(True);
//处理界面
ClearShow;
with sgPrice do
begin
Cells[1,0] := '经纬类型';
Cells[2,0] := '原料名称';
Cells[3,0] := '头份';
Cells[4,0] := '损耗';
Cells[5,0] := '百码耗纱';
Cells[6,0] := '纱价';
Cells[7,0] := '百码价格';
end;
dm.qryCraft.Close;
dm.qryCraftXB.Close;
end;
procedure TfrmQuote.dbgridListTitleBtnClick(Sender: TObject; ACol: Integer;
Column: TColumnEh);
begin
DBGridTitleBtnClick(Sender, ACol, Column);
end;
procedure TfrmQuote.ButtonState(_IsActive, _IsEmpty, _IsModify, _IsCheck: Boolean);
begin
if _IsActive and not _IsEmpty then
_IsCheck := UseDataSet.FieldByName('SHBZ').AsInteger = SHBZ_OK;
inherited;
dbgridList.Enabled := not actSave.Enabled;
actOther1.Enabled := _IsActive and not _IsEmpty and not _IsModify;
//TabSheet1.Enabled := not _IsCheck;
end;
procedure TfrmQuote.doMyOpen(Sender: TObject; var _EventNote, _State: String);
var ls_SQL, ls_Err, ls_where: String;
begin
ls_where := WhereSQL;
if ls_where = '' then Exit;
_EventNote := '打开工艺资料：'+ls_where;
_State := EV_OK;
ls_SQL := 'SELECT * FROM CRAFT WHERE '+ ls_where;
ls_Err := OpenDataSet(dm.qryCraft, ls_SQL);
if ls_err <> '' then
begin
ShowMess('系统错误','打开工艺资料失败，具体为：'+ls_Err, MB_ICONERROR);
_State := EV_FAIL;
end;
if dm.qryCraft.IsEmpty then
ShowMess('提示','按您指定的条件未发现有效记录！', MB_OK);
end;
procedure TfrmQuote.doAfterScroll(DataSet: TDataSet);
var ls_cpSer, ls_Cpmc, ls_SQL, ls_Err: String;
begin
//滚动
if DataSet.IsEmpty then Exit;
ls_cpmc := dm.qryCraft.FieldByName('CPMC').AsString;
ls_cpser:= DataSet.FieldByName('GYSER').AsString;
if ls_Cpser = '' then Exit;
//打开子表
ls_SQL := 'SELECT * FROM CRAFTXB WHERE GYSER=' + ls_Cpser+ ' ORDER BY JWLX';
ls_Err := OpenDataSet(dm.qryCraftXB, ls_SQL);
if ls_Err <> '' then
ShowMess('系统错误','打开成品['+ ls_Cpmc +']的详细报价资料失败，具体为：'+ls_Err, MB_ICONERROR);
//生成报价
ShowPrice(dm.qryCraftXB, -1);
SetButtonState(UseDataSet);
end;
procedure TfrmQuote.dbgridListDrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumnEh;
State: TGridDrawState);
begin
with dbgridList.DataSource.DataSet do
if FieldByName('SHBZ').AsInteger = SHBZ_NOT then
dbgridList.Canvas.Brush.Color := $0084D7AB;
dbgridList.DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;
procedure TfrmQuote.ShowPrice(DataSet: TDataSet; FK_Test: Double);
var lf_bmhs, lf_Price, lf_cb, lf_ljcb, lf_hclcb, lf_tsjg: Double;
lf_Zsl, lf_hclsl, lf_wc, lf_tf, lf_Zjl, lf_Cpfk, lf_Bcgf, lf_Qtfy: Double;
ls_tmp, ls_err, ls_hcl: String;
i, li_Count: Integer;
begin
try
ClearShow;
if not DataSet.Active then Exit;
if DataSet.IsEmpty then Exit;
//开始计算单价
lf_Cpfk := UseDataSet.FieldByName('CPFK').AsFloat; //成品幅宽
lf_Zjl := UseDataSet.FieldByName('ZJL').AsFloat; //总经
lf_Zsl := UseDataSet.FieldByName('ZSL').AsFloat / 100; //织缩率
lf_hclsl:= UseDataSet.FieldByName('HCLSL').AsFloat / 100; //后处理缩率
lf_wc := UseDataSet.FieldByName('WC').AsFloat; //纬长
lf_Bcgf := UseDataSet.FieldByName('BCGF').AsFloat;
lf_Qtfy := UseDataSet.FieldByName('QTFY').AsFloat;
lf_bmhs := 0; //百码耗纱
lf_Price:= 0; //原料价格
lf_cb := 0; //百码价格
lf_ljcb := 0; //累计原料价格
lf_tsjg := 0; //特殊价格
lf_ljcb := 0; //普通价格
//显示主表数据
with UseDataSet do
begin
lbCpmc.Caption := FieldByName('CPMC').AsString + FieldByName('CPYS').AsString;
lbGG.Caption := FieldByName('CPGG').AsString;
lbZZ.Caption := FieldByName('CPZZ').AsString;
lbCpfk.Caption := FieldByName('FK1').AsString + '-' + FieldByName('FK2').AsString + '"';
lbCpzl.Caption := FieldByName('CPZL').AsString;
lbSxfk.Caption := FieldByName('SXFK').AsString;
lbSxzl.Caption := FieldByName('SXZL').AsString;
lbWxys.Caption := FieldByName('WXYS').AsString;
lbZsl.Caption := FieldByName('ZSL').AsString+'%';
lbHclsl.Caption:= FieldByName('HCLSL').AsString+'%';
lbShl.Caption := FieldByName('SHL').AsString;
lbWc.Caption := FieldByName('WC').AsString;
lbWs.Caption := FieldByName('WS').AsString;
if FK_Test > 0 then
lbZjl.Caption := FloatToStr(Round45((lf_Zjl/ lf_Cpfk) * FK_Test, 0))
else
lbZjl.Caption := FieldByName('ZJL').AsString;
lbZwm.Caption := FieldByName('ZWM').AsString;
lbBz.Caption := FieldByName('BZ').AsString;
lbHcl1.Caption := FieldByName('HCL1').AsString;
lbHcl2.Caption := FieldByName('HCL2').AsString;
lbHcl3.Caption := FieldByName('HCL3').AsString;
lbHcl4.Caption := FieldByName('HCL4').AsString;
lbBcgf.Caption := FieldByName('BCGF').AsString;
lbQtfy.Caption := FieldByName('QTFY').AsString;
end;
sgPrice.RowCount := DataSet.RecordCount + 1;
DataSet.First;
with DataSet do
while Not Eof do
begin
sgPrice.Cells[1, RecNo] := FieldByName('JWLX').AsString;
sgPrice.Cells[2, RecNo] := FieldByName('YL_ZS').AsString + '支'+
FieldByName('YL_GYS').AsString +
FieldByName('YL_LX').AsString +
FieldByName('YL_FG').AsString +
FieldByName('YL_GG').AsString;
sgPrice.Cells[4, RecNo] := FieldByName('SH').AsString;
if FieldByName('JWLX').AsString = '经纱' then //计算经纱百码耗纱\纱价\成本
begin
//新头份= 旧头份 / 总经量 * (总经量 / 旧幅宽) * 新幅宽
if FK_Test > 0 then lf_tf := FieldByName('TF').AsFloat / lf_Zjl * (lf_Zjl/ lf_Cpfk) * FK_Test
else lf_tf := FieldByName('TF').AsFloat;
lf_bmhs := (lf_tf * (1 + lf_Zsl)) /
(16.933 * FieldByName('ZS').AsFloat) *
FieldByName('SH').AsFloat / (1 - lf_hclsl) * 0.9144
end else
if FieldByName('JWLX').AsString = '纬纱' then //计算纬纱百码耗纱
begin
lf_bmhs := (lf_wc * 2.325 * FieldByName('TF').AsFloat) / 8 *
FieldByName('SH').AsFloat * 0.9144 / (1 - lf_hclsl);
end;
//取价格，算成本
ls_err := GetFieldVal('MATERIAL', 'PRICE', 'CODE=''' + FieldByName('CODE').AsString + '''', ls_tmp);
if ls_err <> '' then
begin
ShowMess('系统错误','获取原料 '+ sgPrice.Cells[2, RecNo] + ' 的单价失败，具体为：'+ ls_err, MB_ICONERROR);
Exit;
end;
if ls_tmp = '' then
begin
ShowMess('提示','原料 '+ sgPrice.Cells[2, RecNo] + ' 尚未输入单价！计算出的报价不准确！请让相关人员核查！', MB_ICONERROR);
ls_tmp := '0';
end;
lf_Price := StrToFloat(ls_tmp); //原料单价
lf_cb := lf_bmhs * lf_Price; //百码价
sgPrice.Cells[3, RecNo] := FloatToStr(Round45(lf_Tf,0));
sgPrice.Cells[5, RecNo] := FloatToStr(Round45(lf_bmhs,1));
sgPrice.Cells[6, RecNo] := FloatToStr(lf_price);
sgPrice.Cells[7, RecNo] := FloatToStr(Round45(lf_cb,1));
lf_ljcb := lf_ljcb + lf_cb;
Next;
end;
//合计价格
lbPTPrice.Caption := FloatToStr(Round45(lf_ljcb,1));
//取后处理价格
for li_Count:=1 to 4 do
begin
ls_tmp := '0';
ls_hcl := dm.qryCraft.FieldByName('HCL'+ IntToStr(li_Count)).AsString;
if ls_hcl <> '' then
ls_Err := GetFieldVal('CODER','SECCODE', 'FZLX=''BASE_HCLPRICE'' AND NAME=''' + ls_hcl + '''', ls_tmp);
if ls_err <> '' then
begin
ShowMess('系统错误','获取后处理 '+ ls_Hcl + ' 的价格失败，具体为：'+ ls_err, MB_ICONERROR);
Exit;
end;
lf_tsjg := lf_tsjg + StrToFloat(ls_tmp); //特殊价格
Case li_Count of
1: lbHclJg1.Caption := ls_tmp;
2: lbHclJg2.Caption := ls_tmp;
3: lbHclJg3.Caption := ls_tmp;
4: lbHclJg4.Caption := ls_tmp;
end;
end;
//特殊价格
if (edtQtfy.Text = '') or (edtQtfy.Text = '0') then
lbTSPrice.Caption := FloatToStr(Round45(lf_ljcb + lf_tsjg + lf_bcgf + lf_qtfy,1))
else
lbTSPrice.Caption := FloatToStr(Round45(lf_ljcb + lf_tsjg + lf_bcgf + StrToFloat(edtQtfy.Text),1));
except
On E: Exception do
ShowMess('错误', '计算该品种价格时失败，具体为：'+ E.Message, MB_ICONERROR);
end;
end;
procedure TfrmQuote.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//关闭已经打开的数据集
dmc.OpenCpys(False);
dmc.OpenCpzz(False);
dmc.OpenHcllx(False);
inherited;
end;
procedure TfrmQuote.btnOKClick(Sender: TObject);
begin
if edtNewFk.Text <> '' then
ShowPrice(dm.qryCraftXB, StrToFloat(edtNewFk.Text))
else
ShowPrice(dm.qryCraftXB, -1);
end;
procedure TfrmQuote.sgPriceDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
begin
with sgPrice.Canvas do
if sgPrice.Cells[1, ARow] = '经纱' then
begin
Brush.Color := $00A9E2C5;
TextRect(Rect, Rect.Left+2, Rect.Top+2, sgPrice.Cells[ACol, ARow]);
end else
if sgPrice.Cells[1, ARow] = '纬纱' then
begin
Brush.Color := $0080C1DB;
TextRect(Rect, Rect.Left+2, Rect.Top+2, sgPrice.Cells[ACol, ARow]);
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -