craftcheck.pas

delphi框架可以学习, 写的很好的

  if dm.qryCraft.IsEmpty then
    ShowMess('提示','按您指定的条件未发现有效记录！', MB_OK);
end;

procedure TfrmCraftCheck.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 TfrmCraftCheck.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 TfrmCraftCheck.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('CPFK').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;

      lbFkfw.Caption := FieldByName('FK1').AsString + '-' + FieldByName('FK2').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;

    //特殊价格
    lbTSPrice.Caption := FloatToStr(Round45(lf_ljcb + lf_tsjg + lf_bcgf + lf_qtfy,1));
  except
    On E: Exception do
      ShowMess('错误', '计算该品种价格时失败，具体为：'+ E.Message, MB_ICONERROR);
  end;
end;

procedure TfrmCraftCheck.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //关闭已经打开的数据集
  dmc.OpenCpys(False);
  dmc.OpenCpzz(False);
  dmc.OpenHcllx(False);

  inherited;

end;

procedure TfrmCraftCheck.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;

procedure TfrmCraftCheck.btnOKClick(Sender: TObject);
var ls_Ser, ls_SQL, ls_Err: String;
begin
  //保存录入数据
  if edtFk1.Text  = ''  then Exit;
  if edtFk2.Text  = ''  then Exit;
  if edtBcgf.Text = ''  then Exit;
  if edtBcgf.Text = '0' then Exit;
    if edtQtfy.Text = '0' then Exit;


  ls_Ser := dm.qryCraft.FieldByName('GYSER').AsString;

  lbFkfw.Caption := edtFk1.Text + '-' + edtFk2.Text + '"';
  lbBcgf.Caption := edtBcgf.Text;
  lbQtfy.Caption := edtQtfy.Text;

  ls_SQL := 'UPDATE CRAFT SET FK1='+ edtFk1.Text + ','+
                             'FK2='+ edtFk2.Text + ','+
                            'BCGF='+ edtBcgf.Text+ ','+
                            'QTFY='+ edtQtfy.Text+
            ' WHERE GYSER='+ ls_ser;
  ls_Err := doSQL(ls_SQL);

  if ls_Err <> '' then
    ShowMess('系统错误','更新'+ lbCpmc.Caption + '工艺的资料失败，具体为'+ ls_Err, MB_ICONERROR);
end;

end.