unit U_YarnInfoInPut; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, DB, cxDBData, cxCalendar, cxDropDownEdit, ComCtrls, ToolWin, cxGridLevel, cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses, cxControls, cxGridCustomView, cxGrid, cxGridCustomPopupMenu, cxGridPopupMenu, ADODB, DBClient, cxButtonEdit, cxTextEdit, StdCtrls, ExtCtrls, cxLookAndFeels, cxLookAndFeelPainters, cxNavigator, dxDateRanges, dxBarBuiltInMenu, U_BaseInput, U_BaseList, System.ImageList, Vcl.ImgList, cxContainer, cxMaskEdit, cxMemo, cxImageList, dxSkinsCore, dxSkinsDefaultPainters, dxCore, cxDateUtils, dxSkinOffice2013White, dxSkinSharpPlus, dxSkinWXI, dxScrollbarAnnotations, cxCheckBox; type TfrmYarnInfoInPut = class(TfrmBaseInput) ToolBar1: TToolBar; TBSave: TToolButton; TBClose: TToolButton; ADOQueryCmd: TADOQuery; ADOQueryMain: TADOQuery; ADOQueryTemp: TADOQuery; ToolButton1: TToolButton; ScrollBox1: TScrollBox; Label7: TLabel; Label1: TLabel; Y_Name: TcxTextEdit; Label3: TLabel; Y_Code: TcxTextEdit; Label8: TLabel; Denier: TcxTextEdit; Label9: TLabel; Note: TcxMemo; Label5: TLabel; ADOConnection1: TADOConnection; Label10: TLabel; FF: TcxTextEdit; Label12: TLabel; ZS: TcxTextEdit; Y_Color: TcxButtonEdit; Y_Composition: TcxButtonEdit; Label16: TLabel; ToolBar2: TToolBar; TbAdd: TToolButton; TbDel: TToolButton; Tv1: TcxGridDBTableView; cxGrid1Level1: TcxGridLevel; cxGrid1: TcxGrid; Tv1DH: TcxGridDBColumn; Tv1CF: TcxGridDBColumn; Tv1BL: TcxGridDBColumn; CDS_1: TClientDataSet; DS_1: TDataSource; Tv1serialno: TcxGridDBColumn; Tv1CFID: TcxGridDBColumn; Tv1BYIID: TcxGridDBColumn; Tv1VieName: TcxGridDBColumn; Tv1Column1: TcxGridDBColumn; Label2: TLabel; procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure TBCloseClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure TBSaveClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Y_NameClick(Sender: TObject); procedure Y_NameExit(Sender: TObject); procedure Y_SpecPropertiesChange(Sender: TObject); procedure DenierClick(Sender: TObject); procedure DenierExit(Sender: TObject); procedure ZSClick(Sender: TObject); procedure ZSExit(Sender: TObject); procedure DenierPropertiesEditValueChanged(Sender: TObject); procedure ZSPropertiesEditValueChanged(Sender: TObject); procedure ParentCoNamePropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); procedure Y_ColorDblClick(Sender: TObject); procedure CJPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); procedure CJPropertiesChange(Sender: TObject); procedure TbAddClick(Sender: TObject); procedure TbDelClick(Sender: TObject); procedure TextEdit(Sender: TObject); procedure FFPropertiesChange(Sender: TObject); procedure Y_ColorPropertiesChange(Sender: TObject); procedure ZSPropertiesChange(Sender: TObject); private { Private declarations } function SaveData(): Boolean; procedure UpdateYarnName; procedure initCFGrid(); function CheckBL(): Boolean; public { Public declarations } FBYIID, FSTKName: string; end; var frmYarnInfoInPut: TfrmYarnInfoInPut; implementation uses U_DataLink, U_RTFun, U_ZDYHelp, U_CompanySel, U_YarnCFInfoSel; //, U_ProductInfoSel {$R *.dfm} procedure TfrmYarnInfoInPut.CJPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); begin try frmCompanySel := TfrmCompanySel.Create(Application); with frmCompanySel do begin FCoType := '供应商'; if ShowModal = 1 then begin end; end; finally frmCompanySel.Free; end; end; procedure TfrmYarnInfoInPut.CJPropertiesChange(Sender: TObject); begin UpdateYarnName; end; procedure TfrmYarnInfoInPut.DenierClick(Sender: TObject); begin ZS.Style.Color := clMoneyGreen; end; procedure TfrmYarnInfoInPut.DenierExit(Sender: TObject); begin ZS.Style.Color := clWhite; end; procedure TfrmYarnInfoInPut.DenierPropertiesEditValueChanged(Sender: TObject); begin ZS.text := floattostr(roundfloat(5315.5 / strtofloatdef(Denier.text, 0), 0)); end; procedure TfrmYarnInfoInPut.FFPropertiesChange(Sender: TObject); begin UpdateYarnName; end; procedure TfrmYarnInfoInPut.FormClose(Sender: TObject; var Action: TCloseAction); begin inherited; Action := caFree; end; procedure TfrmYarnInfoInPut.initCFGrid(); begin with ADOQueryTemp do begin Close; sql.Clear; sql.Add('select A.* from BS_Yarn_Info_CF A '); sql.Add(' where BYIID = ' + quotedStr(Trim(FBYIID))); sql.Add('Order By A.serialno '); Open; end; SCreateCDS(ADOQueryTemp, CDS_1); SInitCDSData(ADOQueryTemp, CDS_1); end; function TfrmYarnInfoInPut.SaveData(): Boolean; var MaxNo, MaxPRID, maxCFID: string; begin try ADOQueryCmd.Connection.BeginTrans; if Trim(FBYIID) = '' then begin if GetLSNo(ADOQueryCmd, MaxNo, 'P', 'BS_Yarn_Info', 4, 0) = False then raise Exception.Create('取最大号失败!'); Y_Code.Text := MaxNo; end else begin MaxNo := Trim(FBYIID); end; with ADOQueryCmd do begin Close; SQL.Clear; sql.Add('select * from BS_Yarn_Info where BYIID=''' + Trim(MaxNo) + ''''); Open; end; with ADOQueryCmd do begin if Trim(FBYIID) = '' then begin Append; FieldByName('FillId').Value := Trim(DCode); FieldByName('Filler').Value := Trim(DName); end else begin Edit; FieldByName('EditId').Value := Trim(DCode); FieldByName('Editer').Value := Trim(DName); FieldByName('Edittime').Value := SGetServerDateTime(ADOQueryTemp); end; FieldByName('BYIID').Value := Trim(MaxNo); RTSetsavedata(ADOQueryCmd, 'BS_Yarn_Info', ScrollBox1, 2); Post; end; with ADOQueryCmd do begin Close; sql.Clear; sql.Add('select * from BS_Yarn_Info where Y_Code=' + quotedstr(trim(Y_Code.Text))); Open; end; if ADOQueryCmd.RecordCount > 1 then raise Exception.Create('编号重复!'); with ADOQueryCmd do begin Close; sql.Clear; sql.Add('select * from BS_Yarn_Info where Y_Name=' + quotedstr(trim(Y_Name.Text))); Open; end; if ADOQueryCmd.RecordCount > 1 then raise Exception.Create('品名重复!'); ////////////////// 保存成分表开始 ////////////////////// with CDS_1 do begin First; while not Eof do begin if Trim(CDS_1.fieldbyname('CFID').AsString) = '' then begin if GetLSNo(ADOQueryTemp, maxCFID, 'CF', 'BS_Yarn_Info_CF', 5, 1) = False then begin ADOQueryCmd.Connection.RollbackTrans; Application.MessageBox('取配比子流水号失败!', '提示', 0); Exit; end; end else begin maxCFID := Trim(CDS_1.fieldbyname('CFID').AsString); end; with ADOQueryCmd do begin Close; SQL.Clear; sql.Add('select * from BS_Yarn_Info_CF where '); sql.Add(' CFID=''' + Trim(maxCFID) + ''''); Open; end; with ADOQueryCmd do begin if Trim(CDS_1.fieldbyname('BYIID').AsString) = '' then begin Append; end else begin Edit; end; FieldByName('Y_Code').Value := Y_Code.Text; FieldByName('BYIID').Value := Trim(MaxNo); FieldByName('CFID').Value := Trim(maxCFID); RTSetSaveDataCDS(ADOQueryCmd, Tv1, CDS_1, 'BS_Yarn_Info_CF', 0); Post; end; Next; end; end; //////////////// 保存成分子表结束 ////////////////////// ADOQueryCmd.Connection.CommitTrans; Result := True; except Result := False; ADOQueryCmd.Connection.RollbackTrans; application.MessageBox(PChar(Exception(ExceptObject).Message), '提示信息', 0); end; end; procedure TfrmYarnInfoInPut.TbAddClick(Sender: TObject); begin try frmYarnCFInfoSel := TfrmYarnCFInfoSel.Create(Application); with frmYarnCFInfoSel do begin if ShowModal = 1 then begin frmYarnCFInfoSel.CDS_1.First; while not frmYarnCFInfoSel.CDS_1.Eof do begin if frmYarnCFInfoSel.CDS_1.FieldByName('SSel').Value = true then begin with Self.CDS_1 do begin Append; FieldByName('DH').Value := frmYarnCFInfoSel.CDS_1.fieldbyname('DH').value; FieldByName('CF').Value := frmYarnCFInfoSel.CDS_1.fieldbyname('CF').value; FieldByName('CHNName').Value := frmYarnCFInfoSel.CDS_1.fieldbyname('CHNName').value; FieldByName('VieName').Value := frmYarnCFInfoSel.CDS_1.fieldbyname('VieName').value; FieldByName('serialno').Value := Self.CDS_1.RecordCount + 1; Post; end; end; frmYarnCFInfoSel.CDS_1.Next; end; end; end; finally frmYarnCFInfoSel.Free; end; end; procedure TfrmYarnInfoInPut.TbDelClick(Sender: TObject); var i: Integer; begin if not CDS_1.IsEmpty then begin if Application.MessageBox('确定要删除数据吗?', '提示', 32 + 4) = IDYES then begin if Trim(CDS_1.fieldbyname('CFID').AsString) <> '' then begin with ADOQueryCmd do begin Close; sql.Clear; sql.Add('delete BS_Yarn_Info_CF where CFID=' + quotedStr(Trim(CDS_1.fieldbyname('CFID').AsString))); ExecSQL; end; end; CDS_1.Delete; end else exit; i := 0; CDS_1.First; while not CDS_1.Eof do begin i := i + 1; CDS_1.Edit; CDS_1.fieldByName('serialno').value := i; CDS_1.Post; CDS_1.Next; end; end else begin Application.MessageBox('无可删除数据!', '提示', 0); Exit; end; end; procedure TfrmYarnInfoInPut.TBCloseClick(Sender: TObject); begin Close; end; procedure TfrmYarnInfoInPut.FormCreate(Sender: TObject); begin inherited; try with ADOConnection1 do begin Connected := false; ConnectionString := DConString; Connected := true; end; ADOQueryBaseCmd.Connection := ADOConnection1; ADOQueryBaseTemp.Connection := ADOConnection1; except application.MessageBox('网络连接失败!', '提示信息'); end; end; procedure TfrmYarnInfoInPut.FormShow(Sender: TObject); var fsj: string; begin inherited; // fsj := ' select Code=ZDYNo,Name=ZDYName from KH_ZDY where Type=''YType'' and MainType=''纱线档案'' '; // SInitTcxComBoxBySql(ADOQueryTemp, Y_Type, false, fsj); // // fsj := ' select Code=ZDYNo,Name=ZDYName from KH_ZDY where Type=''Y_Spec'' and MainType=''纱线档案'' '; // SInitTcxComBoxBySql(ADOQueryTemp, Y_Spec, false, fsj); // // fsj := ' select Code=ZDYNo,Name=ZDYName from KH_ZDY where Type=''Y_Composition'' and MainType=''纱线档案'' '; // SInitTcxComBoxBySql(ADOQueryTemp, Y_Composition, false, fsj); // // fsj := ' select Code=ZDYNo,Name=ZDYName from KH_ZDY where Type=''Y_Color'' and MainType=''纱线档案'' '; // SInitTcxComBoxBySql(ADOQueryTemp, Y_Color, false, fsj); initCFGrid(); with ADOQueryTemp do begin Close; SQL.Clear; sql.Add(' select * from BS_Yarn_Info '); sql.Add(' where BYIID=''' + Trim(FBYIID) + ''''); Open; end; SCSHData(ADOQueryTemp, ScrollBox1, 2); // initCFGrid(); if FBYIID = '' then begin end; end; procedure TfrmYarnInfoInPut.Y_ColorDblClick(Sender: TObject); begin TcxButtonEdit(Sender).Text := ''; TcxButtonEdit(Sender).Properties.LookupItems.Text := ''; end; procedure TfrmYarnInfoInPut.Y_ColorPropertiesChange(Sender: TObject); begin UpdateYarnName; end; procedure TfrmYarnInfoInPut.ParentCoNamePropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); var fsj: string; FWZ: Integer; begin fsj := Trim(TcxButtonEdit(Sender).Hint); FWZ := Pos('/', fsj); try frmZDYHelp := TfrmZDYHelp.Create(Application); with frmZDYHelp do begin MainType := '纱线档案'; flag := Copy(fsj, 1, FWZ - 1); flagname := Copy(fsj, FWZ + 1, Length(fsj) - FWZ); if ShowModal = 1 then begin TcxButtonEdit(Sender).Text := Trim(ClientDataSet1.fieldbyname('ZDYName').AsString); end; end; finally frmZDYHelp.Free; end; end; procedure TfrmYarnInfoInPut.TBSaveClick(Sender: TObject); begin // if Trim(Y_Code.Text) = '' then // begin // Application.MessageBox('编号不能为空!', '提示', 0); // Exit; // end; ToolBar1.SetFocus; Y_Name.text := Trim(Y_Composition.text) + Trim(ZS.text) + 'S' + Trim(Y_Color.text) + Trim(FF.text); //+ Trim(CJ.text) if Trim(Y_Name.Text) = '' then begin Application.MessageBox('名称不能为空!', '提示', 0); Exit; end; if Trim(Denier.Text) <> '' then begin if StrToFloatdef(Denier.Text, 0) = 0 then begin Application.MessageBox('理论D数请输入数字!', '提示', 0); Exit; end; end; if CDS_1.IsEmpty then begin Application.MessageBox('请输入纱线原料!', '提示', 0); Exit; end; if not CheckBL() then begin Exit; end; if SaveData() then begin Application.MessageBox('保存成功!', '提示', 0); ModalResult := 1; Exit; end; end; procedure TfrmYarnInfoInPut.TextEdit(Sender: TObject); var s: string; fValue: Double; begin s := TcxTextEdit(Sender).EditingText; if (s <> '') and (s[Length(s)] <> '%') then begin try // 尝试将字符串转换为浮点数 fValue := StrToFloat(s); // if fValue < 0 then // begin // s := '0'; // end; // if fValue > 100 then // begin // s := '100'; // end; // 格式化为两位小数并添加百分号 // Tv1.Controller.FocusedColumn.EditValue := FormatFloat('0.00', fValue) + '%'; Tv1.Controller.FocusedColumn.EditValue := s + '%'; Y_Composition.Text := ''; Y_Name.Text := ''; CDS_1.First; while not CDS_1.Eof do begin if Y_Composition.Text = '' then begin Y_Composition.Text := CDS_1.FieldByName('BL').AsString + CDS_1.FieldByName('CF').AsString; end else begin Y_Composition.Text := Y_Composition.Text + ' ' + CDS_1.FieldByName('BL').AsString + CDS_1.FieldByName('CF').AsString; end; if Y_Name.Text = '' then begin Y_Name.Text := CDS_1.FieldByName('BL').AsString + CDS_1.FieldByName('DH').AsString; end else begin Y_Name.Text := Y_Name.Text + ' ' + CDS_1.FieldByName('BL').AsString + CDS_1.FieldByName('DH').AsString; end; CDS_1.Next; end; Y_Name.Text := Trim(Y_Name.Text) + Trim(ZS.Text) + 'S' + Trim(Y_Color.Text) + Trim(FF.Text); except on E: EConvertError do begin // 如果转换失败,保持原样并添加百分号 Tv1.Controller.FocusedColumn.EditValue := s + '%'; end; end; end; end; function TfrmYarnInfoInPut.CheckBL(): Boolean; var mBL: Double; msubBL: Double; begin Result := False; msubBL := 0; CDS_1.First; while not CDS_1.Eof do begin // 一行代码处理:移除%号并尝试转换 if not TryStrToFloat(StringReplace(CDS_1.FieldByName('BL').AsString, '%', '', [rfReplaceAll]), mBL) then begin ShowMessage('代号 ' + CDS_1.FieldByName('DH').AsString + ' 比例格式错误'); Exit; end else begin msubBL := msubBL + mBL; end; if (mBL <= 0) or (mBL > 100) then begin ShowMessage('代号 ' + CDS_1.FieldByName('DH').AsString + ' 比例必须在 0-100% 之间'); Exit; end; CDS_1.Next; end; if msubBL > 100 then begin ShowMessage('比例之和必须在 0-100% 之间'); Exit; end; Result := True; end; procedure TfrmYarnInfoInPut.Y_NameClick(Sender: TObject); begin Y_Composition.Style.Color := clMoneyGreen; ZS.Style.Color := clMoneyGreen; Y_Color.Style.Color := clMoneyGreen; FF.Style.Color := clMoneyGreen; // CJ.Style.Color := clMoneyGreen; end; procedure TfrmYarnInfoInPut.Y_NameExit(Sender: TObject); begin Y_Composition.Style.Color := clWhite; ZS.Style.Color := clWhite; Y_Color.Style.Color := clWhite; FF.Style.Color := clWhite; // CJ.Style.Color := clWhite; end; procedure TfrmYarnInfoInPut.Y_SpecPropertiesChange(Sender: TObject); begin Y_Name.text := Trim(Y_Composition.text) + Trim(ZS.text) + 'S' + Trim(Y_Color.text) + Trim(FF.text); //+ Trim(CJ.text) end; procedure TfrmYarnInfoInPut.ZSClick(Sender: TObject); begin Denier.Style.Color := clMoneyGreen; end; procedure TfrmYarnInfoInPut.ZSExit(Sender: TObject); begin Denier.Style.Color := clWhite; end; procedure TfrmYarnInfoInPut.ZSPropertiesChange(Sender: TObject); begin UpdateYarnName; end; procedure TfrmYarnInfoInPut.ZSPropertiesEditValueChanged(Sender: TObject); begin Denier.text := floattostr(roundfloat(5315.5 / strtofloatdef(ZS.text, 0), 0)); end; procedure TfrmYarnInfoInPut.UpdateYarnName; begin Y_Name.Text := ''; CDS_1.First; while not CDS_1.Eof do begin if Y_Name.Text = '' then begin Y_Name.Text := CDS_1.FieldByName('BL').AsString + CDS_1.FieldByName('DH').AsString; end else begin Y_Name.Text := Y_Name.Text + ' ' + CDS_1.FieldByName('BL').AsString + CDS_1.FieldByName('DH').AsString; end; CDS_1.Next; end; Y_Name.Text := Trim(Y_Name.Text) + Trim(ZS.Text) + 'S' + Trim(Y_Color.Text) + Trim(FF.Text); end; end.