unit PhasePayDm; interface uses SysUtils, Classes, sdDB, sdProvider, ADODB, FormulaCalc, CalcDecimal; type TPhasePayData = class(TDataModule) sdpPhasePay: TsdADOProvider; sddPhasePay: TsdDataSet; procedure sddPhasePayBeforeValueChange(AValue: TsdValue; const NewValue: Variant; var Allow: Boolean); procedure sddPhasePayAfterValueChanged(AValue: TsdValue); private FPhaseData: TObject; FPayFormula: TPayFormula; FBeforeChangeTotalPrice: Double; FDecimal: TCalcDecimal; function CheckMinus(AID: Integer): Boolean; function GetFormula(AID: Integer): string; function GetCalcType(AID: Integer): Integer; function GetName(AID: Integer): string; function GetPayablePrice(AIndex: Integer): Double; procedure RepairPhaseRecord; procedure BeforeBatchOperation; procedure AfterBatchOperation; function GetCurPayable: Double; function GetLastestPhasePay(AType: Integer): Double; procedure SetFieldValidChar; function GetBqwc(AType: Integer): Double; function GetTableName: string; public constructor Create(APhaseData: TObject); destructor Destroy; override; procedure Open(AConnection: TADOConnection); procedure Save; function AddPayRecord(AID: Integer): TsdDataRecord; function PayRecord(AID: Integer): TsdDataRecord; procedure Delete(AID: Integer); procedure CalculateAll; procedure Calculate(AID: Integer); procedure CalculateCurPay; procedure UpdateDataForNewAudit; procedure CopyPrePhasePayData; overload; procedure CopyPrePhasePayData(const APreFile: string; APreFinalIndex: Integer); overload; property TableName: string read GetTableName; property PayablePrice[AIndex: Integer]: Double read GetPayablePrice; // 本期应付 property CurPayable: Double read GetCurPayable; // AType表示不同类型,取值如下: // 1: 本期数据 2: 截止本期数据 3: 截止上期数据 property LastestPhasePay[AType: Integer]: Double read GetLastestPhasePay; property Bqwc[AType: Integer]: Double read GetBqwc; property Decimal: TCalcDecimal read FDecimal; end; implementation uses PhaseData, ProjectData, DealPaymentDm, BillsDm, ConstUnit, UtilMethods; {$R *.dfm} { TPhasePayData } constructor TPhasePayData.Create(APhaseData: TObject); begin inherited Create(nil); FPhaseData := APhaseData; FPayFormula := TPayFormula.Create(TPhaseData(FPhaseData).ProjectData); with TProjectData(TPhaseData(FPhaseData).ProjectData) do begin FPayFormula.Decimal := ProjProperties.DecimalManager.DealPay; FDecimal := ProjProperties.DecimalManager.DealPay; end; end; procedure TPhasePayData.Delete(AID: Integer); begin sddPhasePay.Remove(sddPhasePay.FindKey('idxID', AID)); end; destructor TPhasePayData.Destroy; begin FPayFormula.Free; inherited; end; procedure TPhasePayData.UpdateDataForNewAudit; var iNewAudit, iIndex: Integer; Rec: TsdDataRecord; begin BeforeBatchOperation; try iNewAudit := TPhaseData(FPhaseData).PhaseProperty.AuditCount; for iIndex := 0 to sddPhasePay.RecordCount - 1 do begin Rec := sddPhasePay.Records[iIndex]; Rec.ValueByName('TotalPrice' + IntToStr(iNewAudit)).AsString := Rec.ValueByName('TotalPrice' + IntToStr(iNewAudit - 1)).AsString; Rec.ValueByName('Formula' + IntToStr(iNewAudit)).AsString := Rec.ValueByName('Formula' + IntToStr(iNewAudit - 1)).AsString; Rec.ValueByName('EndTotalPrice' + IntToStr(iNewAudit)).AsString := Rec.ValueByName('EndTotalPrice' + IntToStr(iNewAudit - 1)).AsString; Rec.ValueByName('PreTotalPrice' + IntToStr(iNewAudit)).AsString := Rec.ValueByName('PreTotalPrice' + IntToStr(iNewAudit - 1)).AsString; end; finally AfterBatchOperation; end; end; procedure TPhasePayData.Open(AConnection: TADOConnection); begin sdpPhasePay.Connection := AConnection; sddPhasePay.Open; if not Assigned(sddPhasePay.IndexList.FindByName('idxID')) then sddPhasePay.AddIndex('idxID', 'ID'); SetFieldValidChar; // 为适应旧项目处不计算合同支付值所做修改。 if sddPhasePay.RecordCount = 0 then begin CopyPrePhasePayData; CalculateAll; end; end; procedure TPhasePayData.Save; begin sddPhasePay.Save; end; function TPhasePayData.AddPayRecord(AID: Integer): TsdDataRecord; begin Result := sddPhasePay.Add; Result.ValueByName('ID').AsInteger := AID; end; procedure TPhasePayData.sddPhasePayBeforeValueChange(AValue: TsdValue; const NewValue: Variant; var Allow: Boolean); begin if not Assigned(AValue) then Exit; if Pos('TotalPrice', AValue.FieldName) = 1 then FBeforeChangeTotalPrice := AValue.AsFloat; end; procedure TPhasePayData.sddPhasePayAfterValueChanged(AValue: TsdValue); begin if Pos('TotalPrice', AValue.FieldName) = 1 then begin AValue.Owner.ValueByName('End' + AValue.FieldName).AsFloat := AValue.AsFloat + AValue.Owner.ValueByName('Pre' + AValue.FieldName).AsFloat; with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do UpdateTotalPrice(AValue.Owner.ValueByName('ID').AsInteger, AValue.AsFloat - FBeforeChangeTotalPrice); end; CalculateCurPay; end; procedure TPhasePayData.CalculateAll; var iIndex: Integer; Rec: TsdDataRecord; begin if TPhaseData(FPhaseData).StageDataReadOnly then Exit; RepairPhaseRecord; for iIndex := 0 to sddPhasePay.RecordCount - 1 do begin Rec := sddPhasePay.Records[iIndex]; if GetCalcType(Rec.ValueByName('ID').AsInteger) in [0, 3] then Calculate(Rec.ValueByName('ID').AsInteger); end; CalculateCurPay; end; procedure TPhasePayData.Calculate(AID: Integer); var Rec: TsdDataRecord; // 金额列名, 公式列名 sTPField, sFField, sPreField: string; iID: Integer; fTotalPrice, fStartedPrice: Double; begin Rec := sddPhasePay.FindKey('idxID', AID); sTPField := 'TotalPrice' + IntToStr(TPhaseData(FPhaseData).StageIndex); sFField := 'Formula' + IntToStr(TPhaseData(FPhaseData).StageIndex); sPreField := 'PreTotalPrice' + IntToStr(TPhaseData(FPhaseData).StageIndex); if not Rec.ValueByName('StopCalc').AsBoolean then begin iID := Rec.ValueByName('ID').AsInteger; with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do begin // 获取起扣金额 fStartedPrice := GetStartedPrice(iID); if Rec.ValueByName(sFField).AsString <> '' then begin // 初次达到起扣金额时,bqwc基数值取值为累计完成计量-起扣金额 if FDecimal.TotalPrice.RoundTo(Rec.ValueByName('Pre'+sTPField).AsFloat) = 0 then fTotalPrice := FPayFormula.Calculate(Rec.ValueByName(sFField).AsString, fStartedPrice) else fTotalPrice := FPayFormula.Calculate(Rec.ValueByName(sFField).AsString); end else fTotalPrice := 0; if CheckStartedPrice(iID) then Rec.ValueByName(sTPField).AsFloat := GetAllowTotalPrice(iID, fTotalPrice, Rec.ValueByName(sPreField).AsFloat) else Rec.ValueByName(sTPField).AsFloat := 0; end; end else Rec.ValueByName(sTPField).AsFloat := 0; {if Rec.ValueByName(sFField).AsString <> '' then begin with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do begin iID := Rec.ValueByName('ID').AsInteger; // 获取起扣金额 fStartedPrice := GetStartedPrice(iID); // 初次达到起扣金额时,bqwc基数值取值为累计完成计量-起扣金额 if Rec.ValueByName('Pre'+sTPField).AsFloat = 0 then fTotalPrice := FPayFormula.Calculate(Rec.ValueByName(sFField).AsString, fStartedPrice) else fTotalPrice := FPayFormula.Calculate(Rec.ValueByName(sFField).AsString); if CheckStartedPrice(iID) then Rec.ValueByName(sTPField).AsFloat := GetAllowTotalPrice(iID, fTotalPrice, Rec.ValueByName(sPreField).AsFloat) else Rec.ValueByName(sTPField).AsFloat := 0; end; end;} // 计算截止数据 Rec.ValueByName('End' + sTPField).AsFloat := FDecimal.TotalPrice.RoundTo(Rec.ValueByName(sTPField).AsFloat + Rec.ValueByName('Pre' + sTPField).AsFloat); with TProjectData(TPhaseData(FPhaseData).ProjectData) do if StageDataReadOnly then DealPaymentData.SetTotalPrice(AID, Rec.ValueByName('End' + sTPField).AsFloat); end; function TPhasePayData.GetPayablePrice(AIndex: Integer): Double; var iIndex: Integer; sTotalPriceField: string; Rec: TsdDataRecord; begin Result := 0; // 阶段在0--14之间 if (AIndex < 0) or (AIndex > iMaxStageCount-1) then Exit; sTotalPriceField := 'TotalPrice' + IntToStr(AIndex); for iIndex := 0 to sddPhasePay.RecordCount - 1 do begin Rec := sddPhasePay.Records[iIndex]; if CheckMinus(Rec.ValueByName('ID').AsInteger) then Result := Result - Rec.ValueByName(sTotalPriceField).AsFloat else Result := Result + Rec.ValueByName(sTotalPriceField).AsFloat; end; end; function TPhasePayData.CheckMinus(AID: Integer): Boolean; begin with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do Result := sddDealPayment.FindKey('idxID', AID).ValueByName('IsMinus').AsBoolean; end; function TPhasePayData.GetFormula(AID: Integer): string; begin with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do Result := sddDealPayment.FindKey('idxID', AID).ValueByName('Formula').AsString; end; procedure TPhasePayData.AfterBatchOperation; begin sddPhasePay.BeforeValueChange := sddPhasePayBeforeValueChange; sddPhasePay.AfterValueChanged := sddPhasePayAfterValueChanged; sddPhasePay.EndUpdate; end; procedure TPhasePayData.BeforeBatchOperation; begin sddPhasePay.BeginUpdate; sddPhasePay.BeforeValueChange := nil; sddPhasePay.AfterValueChanged := nil; end; procedure TPhasePayData.CalculateCurPay; var Rec: TsdDataRecord; sTPField: string; I: Integer; begin sTPField := 'TotalPrice' + IntToStr(TPhaseData(FPhaseData).StageIndex); for I := 0 to sddPhasePay.RecordCount - 1 do begin Rec := sddPhasePay.Records[I]; if GetCalcType(Rec.ValueByName('ID').AsInteger) = 1 then begin Rec.ValueByName(sTPField).AsFloat := CurPayable; Rec.ValueByName('End' + sTPField).AsFloat := Rec.ValueByName(sTPField).AsFloat + Rec.ValueByName('Pre' + sTPField).AsFloat; Break; end; end; end; function TPhasePayData.GetCurPayable: Double; var Rec: TsdDataRecord; sTPField: string; i: Integer; begin sTPField := 'TotalPrice' + IntToStr(TPhaseData(FPhaseData).StageIndex); Result := 0; for I := 0 to sddPhasePay.RecordCount - 1 do begin Rec := sddPhasePay.Records[I]; // 检查是否为一般项 if GetCalcType(Rec.ValueByName('ID').AsInteger) = 0 then if CheckMinus(Rec.ValueByName('ID').AsInteger) then Result := Result - Rec.ValueByName(sTPField).AsFloat else Result := Result + Rec.ValueByName(sTPField).AsFloat; end; end; function TPhasePayData.GetCalcType(AID: Integer): Integer; var Rec: TsdDataRecord; begin Result := 0; with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do Rec := sddDealPayment.FindKey('idxID', AID); if Assigned(Rec) then Result := Rec.ValueByName('CalcType').AsInteger; end; function TPhasePayData.GetLastestPhasePay(AType: Integer): Double; var Rec: TsdDataRecord; sTPField: string; i: Integer; begin case AType of 1: sTPField := 'TotalPrice' + IntToStr(TPhaseData(FPhaseData).PhaseProperty.AuditCount); 2: sTPField := 'EndTotalPrice' + IntToStr(TPhaseData(FPhaseData).PhaseProperty.AuditCount); 3: sTPField := 'PreTotalPrice' + IntToStr(TPhaseData(FPhaseData).PhaseProperty.AuditCount); end; Result := 0; for i := 0 to sddPhasePay.RecordCount - 1 do begin Rec := sddPhasePay.Records[i]; // 检查是否为一般项 if GetCalcType(Rec.ValueByName('ID').AsInteger) = 0 then if CheckMinus(Rec.ValueByName('ID').AsInteger) then Result := Result - Rec.ValueByName(sTPField).AsFloat else Result := Result + Rec.ValueByName(sTPField).AsFloat; end; end; procedure TPhasePayData.CopyPrePhasePayData; var iRecord: Integer; Rec, NewRec: TsdDataRecord; begin BeforeBatchOperation; try if sddPhasePay.RecordCount > 0 then Exit; with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do for iRecord := 0 to sddDealPayment.RecordCount - 1 do begin Rec := sddDealPayment.Records[iRecord]; NewRec := sddPhasePay.Add; NewRec.ValueByName('ID').AsInteger := Rec.ValueByName('ID').AsInteger; NewRec.ValueByName('EndTotalPrice0').AsFloat := Rec.ValueByName('TotalPrice').AsFloat; NewRec.ValueByName('PreTotalPrice0').AsFloat := Rec.ValueByName('TotalPrice').AsFloat; NewRec.ValueByName('Formula0').AsString := Rec.ValueByName('Formula').AsString; NewRec.ValueByName('StopCalc').AsBoolean := Rec.ValueByName('StopCalc').AsBoolean; end; finally AfterBatchOperation; end; end; procedure TPhasePayData.SetFieldValidChar; var i: Integer; sField: string; begin for i := 0 to iMaxStageCount - 1 do begin sField := 'TotalPrice' + IntToStr(i); sddPhasePay.FieldByName(sField).ValidChars := sddPhasePay.FieldByName(sField).ValidChars + ArithmeticCharSet + ExprsBaseCharSet; end; end; function TPhasePayData.PayRecord(AID: Integer): TsdDataRecord; begin Result := sddPhasePay.FindKey('idxID', AID); end; procedure TPhasePayData.RepairPhaseRecord; var i: Integer; vDealRec, vPhaseRec: TsdDataRecord; begin // 旧设计中,DealPayment中数据多于PhasePay // 在于用户新增了合同支付项,但未输入金额或公式,以减少数据 // 现,要求存在合同支付项,设置了计提期限,但未输入金额或公式时,达计提期限时,金额需计 // 故在每次计算前,检查一遍合同支付数据,以兼容旧项目,并保证DealPayment与PhasePay数据行相同 with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do begin if sddDealPayment.RecordCount > sddPhasePay.RecordCount then begin for i := 0 to sddDealPayment.RecordCount - 1 do begin vDealRec := sddDealPayment.Records[i]; vPhaseRec := PayRecord(vDealRec.ValueByName('ID').AsInteger); if not Assigned(vPhaseRec) then vPhaseRec := AddPayRecord(vDealRec.ValueByName('ID').AsInteger); end; end; end; end; function TPhasePayData.GetBqwc(AType: Integer): Double; var Rec: TsdDataRecord; sTPField: string; i: Integer; begin case AType of 1: sTPField := 'TotalPrice' + IntToStr(TPhaseData(FPhaseData).PhaseProperty.AuditCount); 2: sTPField := 'EndTotalPrice' + IntToStr(TPhaseData(FPhaseData).PhaseProperty.AuditCount); 3: sTPField := 'PreTotalPrice' + IntToStr(TPhaseData(FPhaseData).PhaseProperty.AuditCount); end; Result := 0; for i := 0 to sddPhasePay.RecordCount - 1 do begin Rec := sddPhasePay.Records[i]; // 检查是否为一般项 if GetName(Rec.ValueByName('ID').AsInteger) = '本期完成计量' then begin Result := Rec.ValueByName(sTPField).AsFloat; Break; end; end; end; function TPhasePayData.GetName(AID: Integer): string; var Rec: TsdDataRecord; begin Result := ''; with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do Rec := sddDealPayment.FindKey('idxID', AID); if Assigned(Rec) then Result := Rec.ValueByName('Name').AsString; end; procedure TPhasePayData.CopyPrePhasePayData(const APreFile: string; APreFinalIndex: Integer); const sCopySql = 'Insert Into %s (' + ' ID, PreTotalPrice0, EndTotalPrice0, Formula0, StopCalc' + ' ) Select ID, EndTotalPrice%d, EndTotalPrice%d, Formula%d, StopCalc' + ' From %s' + ' In ''%s'''; var sPre, sSql: string; i: Integer; vRec: TsdDataRecord; fValue: Double; begin try sSql := Format(sCopySql, [TableName, APreFinalIndex, APreFinalIndex, APreFinalIndex, TableName, APreFile]); ExecuteSql(TPhaseData(FPhaseData).ADOConnection, sSql); finally sddPhasePay.Reload; for i := 0 to sddPhasePay.RecordCount - 1 do begin vRec := sddPhasePay.Records[i]; if TryStrToFloat(vRec.ValueByName('Formula0').AsString, fValue) then vRec.ValueByName('Formula0').AsString := ''; end; end; end; function TPhasePayData.GetTableName: string; begin Result := sdpPhasePay.TableName; end; end.