123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755 |
- 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.
|