unit PhasePayDm; interface uses SysUtils, Classes, sdDB, sdProvider, ADODB, FormulaCalc; 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; function CheckMinus(AID: Integer): Boolean; function GetFormula(AID: Integer): string; function GetCalcType(AID: Integer): Integer; function GetPayablePrice(AIndex: Integer): Double; procedure BeforeBatchOperation; procedure AfterBatchOperation; function GetCurPayable: Double; function GetLastestPhasePay(AType: Integer): Double; procedure SetFieldValidChar; 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; property PayablePrice[AIndex: Integer]: Double read GetPayablePrice; // 本期应付 property CurPayable: Double read GetCurPayable; // AType表示不同类型,取值如下: // 1: 本期数据 2: 截止本期数据 3: 截止上期数据 property LastestPhasePay[AType: Integer]: Double read GetLastestPhasePay; end; implementation uses PhaseData, ProjectData, DealPaymentDm, BillsDm, ConstUnit; {$R *.dfm} { TPhasePayData } constructor TPhasePayData.Create(APhaseData: TObject); begin inherited Create(nil); FPhaseData := APhaseData; FPayFormula := TPayFormula.Create(TPhaseData(FPhaseData).ProjectData); 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; begin if TPhaseData(FPhaseData).StageDataReadOnly then Exit; for iIndex := 0 to sddPhasePay.RecordCount - 1 do Calculate(sddPhasePay.Records[iIndex].ValueByName('ID').AsInteger); CalculateCurPay; end; procedure TPhasePayData.Calculate(AID: Integer); var Rec: TsdDataRecord; // 金额列名, 公式列名 sTPField, sFField: string; iID: Integer; fTotalPrice, fStartedPrice: Double; begin Rec := sddPhasePay.FindKey('idxID', AID); sTPField := 'TotalPrice' + IntToStr(TPhaseData(FPhaseData).StageIndex); sFField := 'Formula' + IntToStr(TPhaseData(FPhaseData).StageIndex); 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) - Rec.ValueByName(sTPField).AsFloat else fTotalPrice := FPayFormula.Calculate(Rec.ValueByName(sFField).AsString) - Rec.ValueByName(sTPField).AsFloat; if CheckStartedPrice(iID) then Rec.ValueByName(sTPField).AsFloat := Rec.ValueByName(sTPField).AsFloat + GetAllowTotalPrice(iID, fTotalPrice) else Rec.ValueByName(sTPField).AsFloat := 0; end; end; // 计算截止数据 Rec.ValueByName('End' + sTPField).AsFloat := Rec.ValueByName(sTPField).AsFloat + Rec.ValueByName('Pre' + 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; end; procedure TPhasePayData.BeforeBatchOperation; begin 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; 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; end.