quotefind.pas

来自「delphi框架可以学习, 写的很好的」· PAS 代码 · 共 465 行

unit QuoteFind;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, BasicFind, ppEndUsr, ppBands, ppCache, ppClass, ppProd,
  ppReport, ppDB, ppComm, ppRelatv, ppDBPipe, Menus, ActnList, ImgList,
  StdCtrls, RzLstBox, RzButton, RzEdit, Mask, RzRadChk, RzLabel, RzBckgnd,
  RzPanel, ExtCtrls, DB, Grids, RzGrids, RzTabs, DBGridEh;

type
  TfrmQuoteFind = class(TfrmBasicFind)
    Splitter1: TSplitter;
    dbgridList: TDBGridEh;
    RzPageControl1: TRzPageControl;
    TabSheet1: TRzTabSheet;
    Bevel1: TBevel;
    Shape2: TShape;
    Shape1: TShape;
    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;
    Label21: TLabel;
    Label22: TLabel;
    Label23: TLabel;
    Label24: TLabel;
    Label25: TLabel;
    RzSeparator15: TRzSeparator;
    Label26: TLabel;
    Label27: TLabel;
    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;
    lbBcgf: TLabel;
    lbQtfy: TLabel;
    RzPanel9: TRzPanel;
    RzLabel8: TRzLabel;
    Label28: TLabel;
    edtNewFk: TRzEdit;
    btnOK: TRzBitBtn;
    edtQtfy: TRzEdit;
    sgPrice: TRzStringGrid;
    RzPanel8: TRzPanel;
    RzSeparator20: TRzSeparator;
    btnHfyj: TRzBitBtn;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure btnOKClick(Sender: TObject);

    procedure sgPriceDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
    procedure dbgridListDrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumnEh; State: TGridDrawState);
    procedure dbgridListTitleBtnClick(Sender: TObject; ACol: Integer; Column: TColumnEh);
    procedure btnHfyjClick(Sender: TObject);
  private
    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
  frmQuoteFind: TfrmQuoteFind;

implementation

uses dm32, dmc32, MyPublic;

{$R *.dfm}

procedure TfrmQuoteFind.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;
end;

procedure TfrmQuoteFind.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 TfrmQuoteFind.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 TfrmQuoteFind.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 TfrmQuoteFind.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] := '纱价';
    Cells[8,0] := '百码价格';
  end;

  dm.qryCraft.Close;
  dm.qryCraftXB.Close;
end;

procedure TfrmQuoteFind.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, ls_zs: 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; //普通价格
    ls_zs   := '';//实际支数

    //显示主表数据
    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 := FloatToStr(FieldByName('WXYS').AsFloat * 100 ) + '%';
      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[5, RecNo] := FieldByName('SH').AsString;

      if FieldByName('JWLX').AsString = '经纱' then  //计算经纱百码耗纱\纱价\成本
      begin
        //新头份= 旧头份 / 总经量 * (总经量 / 旧幅宽) * 新幅宽
        if FK_Test > 0 then lf_tf := Round45(FieldByName('TF').AsFloat / lf_Zjl * (lf_Zjl/ lf_Cpfk) * FK_Test, 0)
                       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
        //(纬长 * 2.325 * 纬密) / 8 * 损耗率 * 0.9144 / (1 - 后处理缩率)
        lf_tf   := FieldByName('TF').AsFloat;
        lf_bmhs := (lf_wc * 2.325 * FieldByName('TF').AsFloat) / FieldByName('ZS').AsFloat *
                   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] := FieldByName('ZS').AsString;
      sgPrice.Cells[4, RecNo] := FloatToStr(lf_Tf);
      sgPrice.Cells[6, RecNo] := FloatToStr(Round45(lf_bmhs,1));
      sgPrice.Cells[7, RecNo] := FloatToStr(lf_price);
      sgPrice.Cells[8, RecNo] := FloatToStr(Round45(lf_cb,1));

      lf_ljcb := lf_ljcb + lf_cb;
      Next;
    end;

    //合计价格
    lbPTPrice.Caption := FloatToStr(Round45(lf_ljcb,0));

    //取后处理价格
    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,0))
    else
      lbTSPrice.Caption := FloatToStr(Round45(lf_ljcb + lf_tsjg + lf_bcgf + StrToFloat(edtQtfy.Text),0));

  except
    On E: Exception do
      ShowMess('错误', '计算该品种价格时失败，具体为：'+ E.Message, MB_ICONERROR);
  end;
end;

procedure TfrmQuoteFind.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  dmc.OpenCpys(False);
  dmc.OpenCpzz(False);
  dmc.OpenHcllx(False);

  inherited;
end;

procedure TfrmQuoteFind.btnOKClick(Sender: TObject);
begin
  if edtNewFk.Text <> '' then
    ShowPrice(dm.qryCraftXB, StrToFloat(edtNewFk.Text))
  else
    ShowPrice(dm.qryCraftXB, -1);
end;

procedure TfrmQuoteFind.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 TfrmQuoteFind.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 TfrmQuoteFind.dbgridListTitleBtnClick(Sender: TObject;
  ACol: Integer; Column: TColumnEh);
begin
  DBGridTitleBtnClick(Sender, ACol, Column);
end;

procedure TfrmQuoteFind.btnHfyjClick(Sender: TObject);
begin
  edtNewFk.Text := '';
  edtQtfy.Text  := '';
  btnOKClick(nil);
end;

end.