unit StageDm; // 原报、审核数据通用 // 原报 - Refer // 审核 - Audit1, Audit2 ... interface uses mDataRecord, BillsTree, SysUtils, Classes, sdDB, sdProvider, ADODB, ZhAPI, sdIDTree; type TStageData = class(TDataModule) sdpStage: TsdADOProvider; sddStage: TsdDataSet; procedure sddStageAfterValueChanged(AValue: TsdValue); procedure sddStageBeforeValueChange(AValue: TsdValue; const NewValue: Variant; var Allow: Boolean); procedure sddStageGetRecordClass(var ARecordClass: TsdRecordClass); private FPhaseData: TObject; FIndex: Integer; FBeforeChangeQuantity: Double; FBeforeChangeTotalPrice: Double; procedure BeforeBatchOperation; procedure AfterBatchOperation; procedure UpdateParentRecord(ABillsID: Integer; ATotalPrice: Double; const AFieldName: string); procedure UpdateComplete(ABillsID: Integer; AQuantity, ATotalPrice: Double); procedure CalculateDeal(ABillsID: Integer); procedure CalculateQuantityChange(ABillsID: Integer); procedure CalculatePriceChange(ABillsID: Integer); procedure CalculateParent(ANode: TBillsIDTreeNode); procedure CalculateLeaf(ANode: TBillsIDTreeNode); function GetTotalPrice(ABillsID, AType, AStageIndex: Integer): Double; function GetCalcType(ABillsID: Integer): Integer; function GetBillsPrice(ABillsID: Integer): Double; function GetBillsNewPrice(ABillsID: Integer): Double; function GetBillsPriceDiffer(ABillsID: Integer): Double; function GetMainBillsTree: TBillsIDTree; function GetBuildLoadInterest(AType, AIndex: Integer): Double; function GetFirstPart(AType, AIndex: Integer): Double; function GetOtherFee(AType, AIndex: Integer): Double; function GetOtherProjectFee(AType, AIndex: Integer): Double; function GetRecyclingFee(AType, AIndex: Integer): Double; function GetReservedFee(AType, AIndex: Integer): Double; function GetSecondPart(AType, AIndex: Integer): Double; function GetStageSettlement(AType, AIndex: Integer): Double; function GetThirdPart(AType, AIndex: Integer): Double; function GetActive: Boolean; procedure SetTableName(const Value: string); function GetChapterStageGather(AChapter: Integer): Double; public constructor Create(APhaseData: TObject); destructor Destroy; override; procedure Open(AConnection: TADOConnection); procedure Save; procedure CalculateNode(ANode: TsdIDTreeNode); procedure CalculateAll; function AddPhaseData(ABillsID: Integer; const AField, ANewValue: string): Boolean; function AddStageRecord(ABillsID: Integer): TStageRecord; procedure DeletePhaseRecord(ABillsID: Integer); procedure ReCalculate(ABillsID: Integer); procedure UpdateBGLInfo(ARec: TsdDataRecord; const AType: string); function StageRecord(ABillsID: Integer): TStageRecord; // 将Bills表中存的累计计量数据拷贝至截止本期计量、截止上期计量,除新增一期计量外不可调用 procedure CopyPrePhaseData; property Active: Boolean read GetActive; property TableName: string Write SetTableName; property MainBillsTree: TBillsIDTree read GetMainBillsTree; {可选计算数} // AType表示不同类型,取值如下: // 1: 本期数据 2: 截止本期数据 3: 截止上期数据 // AIndex表示AType下不同数据类型,取值如下: // 1: 合同计量 2: 数量变更计量 3: 单价变更计量 4: 完成计量 // 第一部分 property FirstPart[AType, AIndex: Integer]: Double read GetFirstPart; // 第二部分 property SecondPart[AType, AIndex: Integer]: Double read GetSecondPart; // 第三部分 property ThirdPart[AType, AIndex: Integer]: Double read GetThirdPart; // 预留费用 property ReservedFee[AType, AIndex: Integer]: Double read GetReservedFee; // 其他费用项目 property OtherFee[AType, AIndex: Integer]: Double read GetOtherFee; // 建设期贷款利息 property BuildLoadInterest[AType, AIndex: Integer]: Double read GetBuildLoadInterest; // 回收金额 property RecyclingFee[AType, AIndex: Integer]: Double read GetRecyclingFee; // 公路工程以外的工程费用 property OtherProjectFee[AType, AIndex: Integer]: Double read GetOtherProjectFee; // 本期结算价 property StageSettlement[AType, AIndex: Integer]: Double read GetStageSettlement; // 100/200/.../900章本期完成计量 property ChapterStageGather[AChapter: Integer]: Double read GetChapterStageGather; end; implementation uses ProjectData, BillsDm, PhaseData, Math, BGLDm, BillsMeasureDm, UtilMethods, ConditionalDefines, FormulaCalc; {$R *.dfm} { TPhaseData } function TStageData.AddPhaseData(ABillsID: Integer; const AField, ANewValue: string): Boolean; procedure SetPhaseRecord(ARec: TsdDataRecord; const AField, AValue: string); begin if CheckNumeric(ANewValue) then ARec.ValueByName(AField).AsString := AValue else begin ARec.ValueByName(AField).AsFloat := EvaluateExprs(AValue); ARec.ValueByName(StringReplace(AField, 'Quantity', 'Flag', [])).AsInteger := 1; ARec.ValueByName(StringReplace(AField, 'Quantity', 'Formula', [])).AsString := AValue; end; end; var Rec: TsdDataRecord; begin if Assigned(sddStage.FindKey('idxBID', ABillsID)) then Exit; Rec := sddStage.Add; Rec.ValueByName('BillsID').AsInteger := ABillsID; SetPhaseRecord(Rec, AField, ANewValue); end; function TStageData.AddStageRecord(ABillsID: Integer): TStageRecord; begin Result := TStageRecord(sddStage.FindKey('idxBID', ABillsID)); if Assigned(Result) then Exit; Result := TStageRecord(sddStage.Add(True)); try Result.ValueByName('BillsID').AsInteger := ABillsID; finally Result.EndUpdate; end; end; procedure TStageData.CalculateDeal(ABillsID: Integer); var Rec: TsdDataRecord; fQtyDiffer, fTPDiffer: Double; begin Rec := sddStage.FindKey('idxBID', ABillsID); if GetCalcType(ABillsID) = 0 then Rec.ValueByName('DealTotalPrice').AsFloat := TotalPriceRoundTo(Rec.ValueByName('DealQuantity').AsFloat * GetBillsPrice(ABillsID)); fQtyDiffer := Rec.ValueByName('DealQuantity').AsFloat - FBeforeChangeQuantity; fTPDiffer := Rec.ValueByName('DealTotalPrice').AsFloat - FBeforeChangeTotalPrice; Rec.ValueByName('EndDealQuantity').AsFloat := QuantityRoundTo( Rec.ValueByName('EndDealQuantity').AsFloat + fQtyDiffer); Rec.ValueByName('EndDealTotalPrice').AsFloat := TotalPriceRoundTo( Rec.ValueByName('EndDealTotalPrice').AsFloat + fTPDiffer); UpdateParentRecord(ABillsID, fTPDiffer, 'DealTotalPrice'); UpdateComplete(ABillsID, fQtyDiffer, fTPDiffer); if TPhaseData(FPhaseData).IsLastStage then with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do UpdateRecordDeal(ABillsID, fQtyDiffer, fTPDiffer); TPhaseData(FPhaseData).PhasePayData.CalculateAll; end; procedure TStageData.CalculatePriceChange(ABillsID: Integer); var Rec: TsdDataRecord; fQtyDiffer, fTPDiffer: Double; begin Rec := sddStage.FindKey('idxBID', ABillsID); if GetCalcType(ABillsID) < 2 then Rec.ValueByName('PcTotalPrice').AsFloat := TotalPriceRoundTo(Rec.ValueByName('PcQuantity').AsFloat * GetBillsPriceDiffer(ABillsID)); fQtyDiffer := Rec.ValueByName('PcQuantity').AsFloat - FBeforeChangeQuantity; fTPDiffer := Rec.ValueByName('PcTotalPrice').AsFloat - FBeforeChangeTotalPrice; Rec.ValueByName('EndPcQuantity').AsFloat := QuantityRoundTo( Rec.ValueByName('EndPcQuantity').AsFloat + fQtyDiffer); Rec.ValueByName('EndPcTotalPrice').AsFloat := TotalPriceRoundTo( Rec.ValueByName('EndPcTotalPrice').AsFloat + fTPDiffer); UpdateParentRecord(ABillsID, fTPDiffer, 'PcTotalPrice'); UpdateComplete(ABillsID, 0, fTPDiffer); if TPhaseData(FPhaseData).IsLastStage then with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do UpdateRecordPc(ABillsID, fQtyDiffer, fTPDiffer); TPhaseData(FPhaseData).PhasePayData.CalculateAll; end; procedure TStageData.CalculateQuantityChange(ABillsID: Integer); var Rec: TsdDataRecord; fQtyDiffer, fTPDiffer: Double; begin Rec := sddStage.FindKey('idxBID', ABillsID); if GetCalcType(ABillsID) = 0 then Rec.ValueByName('QcTotalPrice').AsFloat := TotalPriceRoundTo(Rec.ValueByName('QcQuantity').AsFloat * GetBillsPrice(ABillsID)); fQtyDiffer := Rec.ValueByName('QcQuantity').AsFloat - FBeforeChangeQuantity; fTPDiffer := Rec.ValueByName('QcTotalPrice').AsFloat - FBeforeChangeTotalPrice; Rec.ValueByName('EndQcQuantity').AsFloat := QuantityRoundTo( Rec.ValueByName('EndQcQuantity').AsFloat + fQtyDiffer); Rec.ValueByName('EndQcTotalPrice').AsFloat := TotalPriceRoundTo( Rec.ValueByName('EndQcTotalPrice').AsFloat + fTPDiffer); UpdateParentRecord(ABillsID, fTPDiffer, 'QcTotalPrice'); UpdateComplete(ABillsID, fQtyDiffer, fTPDiffer); if TPhaseData(FPhaseData).IsLastStage then with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do UpdateRecordQc(ABillsID, fQtyDiffer, fTPDiffer); TPhaseData(FPhaseData).PhasePayData.CalculateAll; end; constructor TStageData.Create(APhaseData: TObject); begin inherited Create(nil); FPhaseData := APhaseData; end; procedure TStageData.DeletePhaseRecord(ABillsID: Integer); var Rec: TsdDataRecord; begin Rec := sddStage.FindKey('idxBID', ABillsID); if Assigned(Rec) then sddStage.Remove(Rec); end; destructor TStageData.Destroy; begin inherited; end; function TStageData.GetBillsNewPrice(ABillsID: Integer): Double; begin Result := MainBillsTree.FindNode(ABillsID).Rec.ValueByName('NewPrice').AsFloat; end; function TStageData.GetBillsPrice(ABillsID: Integer): Double; begin Result := MainBillsTree.FindNode(ABillsID).Rec.ValueByName('Price').AsFloat; end; procedure TStageData.Open(AConnection: TADOConnection); begin sdpStage.Connection := AConnection; sddStage.Open; if not Assigned(sddStage.IndexList.FindByName('idxBID')) then sddStage.AddIndex('idxBID', 'BillsID'); sddStage.FieldByName('DealQuantity').ValidChars := sddStage.FieldByName('DealQuantity').ValidChars + ArithmeticCharSet; sddStage.FieldByName('DealTotalPrice').ValidChars := sddStage.FieldByName('DealQuantity').ValidChars; end; function TStageData.StageRecord(ABillsID: Integer): TStageRecord; begin Result := nil; if Assigned(sddStage.IndexList.FindByName('idxBID')) then Result := TStageRecord(sddStage.FindKey('idxBID', ABillsID)); end; procedure TStageData.ReCalculate(ABillsID: Integer); var Rec: TsdDataRecord; fDiffer: Double; begin Rec := sddStage.FindKey('idxBID', ABillsID); if not Assigned(Rec) then Exit; if Rec.ValueByName('DealFlag').AsInteger = 1 then Rec.ValueByName('DealQuantity').AsFloat := QuantityRoundTo( EvaluateExprs(Rec.ValueByName('DealFormula').AsString)); if Rec.ValueByName('DealFlag').AsInteger < 2 then begin fDiffer := Rec.ValueByName('DealQuantity').AsFloat * GetBillsPrice(ABillsID) - Rec.ValueByName('DealTotalPrice').AsFloat; Rec.ValueByName('DealTotalPrice').AsFloat := TotalPriceRoundTo( Rec.ValueByName('DealQuantity').AsFloat * GetBillsPrice(ABillsID)); end; Rec.ValueByName('EndDealQuantity').AsFloat := QuantityRoundTo( Rec.ValueByName('PreDealQuantity').AsFloat + Rec.ValueByName('DealQuantity').AsFloat); Rec.ValueByName('EndDealTotalPrice').AsFloat := TotalPriceRoundTo( Rec.ValueByName('PreDealTotalPrice').AsFloat + Rec.ValueByName('DealTotalPrice').AsFloat); if Rec.ValueByName('QcFlag').AsInteger = 1 then Rec.ValueByName('QcQuantity').AsFloat := QuantityRoundTo( EvaluateExprs(Rec.ValueByName('QcFormula').AsString)); if Rec.ValueByName('QcFlag').AsInteger < 2 then begin fDiffer := Rec.ValueByName('QcQuantity').AsFloat * GetBillsPrice(ABillsID) - Rec.ValueByName('QcTotalPrice').AsFloat; Rec.ValueByName('QcTotalPrice').AsFloat := TotalPriceRoundTo( Rec.ValueByName('QcQuantity').AsFloat * GetBillsPrice(ABillsID)); end; Rec.ValueByName('EndQcQuantity').AsFloat := QuantityRoundTo( Rec.ValueByName('PreQcQuantity').AsFloat + Rec.ValueByName('QcQuantity').AsFloat); Rec.ValueByName('EndQcTotalPrice').AsFloat := TotalPriceRoundTo( Rec.ValueByName('PreQcTotalPrice').AsFloat + Rec.ValueByName('QcTotalPrice').AsFloat); if Rec.ValueByName('PcFlag').AsInteger = 1 then Rec.ValueByName('PcQuantity').AsFloat := QuantityRoundTo( EvaluateExprs(Rec.ValueByName('PcFormula').AsString)); if Rec.ValueByName('DealFlag').AsInteger < 2 then begin fDiffer := Rec.ValueByName('PcQuantity').AsFloat * GetBillsNewPrice(ABillsID) - Rec.ValueByName('PcTotalPrice').AsFloat; Rec.ValueByName('PcTotalPrice').AsFloat := TotalPriceRoundTo( Rec.ValueByName('PcQuantity').AsFloat * GetBillsNewPrice(ABillsID)); end; Rec.ValueByName('EndPcQuantity').AsFloat := QuantityRoundTo( Rec.ValueByName('PrePcQuantity').AsFloat + Rec.ValueByName('PcQuantity').AsFloat); Rec.ValueByName('EndPcTotalPrice').AsFloat := TotalPriceRoundTo( Rec.ValueByName('PrePcTotalPrice').AsFloat + Rec.ValueByName('PcTotalPrice').AsFloat); end; procedure TStageData.Save; begin sddStage.Save; end; procedure TStageData.sddStageAfterValueChanged(AValue: TsdValue); var iBillsID: Integer; stnNode: TsdIDTreeNode; begin iBillsID := AValue.Owner.ValueByName('BillsID').AsInteger; stnNode := MainBillsTree.FindNode(iBillsID); if not Assigned(stnNode) or stnNode.HasChildren then Exit; if (AValue.FieldName = 'DealQuantity') or (AValue.FieldName = 'DealFormula') or (AValue.FieldName = 'DealTotalPrice') then CalculateDeal(AValue.Owner.ValueByName('BillsID').AsInteger); if (AValue.FieldName = 'QcQuantity') or (AValue.FieldName = 'QcFormula') or (AValue.FieldName = 'QcTotalPrice') then CalculateQuantityChange(AValue.Owner.ValueByName('BillsID').AsInteger); if (AValue.FieldName = 'PcQuantity') or (AValue.FieldName = 'PcFormula') or (AValue.FieldName = 'PcTotalPrice') then CalculatePriceChange(AValue.Owner.ValueByName('BillsID').AsInteger); end; function TStageData.GetMainBillsTree: TBillsIDTree; begin with TProjectData(TPhaseData(FPhaseData).ProjectData) do Result := BillsMeasureData.BillsMeasureTree; end; procedure TStageData.sddStageBeforeValueChange(AValue: TsdValue; const NewValue: Variant; var Allow: Boolean); procedure SetBeforeChangeValue(const AType: string); begin if SameText(AValue.FieldName, AType + 'Quantity') or SameText(AValue.FieldName, AType + 'Formula') or SameText(AValue.FieldName, AType + 'TotalPrice') then begin FBeforeChangeQuantity := AValue.Owner.ValueByName(AType + 'Quantity').AsFloat; FBeforeChangeTotalPrice := AValue.Owner.ValueByName(AType + 'TotalPrice').AsFloat; end; end; procedure CheckOverRange; var vNode: TsdIDTreeNode; fAvailableQty: Double; begin if SameText(AValue.FieldName, 'DealQuantity') then begin vNode := MainBillsTree.FindNode(AValue.Owner.ValueByName('BillsID').AsInteger); fAvailableQty := vNode.Rec.ValueByName('Quantity').AsFloat - vNode.Rec.ValueByName('AddDealQuantity').AsFloat + AValue.AsFloat; if VarToFloatDef(NewValue, 0) > fAvailableQty then DataSetErrorMessage(Allow, '不可超过0号台账合同数量!'); end; end; begin // 不检查超计 //CheckOverRange; SetBeforeChangeValue('Deal'); SetBeforeChangeValue('Qc'); SetBeforeChangeValue('Pc'); end; procedure TStageData.AfterBatchOperation; begin sddStage.BeforeValueChange := sddStageBeforeValueChange; sddStage.AfterValueChanged := sddStageAfterValueChanged; end; procedure TStageData.BeforeBatchOperation; begin sddStage.BeforeValueChange := nil; sddStage.AfterValueChanged := nil; end; function TStageData.GetBillsPriceDiffer(ABillsID: Integer): Double; begin with MainBillsTree.FindNode(ABillsID).Rec do Result := ValueByName('NewPrice').AsFloat - ValueByName('Price').AsFloat; end; procedure TStageData.UpdateComplete(ABillsID: Integer; AQuantity, ATotalPrice: Double); var Rec: TsdDataRecord; begin if ABillsID = -1 then Exit; Rec := StageRecord(ABillsID); Rec.ValueByName('GatherQuantity').AsFloat := QuantityRoundTo( Rec.ValueByName('GatherQuantity').AsFloat + AQuantity); Rec.ValueByName('GatherTotalPrice').AsFloat := TotalPriceRoundTo( Rec.ValueByName('GatherTotalPrice').AsFloat + ATotalPrice); Rec.ValueByName('EndGatherQuantity').AsFloat := QuantityRoundTo( Rec.ValueByName('EndGatherQuantity').AsFloat + AQuantity); Rec.ValueByName('EndGatherTotalPrice').AsFloat := TotalPriceRoundTo( Rec.ValueByName('EndGatherTotalPrice').AsFloat + ATotalPrice); // 数量不向上汇总 UpdateParentRecord(ABillsID, ATotalPrice, 'GatherTotalPrice'); end; procedure TStageData.UpdateParentRecord(ABillsID: Integer; ATotalPrice: Double; const AFieldName: string); var iParentID: Integer; Rec: TsdDataRecord; begin iParentID := MainBillsTree.FindNode(ABillsID).ParentID; if iParentID = -1 then Exit; Rec := StageRecord(iParentID); if not Assigned(Rec) then Rec := AddStageRecord(iParentID); Rec.ValueByName(AFieldName).AsFloat := TotalPriceRoundTo( Rec.ValueByName(AFieldName).AsFloat + ATotalPrice); Rec.ValueByName('End' + AFieldName).AsFloat := TotalPriceRoundTo( Rec.ValueByName('End' + AFieldName).AsFloat + ATotalPrice); UpdateParentRecord(iParentID, ATotalPrice, AFieldName); end; function TStageData.GetBuildLoadInterest(AType, AIndex: Integer): Double; begin Result := GetTotalPrice(34, AType, AIndex); end; function TStageData.GetFirstPart(AType, AIndex: Integer): Double; begin Result := GetTotalPrice(1, AType, AIndex); end; function TStageData.GetOtherFee(AType, AIndex: Integer): Double; begin Result := GetTotalPrice(15, AType, AIndex); end; function TStageData.GetOtherProjectFee(AType, AIndex: Integer): Double; begin Result := GetTotalPrice(9, AType, AIndex); end; function TStageData.GetRecyclingFee(AType, AIndex: Integer): Double; begin Result := GetTotalPrice(16, AType, AIndex); end; function TStageData.GetReservedFee(AType, AIndex: Integer): Double; begin Result := GetTotalPrice(7, AType, AIndex); end; function TStageData.GetSecondPart(AType, AIndex: Integer): Double; begin Result := GetTotalPrice(2, AType, AIndex); end; function TStageData.GetStageSettlement(AType, AIndex: Integer): Double; begin // 全国 // 第一部分+第二部分+第三部分+预备费+新增加费用项目(其他费用_广东)-回收金额 Result := FirstPart[AType, AIndex] + SecondPart[AType, AIndex] + ThirdPart[AType, AIndex] + ReservedFee[AType, AIndex] + OtherFee[AType, AIndex] - RecyclingFee[AType, AIndex]; // 广东 // 全国的基础上+建设期贷款利息+公路功能以外的项目 if _IsGuangDong then Result := Result + BuildLoadInterest[AType, AIndex] + OtherProjectFee[AType, AIndex] end; function TStageData.GetThirdPart(AType, AIndex: Integer): Double; begin Result := GetTotalPrice(3, AType, AIndex); end; function TStageData.GetTotalPrice(ABillsID, AType, AStageIndex: Integer): Double; var Rec: TsdDataRecord; sFieldName: string; begin Result := 0; Rec := StageRecord(ABillsID); if not Assigned(Rec) then Exit; case AType of 1: sFieldName := ''; 2: sFieldName := 'End'; 3: sFieldName := 'Pre'; end; case AStageIndex of 1: sFieldName := sFieldName + 'DealTotalPrice'; 2: sFieldName := sFieldName + 'QcTotalPrice'; 3: sFieldName := sFieldName + 'PcTotalPrice'; 4: sFieldName := sFieldName + 'GatherTotalPrice'; end; Result := Rec.ValueByName(sFieldName).AsFloat; end; procedure TStageData.CopyPrePhaseData; var iRecord: Integer; Rec, NewRec: TsdDataRecord; begin BeforeBatchOperation; try with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsData do for iRecord := 0 to sddBills.RecordCount - 1 do begin Rec := sddBills.Records[iRecord]; if (Rec.ValueByName('AddGatherTotalPrice').AsFloat = 0) and (Rec.ValueByName('AddDealTotalPrice').AsFloat = 0) and (Rec.ValueByName('AddQcTotalPrice').AsFloat = 0) and (Rec.ValueByName('AddPcTotalPrice').AsFloat = 0) then Continue; NewRec := sddStage.Add; NewRec.ValueByName('BillsID').AsInteger := Rec.ValueByName('ID').AsInteger; NewRec.ValueByName('EndDealQuantity').AsFloat := Rec.ValueByName('AddDealQuantity').AsFloat; NewRec.ValueByName('EndDealTotalPrice').AsFloat := Rec.ValueByName('AddDealTotalPrice').AsFloat; NewRec.ValueByName('EndQcQuantity').AsFloat := Rec.ValueByName('AddQcQuantity').AsFloat; NewRec.ValueByName('EndQcTotalPrice').AsFloat := Rec.ValueByName('AddQcTotalPrice').AsFloat; NewRec.ValueByName('EndQcBGLCode').AsString := Rec.ValueByName('AddQcBGLCode').AsString; NewRec.ValueByName('EndQcBGLNum').AsString := Rec.ValueByName('AddQcBGLNum').AsString; NewRec.ValueByName('EndPcQuantity').AsFloat := Rec.ValueByName('AddPcQuantity').AsFloat; NewRec.ValueByName('EndPcTotalPrice').AsFloat := Rec.ValueByName('AddPcTotalPrice').AsFloat; NewRec.ValueByName('EndPcBGLCode').AsString := Rec.ValueByName('AddPcBGLCode').AsString; NewRec.ValueByName('EndPcBGLNum').AsString := Rec.ValueByName('AddPcBGLNum').AsString; NewRec.ValueByName('EndGatherQuantity').AsFloat := Rec.ValueByName('AddGatherQuantity').AsFloat; NewRec.ValueByName('EndGatherTotalPrice').AsFloat := Rec.ValueByName('AddGatherTotalPrice').AsFloat; NewRec.ValueByName('PreDealQuantity').AsFloat := Rec.ValueByName('AddDealQuantity').AsFloat; NewRec.ValueByName('PreDealTotalPrice').AsFloat := Rec.ValueByName('AddDealTotalPrice').AsFloat; NewRec.ValueByName('PreQcQuantity').AsFloat := Rec.ValueByName('AddQcQuantity').AsFloat; NewRec.ValueByName('PreQcTotalPrice').AsFloat := Rec.ValueByName('AddQcTotalPrice').AsFloat; NewRec.ValueByName('PreQcBGLCode').AsString := Rec.ValueByName('AddQcBGLCode').AsString; NewRec.ValueByName('PreQcBGLNum').AsString := Rec.ValueByName('AddQcBGLNum').AsString; NewRec.ValueByName('PrePcQuantity').AsFloat := Rec.ValueByName('AddPcQuantity').AsFloat; NewRec.ValueByName('PrePcTotalPrice').AsFloat := Rec.ValueByName('AddPcTotalPrice').AsFloat; NewRec.ValueByName('PrePcBGLCode').AsString := Rec.ValueByName('AddPcBGLCode').AsString; NewRec.ValueByName('PrePcBGLNum').AsString := Rec.ValueByName('AddPcBGLNum').AsString; NewRec.ValueByName('PreGatherQuantity').AsFloat := Rec.ValueByName('AddGatherQuantity').AsFloat; NewRec.ValueByName('PreGatherTotalPrice').AsFloat := Rec.ValueByName('AddGatherTotalPrice').AsFloat; end; finally AfterBatchOperation; end; end; procedure TStageData.UpdateBGLInfo(ARec: TsdDataRecord; const AType: string); var sPreBGLCode, sPreBGLNum, sCurBGLCode, sCurBGLNum: string; begin sPreBGLCode := ARec.ValueByName('Pre' + AType + 'BGLCode').AsString; sPreBGLNum := ARec.ValueByName('Pre' + AType + 'BGLNum').AsString; sCurBGLCode := ARec.ValueByName(AType + 'BGLCode').AsString; sCurBGLNum := ARec.ValueByName(AType + 'BGLNum').AsString; MergeRelaBGLAndNum(sPreBGLCode, sPreBGLNum, sCurBGLCode, sCurBGLNum); ARec.ValueByName('End' + AType + 'BGLCode').AsString := sPreBGLCode; ARec.ValueByName('End' + AType + 'BGLNum').AsString := sPreBGLNum; end; procedure TStageData.CalculateAll; begin BeforeBatchOperation; CalculateNode(MainBillsTree.FirstNode); AfterBatchOperation; end; procedure TStageData.CalculateNode(ANode: TsdIDTreeNode); begin if not Assigned(ANode) then Exit; if ANode.HasChildren then begin CalculateNode(ANode.FirstChild); CalculateParent(TBillsIDTreeNode(ANode)); end else CalculateLeaf(TBillsIDTreeNode(ANode)); CalculateNode(ANode.NextSibling); end; procedure TStageData.CalculateParent(ANode: TBillsIDTreeNode); var iChild: Integer; ChildNode: TBillsIDTreeNode; fDeal, fQc, fPc: Double; begin if not Assigned(ANode.StageRec) then Exit; fDeal := 0; fQc := 0; FPc := 0; for iChild := 0 to ANode.ChildCount - 1 do begin ChildNode := TBillsIDTreeNode(ANode.ChildNodes[iChild]); if not Assigned(ChildNode.StageRec) then Continue; fDeal := TotalPriceRoundTo(fDeal + ChildNode.StageRec.DealTotalPrice.AsFloat); fQc := TotalPriceRoundTo(fQc + ChildNode.StageRec.QcTotalPrice.AsFloat); fPc := TotalPriceRoundTo(fPc + ChildNode.StageRec.PcTotalPrice.AsFloat); end; with ANode.StageRec do begin DealTotalPrice.AsFloat := fDeal; QcTotalPrice.AsFloat := fQc; PcTotalPrice.AsFloat := fPc; GatherTotalPrice.AsFloat := TotalPriceRoundTo(fDeal + fQc + fPc); EndDealTotalPrice.AsFloat := TotalPriceRoundTo(PreDealTotalPrice.AsFloat + fDeal); EndQcTotalPrice.AsFloat := TotalPriceRoundTo(PreQcTotalPrice.AsFloat + fQc); EndPcTotalPrice.AsFloat := TotalPriceRoundTo(PrePcTotalPrice.AsFloat + fPc); EndGatherTotalPrice.AsFloat := TotalPriceRoundTo( PreGatherTotalPrice.AsFloat + GatherTotalPrice.AsFloat); end; end; procedure TStageData.CalculateLeaf(ANode: TBillsIDTreeNode); procedure CalculateMeasure(ARec: TsdDataRecord; const AType: string); begin if GetCalcType(ANode.ID) = 0 then begin if ARec.ValueByName(AType + 'Formula').AsString <> '' then ARec.ValueByName(AType + 'Quantity').AsFloat := EvaluateExprs(ARec.ValueByName(AType + 'Formula').AsString); ARec.ValueByName(AType + 'TotalPrice').AsFloat := TotalPriceRoundTo( ARec.ValueByName(AType + 'Quantity').AsFloat * GetBillsPrice(ANode.ID)); end; ARec.ValueByName('End' + AType + 'Quantity').AsFloat := QuantityRoundTo( ARec.ValueByName('Pre' + AType + 'Quantity').AsFloat + ARec.ValueByName(AType + 'Quantity').AsFloat); ARec.ValueByName('End' + AType + 'TotalPrice').AsFloat := TotalPriceRoundTo( ARec.ValueByName('Pre' + AType + 'TotalPrice').AsFloat + ARec.ValueByName(AType + 'TotalPrice').AsFloat); end; var Rec: TStageRecord; begin Rec := ANode.StageRec; if not Assigned(Rec) then Exit; CalculateMeasure(Rec, 'Deal'); CalculateMeasure(Rec, 'Pc'); CalculateMeasure(Rec, 'Qc'); Rec.GatherQuantity.AsFloat := QuantityRoundTo( Rec.DealQuantity.AsFloat + Rec.QcQuantity.AsFloat); Rec.GatherTotalPrice.AsFloat := TotalPriceRoundTo( Rec.DealTotalPrice.AsFloat + Rec.QcTotalPrice.AsFloat + Rec.PcTotalPrice.AsFloat); Rec.EndGatherQuantity.AsFloat := QuantityRoundTo( Rec.PreGatherQuantity.AsFloat + Rec.GatherQuantity.AsFloat); Rec.EndGatherTotalPrice.AsFloat := TotalPriceRoundTo( Rec.PreGatherTotalPrice.AsFloat + Rec.GatherTotalPrice.AsFloat); end; function TStageData.GetActive: Boolean; begin Result := sddStage.Active; end; procedure TStageData.SetTableName(const Value: string); begin sdpStage.TableName := Value; end; procedure TStageData.sddStageGetRecordClass( var ARecordClass: TsdRecordClass); begin ARecordClass := TStageRecord; end; function TStageData.GetChapterStageGather(AChapter: Integer): Double; function CheckCodeChapter(const ACode: string): Boolean; var iFirst: Integer; sgs: TStrings; begin sgs := TStringList.Create; try sgs.Delimiter := '-'; sgs.DelimitedText := ACode; if sgs.Count > 1 then begin iFirst := StrToIntDef(sgs[0], 0) div 100; Result := iFirst = AChapter; end else Result := False; finally sgs.Free; end; end; var iIndex: Integer; Rec: TsdDataRecord; stnNode: TsdIDTreeNode; begin Result := 0; for iIndex := 0 to sddStage.RecordCount - 1 do begin Rec := sddStage.Records[iIndex]; stnNode := MainBillsTree.FindNode(Rec.ValueByName('BillsID').AsInteger); if not stnNode.HasChildren and CheckCodeChapter(stnNode.Rec.ValueByName('B_Code').AsString) then Result := Result + Rec.ValueByName('GatherTotalPrice').AsFloat; end; end; function TStageData.GetCalcType(ABillsID: Integer): Integer; begin Result := MainBillsTree.FindNode(ABillsID).Rec.ValueByName('CalcType').AsInteger; end; end.