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 UpdateParentRecord(ABillsID: Integer; ATotalPrice: Double; const AFieldName: string); procedure UpdateComplete(ABillsID: Integer; AQuantity, ATotalPrice: Double); function HasPriceMarginBills: Boolean; // 向父项增量--PM_TotalPrice procedure UpdateParentPriceMargin(ABillsID: Integer; ADiffer: Double); // 向价差调整节点增量--GatherTotalPrice procedure UpdatePriceMarginNode(ADiffer: Double); // 重新计算相关的项目工料的价差数据 procedure UpdateProjectGL(ABillsID: Integer); procedure CalculateDeal(ABillsID: Integer); procedure CalculateQuantityChange(ABillsID: Integer); procedure CalculatePriceChange(ABillsID: Integer); procedure CalculateGather(ABillsID: Integer); procedure CalculateParent(ANode: TMeasureBillsIDTreeNode); procedure CalculateLeaf(ANode: TMeasureBillsIDTreeNode); procedure CalculateSpecialLeaf(ANode: TMeasureBillsIDTreeNode); function GetTotalPrice(ABillsID, AType, AStageIndex: Integer): Double; function GetCalcType(ABillsID: Integer): Integer; function GetBillsUnitPriceMargin(ABillsID: Integer): Double; 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; function GetPriceMargin(AType, AIndex: Integer): Double; public constructor Create(APhaseData: TObject); destructor Destroy; override; procedure Open(AConnection: TADOConnection); procedure Save; procedure BeforeBatchOperation; procedure AfterBatchOperation; // 计算任一清单节点的价差金额,并增量汇总至父项 procedure CalculatePriceMargin(ABillsID: Integer); // 计算材料调差节点 procedure CalculatePriceMarginNode; 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; // 查找,如未找到则新增 function StageRecordWithAdd(ABillsID: Integer): TStageRecord; // 将Bills表中存的累计计量数据拷贝至截止本期计量、截止上期计量,除新增一期计量外不可调用 procedure CopyPrePhaseData; property Active: Boolean read GetActive; property TableName: string Write SetTableName; property MainBillsTree: TBillsIDTree read GetMainBillsTree; property PhaseData: TObject read FPhaseData; {可选计算数} // 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; // 价差 property PriceMargin[AType, AIndex: Integer]: Double read GetPriceMargin; // 100/200/.../900章本期完成计量 property ChapterStageGather[AChapter: Integer]: Double read GetChapterStageGather; end; implementation uses ProjectData, BillsDm, PhaseData, Math, BGLDm, BillsMeasureDm, UtilMethods, ConditionalDefines, FormulaCalc, DetailGLDm, ConstUnit, ProjectGLDm; {$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); CalculatePriceMargin(ABillsID); if ABillsID = iPriceMarginID then CalculateGather(ABillsID); 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); CalculatePriceMargin(ABillsID); if ABillsID = iPriceMarginID then CalculateGather(ABillsID); 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); function LeafCurHasMeasure(ANode: TMeasureBillsIDTreeNode): Boolean; begin Result := Assigned(ANode.StageRec) and ((ANode.StageRec.DealQuantity.AsFloat <> 0) or (ANode.StageRec.DealTotalPrice.AsFloat <> 0) or (ANode.StageRec.QcQuantity.AsFloat <> 0) or (ANode.StageRec.QcTotalPrice.AsFloat <> 0) or (ANode.StageRec.PcQuantity.AsFloat <> 0) or (ANode.StageRec.PcTotalPrice.AsFloat <> 0)); end; function ParentCurHasMeasure(ANode: TBillsIDTreeNode): Boolean; var i: Integer; vChild: TBillsIDTreeNode; begin Result := False; for i := 0 to ANode.ChildCount - 1 do begin vChild := TMeasureBillsIDTreeNode(ANode.ChildNodes[i]); if vChild.Rec.CurHasMeasure.AsBoolean then begin Result := True; Break; end; end; end; procedure RecalcNodeCurHasMeasure(ANode: TBillsIDTreeNode); begin if not Assigned(ANode) then Exit; if ANode.HasChildren then ANode.Rec.CurHasMeasure.AsBoolean := ParentCurHasMeasure(ANode) else ANode.Rec.CurHasMeasure.AsBoolean := LeafCurHasMeasure(TMeasureBillsIDTreeNode(ANode)); RecalcNodeCurHasMeasure(TBillsIDTreeNode(ANode.Parent)); end; 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(iBillsID); if (AValue.FieldName = 'QcQuantity') or (AValue.FieldName = 'QcFormula') or (AValue.FieldName = 'QcTotalPrice') then CalculateQuantityChange(iBillsID); if (AValue.FieldName = 'PcQuantity') or (AValue.FieldName = 'PcFormula') or (AValue.FieldName = 'PcTotalPrice') then CalculatePriceChange(iBillsID); if (AValue.FieldName = 'DealQuantity') or (AValue.FieldName = 'QcQuantity') then UpdateProjectGL(iBillsID); RecalcNodeCurHasMeasure(TBillsIDTreeNode(stnNode)); 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: TStageRecord; begin if ABillsID = -1 then Exit; Rec := StageRecord(ABillsID); Rec.GatherQuantity.AsFloat := QuantityRoundTo(Rec.GatherQuantity.AsFloat + AQuantity); Rec.GatherTotalPrice.AsFloat := TotalPriceRoundTo(Rec.GatherTotalPrice.AsFloat + ATotalPrice); Rec.EndGatherQuantity.AsFloat := QuantityRoundTo(Rec.EndGatherQuantity.AsFloat + AQuantity); Rec.EndGatherTotalPrice.AsFloat := TotalPriceRoundTo(Rec.EndGatherTotalPrice.AsFloat + ATotalPrice); // 数量不向上汇总 UpdateParentRecord(ABillsID, ATotalPrice, 'GatherTotalPrice'); end; procedure TStageData.UpdateParentRecord(ABillsID: Integer; ATotalPrice: Double; const AFieldName: string); var vNode: TMeasureBillsIDTreeNode; iParentID: Integer; Rec: TsdDataRecord; begin iParentID := MainBillsTree.FindNode(ABillsID).ParentID; if iParentID = -1 then Exit; vNode := TMeasureBillsIDTreeNode(MainBillsTree.FindNode(iParentID)); Rec := StageRecordWithAdd(iParentID); vNode.StageRec := TStageRecord(Rec); 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: TBillsRecord; NewRec: TStageRecord; begin BeforeBatchOperation; try with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsData do for iRecord := 0 to sddBills.RecordCount - 1 do begin Rec := TBillsRecord(sddBills.Records[iRecord]); if (Rec.AddGatherTotalPrice.AsFloat = 0) and (Rec.AddDealTotalPrice.AsFloat = 0) and (Rec.AddQcTotalPrice.AsFloat = 0) and (Rec.AddPcTotalPrice.AsFloat = 0) and (Rec.PM_AddTotalPrice.AsFloat = 0) then Continue; NewRec := TStageRecord(sddStage.Add); NewRec.BillsID.AsInteger := Rec.ID.AsInteger; NewRec.EndDealQuantity.AsFloat := Rec.AddDealQuantity.AsFloat; NewRec.EndDealTotalPrice.AsFloat := Rec.AddDealTotalPrice.AsFloat; NewRec.EndQcQuantity.AsFloat := Rec.AddQcQuantity.AsFloat; NewRec.EndQcTotalPrice.AsFloat := Rec.AddQcTotalPrice.AsFloat; NewRec.EndQcBGLCode.AsString := Rec.AddQcBGLCode.AsString; NewRec.EndQcBGLNum.AsString := Rec.AddQcBGLNum.AsString; NewRec.EndPcQuantity.AsFloat := Rec.AddPcQuantity.AsFloat; NewRec.EndPcTotalPrice.AsFloat := Rec.AddPcTotalPrice.AsFloat; NewRec.EndPcBGLCode.AsString := Rec.AddPcBGLCode.AsString; NewRec.EndPcBGLNum.AsString := Rec.AddPcBGLNum.AsString; NewRec.EndGatherQuantity.AsFloat := Rec.AddGatherQuantity.AsFloat; NewRec.EndGatherTotalPrice.AsFloat := Rec.AddGatherTotalPrice.AsFloat; NewRec.PreDealQuantity.AsFloat := Rec.AddDealQuantity.AsFloat; NewRec.PreDealTotalPrice.AsFloat := Rec.AddDealTotalPrice.AsFloat; NewRec.PreQcQuantity.AsFloat := Rec.AddQcQuantity.AsFloat; NewRec.PreQcTotalPrice.AsFloat := Rec.AddQcTotalPrice.AsFloat; NewRec.PreQcBGLCode.AsString := Rec.AddQcBGLCode.AsString; NewRec.PreQcBGLNum.AsString := Rec.AddQcBGLNum.AsString; NewRec.PrePcQuantity.AsFloat := Rec.AddPcQuantity.AsFloat; NewRec.PrePcTotalPrice.AsFloat := Rec.AddPcTotalPrice.AsFloat; NewRec.PrePcBGLCode.AsString := Rec.AddPcBGLCode.AsString; NewRec.PrePcBGLNum.AsString := Rec.AddPcBGLNum.AsString; NewRec.PreGatherQuantity.AsFloat := Rec.AddGatherQuantity.AsFloat; NewRec.PreGatherTotalPrice.AsFloat := Rec.AddGatherTotalPrice.AsFloat; NewRec.PM_PreTotalPrice.AsFloat := Rec.PM_AddTotalPrice.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); function IsSpecialNode: Boolean; begin //Result := ANode.ID = iPriceMarginID; Result := False; end; begin if not Assigned(ANode) then Exit; if ANode.HasChildren then begin CalculateNode(ANode.FirstChild); CalculateParent(TMeasureBillsIDTreeNode(ANode)); end else begin if IsSpecialNode then CalculateSpecialLeaf(TMeasureBillsIDTreeNode(ANode)) else CalculateLeaf(TMeasureBillsIDTreeNode(ANode)); end; CalculateNode(ANode.NextSibling); end; procedure TStageData.CalculateParent(ANode: TMeasureBillsIDTreeNode); var iChild: Integer; ChildNode: TMeasureBillsIDTreeNode; fDeal, fQc, fPc, fTotal, fPM: Double; begin if not Assigned(ANode.StageRec) then ANode.StageRec := AddStageRecord(ANode.ID); fDeal := 0; fQc := 0; fPc := 0; fPM := 0; for iChild := 0 to ANode.ChildCount - 1 do begin ChildNode := TMeasureBillsIDTreeNode(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); fPM := TotalPriceRoundTo(fPM + ChildNode.StageRec.PM_TotalPrice.AsFloat); end; fTotal := TotalPriceRoundTo(fDeal + fQc + fPc); with ANode.StageRec do begin if DealTotalPrice.AsFloat <> fDeal then begin DealTotalPrice.AsFloat := fDeal; EndDealTotalPrice.AsFloat := TotalPriceRoundTo(PreDealTotalPrice.AsFloat + fDeal); end; if QcTotalPrice.AsFloat <> fQc then begin QcTotalPrice.AsFloat := fQc; EndQcTotalPrice.AsFloat := TotalPriceRoundTo(PreQcTotalPrice.AsFloat + fQc); end; if PcTotalPrice.AsFloat <> fPc then begin PcTotalPrice.AsFloat := fPc; EndPcTotalPrice.AsFloat := TotalPriceRoundTo(PrePcTotalPrice.AsFloat + fPc); end; if GatherTotalPrice.AsFloat <> fTotal then begin GatherTotalPrice.AsFloat := fTotal; EndGatherTotalPrice.AsFloat := TotalPriceRoundTo(PreGatherTotalPrice.AsFloat + fTotal); end; if PM_TotalPrice.AsFloat <> fPM then PM_TotalPrice.AsFloat := fPM; end; end; procedure TStageData.CalculateLeaf(ANode: TMeasureBillsIDTreeNode); 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; procedure CalculatePriceMargin(ARec: TStageRecord); var fPrice: Double; begin fPrice := GetBillsUnitPriceMargin(ARec.BillsID.AsInteger); ARec.SetFloatValue(ARec.PM_TotalPrice, TotalPriceRoundTo(ARec.GatherQuantity.AsFloat * fPrice)); 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); CalculatePriceMargin(Rec); 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; procedure TStageData.CalculatePriceMarginNode; var Rec: TStageRecord; fDiffer: Double; begin if not HasPriceMarginBills then Exit; with TProjectData(TPhaseData(FPhaseData).ProjectData) do begin Rec := StageRecord(iPriceMarginID); if not Assigned(Rec) then Rec := AddStageRecord(iPriceMarginID); fDiffer := TotalPriceRoundTo(ProjectGLData.PM_TotalPrice - Rec.GatherTotalPrice.AsFloat); if fDiffer <> 0 then begin Rec.AddDifferValue(Rec.GatherTotalPrice, fDiffer); Rec.AddDifferValue(Rec.EndGatherTotalPrice, fDiffer); UpdateParentRecord(Rec.BillsID.AsInteger, fDiffer, 'GatherTotalPrice'); end; end; end; function TStageData.GetBillsUnitPriceMargin(ABillsID: Integer): Double; var vGLs: TList; iGL: Integer; GLRec: TDetailGLRecord; begin Result := 0; vGLs := TList.Create; try with TProjectData(TPhaseData(FPhaseData).ProjectData).DetailGLData do LoadDetailGLs(ABillsID, vGLs); for iGL := 0 to vGLs.Count - 1 do begin GLRec := TDetailGLRecord(vGLs.Items[iGL]); Result := Result + GLRec.Quantity.AsFloat * GLRec.RelaProjectGL.ValidDeltaPrice.AsFloat; end; finally vGLs.Free; end; end; procedure TStageData.CalculatePriceMargin(ABillsID: Integer); var Rec: TStageRecord; fPM, fPMDiffer: Double; begin //if not HasPriceMarginBills then Exit; Rec := StageRecord(ABillsID); if not Assigned(Rec) then Exit; fPM := TotalPriceRoundTo(Rec.GatherQuantity.AsFloat * GetBillsUnitPriceMargin(ABillsID)); if fPM <> Rec.PM_TotalPrice.AsFloat then begin fPMDiffer := fPM - Rec.PM_TotalPrice.AsFloat; Rec.PM_TotalPrice.AsFloat := fPM; UpdateParentPriceMargin(ABillsID, fPMDiffer); //UpdatePriceMarginNode(fPMDiffer); with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do UpdateRecordPM(ABillsID, fPMDiffer); end; end; procedure TStageData.UpdatePriceMarginNode(ADiffer: Double); var Rec: TStageRecord; begin Rec := StageRecordWithAdd(iPriceMarginID); Rec.AddDifferValue(Rec.GatherTotalPrice, ADiffer); Rec.AddDifferValue(Rec.EndGatherTotalPrice, ADiffer); UpdateParentRecord(iPriceMarginID, ADiffer, 'GatherTotalPrice'); with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do UpdateGather(Rec.BillsID.AsInteger, ADiffer); end; procedure TStageData.UpdateParentPriceMargin(ABillsID: Integer; ADiffer: Double); var iParentID: Integer; Rec: TStageRecord; begin iParentID := MainBillsTree.FindNode(ABillsID).ParentID; if iParentID = -1 then Exit; Rec := StageRecordWithAdd(iParentID); Rec.PM_TotalPrice.AsFloat := TotalPriceRoundTo(Rec.PM_TotalPrice.AsFloat + ADiffer); UpdateParentPriceMargin(iParentID, ADiffer); end; function TStageData.StageRecordWithAdd(ABillsID: Integer): TStageRecord; begin Result := StageRecord(ABillsID); if not Assigned(Result) then Result := AddStageRecord(ABillsID); end; procedure TStageData.UpdateProjectGL(ABillsID: Integer); var vGLs: TList; iGL: Integer; GLRec: TDetailGLRecord; begin vGLs := TList.Create; try with TProjectData(TPhaseData(FPhaseData).ProjectData) do begin DetailGLData.LoadDetailGLs(ABillsID, vGLs); ProjectGLData.CalculateGLs_PM(vGLs); ProjectGLData.RefreshGatherData; end; finally vGLs.Free; end; end; procedure TStageData.CalculateSpecialLeaf(ANode: TMeasureBillsIDTreeNode); procedure GatherPriceMargin(ARec: TStageRecord); begin with TProjectData(TPhaseData(FPhaseData).ProjectData).ProjectGLData do ARec.SetFloatValue(ARec.GatherTotalPrice, PM_TotalPrice); ARec.SetFloatValue(ARec.EndGatherTotalPrice, ARec.PreGatherTotalPrice.AsFloat + ARec.GatherTotalPrice.AsFloat); end; var StageRec: TStageRecord; begin StageRec := ANode.StageRec; if not Assigned(StageRec) then Exit; case ANode.ID of iPriceMarginID: GatherPriceMargin(StageRec); end; end; function TStageData.HasPriceMarginBills: Boolean; var vPM_Node: TsdIDTreeNode; begin vPM_Node := MainBillsTree.FindNode(iPriceMarginID); Result := Assigned(vPM_Node); end; procedure TStageData.CalculateGather(ABillsID: Integer); var Rec: TStageRecord; fQuantity, fTotalPrice: Double; begin Rec := TStageRecord(sddStage.FindKey('idxBID', ABillsID)); if not Assigned(Rec) then Exit; fQuantity := QuantityRoundTo(Rec.DealQuantity.AsFloat + Rec.QcQuantity.AsFloat) - Rec.GatherQuantity.AsFloat; fTotalPrice := TotalPriceRoundTo( Rec.DealTotalPrice.AsFloat + Rec.QcTotalPrice.AsFloat + Rec.PcTotalPrice.AsFloat) - Rec.GatherTotalPrice.AsFloat; UpdateComplete(ABillsID, fQuantity, fTotalPrice); end; function TStageData.GetPriceMargin(AType, AIndex: Integer): Double; begin Result := GetTotalPrice(iPriceMarginID, AType, AIndex); end; end.