StageDm.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748
  1. unit StageDm;
  2. // 原报、审核数据通用
  3. // 原报 - Refer
  4. // 审核 - Audit1, Audit2 ...
  5. interface
  6. uses
  7. mDataRecord, BillsTree,
  8. SysUtils, Classes, sdDB, sdProvider, ADODB, ZhAPI, sdIDTree;
  9. type
  10. TStageData = class(TDataModule)
  11. sdpStage: TsdADOProvider;
  12. sddStage: TsdDataSet;
  13. procedure sddStageAfterValueChanged(AValue: TsdValue);
  14. procedure sddStageBeforeValueChange(AValue: TsdValue;
  15. const NewValue: Variant; var Allow: Boolean);
  16. procedure sddStageGetRecordClass(var ARecordClass: TsdRecordClass);
  17. private
  18. FPhaseData: TObject;
  19. FIndex: Integer;
  20. FBeforeChangeQuantity: Double;
  21. FBeforeChangeTotalPrice: Double;
  22. procedure BeforeBatchOperation;
  23. procedure AfterBatchOperation;
  24. procedure UpdateParentRecord(ABillsID: Integer; ATotalPrice: Double; const AFieldName: string);
  25. procedure UpdateComplete(ABillsID: Integer; AQuantity, ATotalPrice: Double);
  26. procedure CalculateDeal(ABillsID: Integer);
  27. procedure CalculateQuantityChange(ABillsID: Integer);
  28. procedure CalculatePriceChange(ABillsID: Integer);
  29. procedure CalculateParent(ANode: TBillsIDTreeNode);
  30. procedure CalculateLeaf(ANode: TBillsIDTreeNode);
  31. function GetTotalPrice(ABillsID, AType, AStageIndex: Integer): Double;
  32. function GetBillsPrice(ABillsID: Integer): Double;
  33. function GetBillsNewPrice(ABillsID: Integer): Double;
  34. function GetBillsPriceDiffer(ABillsID: Integer): Double;
  35. function GetMainBillsTree: TBillsIDTree;
  36. function GetBuildLoadInterest(AType, AIndex: Integer): Double;
  37. function GetFirstPart(AType, AIndex: Integer): Double;
  38. function GetOtherFee(AType, AIndex: Integer): Double;
  39. function GetOtherProjectFee(AType, AIndex: Integer): Double;
  40. function GetRecyclingFee(AType, AIndex: Integer): Double;
  41. function GetReservedFee(AType, AIndex: Integer): Double;
  42. function GetSecondPart(AType, AIndex: Integer): Double;
  43. function GetStageSettlement(AType, AIndex: Integer): Double;
  44. function GetThirdPart(AType, AIndex: Integer): Double;
  45. function GetActive: Boolean;
  46. procedure SetTableName(const Value: string);
  47. function GetChapterStageGather(AChapter: Integer): Double;
  48. public
  49. constructor Create(APhaseData: TObject);
  50. destructor Destroy; override;
  51. procedure Open(AConnection: TADOConnection);
  52. procedure Save;
  53. procedure CalculateNode(ANode: TsdIDTreeNode);
  54. procedure CalculateAll;
  55. function AddPhaseData(ABillsID: Integer;
  56. const AField, ANewValue: string): Boolean;
  57. function AddStageRecord(ABillsID: Integer): TStageRecord;
  58. procedure DeletePhaseRecord(ABillsID: Integer);
  59. procedure ReCalculate(ABillsID: Integer);
  60. procedure UpdateBGLInfo(ARec: TsdDataRecord; const AType: string);
  61. function StageRecord(ABillsID: Integer): TStageRecord;
  62. // 将Bills表中存的累计计量数据拷贝至截止本期计量、截止上期计量,除新增一期计量外不可调用
  63. procedure CopyPrePhaseData;
  64. property Active: Boolean read GetActive;
  65. property TableName: string Write SetTableName;
  66. property MainBillsTree: TBillsIDTree read GetMainBillsTree;
  67. {可选计算数}
  68. // AType表示不同类型,取值如下:
  69. // 1: 本期数据 2: 截止本期数据 3: 截止上期数据
  70. // AIndex表示AType下不同数据类型,取值如下:
  71. // 1: 合同计量 2: 数量变更计量 3: 单价变更计量 4: 完成计量
  72. // 第一部分
  73. property FirstPart[AType, AIndex: Integer]: Double read GetFirstPart;
  74. // 第二部分
  75. property SecondPart[AType, AIndex: Integer]: Double read GetSecondPart;
  76. // 第三部分
  77. property ThirdPart[AType, AIndex: Integer]: Double read GetThirdPart;
  78. // 预留费用
  79. property ReservedFee[AType, AIndex: Integer]: Double read GetReservedFee;
  80. // 其他费用项目
  81. property OtherFee[AType, AIndex: Integer]: Double read GetOtherFee;
  82. // 建设期贷款利息
  83. property BuildLoadInterest[AType, AIndex: Integer]: Double read GetBuildLoadInterest;
  84. // 回收金额
  85. property RecyclingFee[AType, AIndex: Integer]: Double read GetRecyclingFee;
  86. // 公路工程以外的工程费用
  87. property OtherProjectFee[AType, AIndex: Integer]: Double read GetOtherProjectFee;
  88. // 本期结算价
  89. property StageSettlement[AType, AIndex: Integer]: Double read GetStageSettlement;
  90. // 100/200/.../900章本期完成计量
  91. property ChapterStageGather[AChapter: Integer]: Double read GetChapterStageGather;
  92. end;
  93. implementation
  94. uses
  95. ProjectData, BillsDm, PhaseData, Math, BGLDm, BillsMeasureDm,
  96. UtilMethods, ConditionalDefines, FormulaCalc;
  97. {$R *.dfm}
  98. { TPhaseData }
  99. function TStageData.AddPhaseData(ABillsID: Integer;
  100. const AField, ANewValue: string): Boolean;
  101. procedure SetPhaseRecord(ARec: TsdDataRecord; const AField, AValue: string);
  102. begin
  103. if CheckNumeric(ANewValue) then
  104. ARec.ValueByName(AField).AsString := AValue
  105. else
  106. begin
  107. ARec.ValueByName(AField).AsFloat := EvaluateExprs(AValue);
  108. ARec.ValueByName(StringReplace(AField, 'Quantity', 'Flag', [])).AsInteger := 1;
  109. ARec.ValueByName(StringReplace(AField, 'Quantity', 'Formula', [])).AsString := AValue;
  110. end;
  111. end;
  112. var
  113. Rec: TsdDataRecord;
  114. begin
  115. if Assigned(sddStage.FindKey('idxBID', ABillsID)) then Exit;
  116. Rec := sddStage.Add;
  117. Rec.ValueByName('BillsID').AsInteger := ABillsID;
  118. SetPhaseRecord(Rec, AField, ANewValue);
  119. end;
  120. function TStageData.AddStageRecord(ABillsID: Integer): TStageRecord;
  121. begin
  122. Result := TStageRecord(sddStage.FindKey('idxBID', ABillsID));
  123. if Assigned(Result) then Exit;
  124. Result := TStageRecord(sddStage.Add(True));
  125. try
  126. Result.ValueByName('BillsID').AsInteger := ABillsID;
  127. finally
  128. Result.EndUpdate;
  129. end;
  130. end;
  131. procedure TStageData.CalculateDeal(ABillsID: Integer);
  132. var
  133. Rec: TsdDataRecord;
  134. fQtyDiffer, fTPDiffer: Double;
  135. begin
  136. Rec := sddStage.FindKey('idxBID', ABillsID);
  137. if Rec.ValueByName('DealFlag').AsInteger < 2 then
  138. Rec.ValueByName('DealTotalPrice').AsFloat :=
  139. TotalPriceRoundTo(Rec.ValueByName('DealQuantity').AsFloat * GetBillsPrice(ABillsID));
  140. fQtyDiffer := Rec.ValueByName('DealQuantity').AsFloat - FBeforeChangeQuantity;
  141. fTPDiffer := Rec.ValueByName('DealTotalPrice').AsFloat - FBeforeChangeTotalPrice;
  142. Rec.ValueByName('EndDealQuantity').AsFloat := QuantityRoundTo(
  143. Rec.ValueByName('EndDealQuantity').AsFloat + fQtyDiffer);
  144. Rec.ValueByName('EndDealTotalPrice').AsFloat := TotalPriceRoundTo(
  145. Rec.ValueByName('EndDealTotalPrice').AsFloat + fTPDiffer);
  146. UpdateParentRecord(ABillsID, fTPDiffer, 'DealTotalPrice');
  147. UpdateComplete(ABillsID, fQtyDiffer, fTPDiffer);
  148. if TPhaseData(FPhaseData).IsLastStage then
  149. with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do
  150. UpdateRecordDeal(ABillsID, fQtyDiffer, fTPDiffer);
  151. TPhaseData(FPhaseData).PhasePayData.CalculateAll;
  152. end;
  153. procedure TStageData.CalculatePriceChange(ABillsID: Integer);
  154. var
  155. Rec: TsdDataRecord;
  156. fQtyDiffer, fTPDiffer: Double;
  157. begin
  158. Rec := sddStage.FindKey('idxBID', ABillsID);
  159. if Rec.ValueByName('PcFlag').AsInteger < 2 then
  160. Rec.ValueByName('PcTotalPrice').AsFloat :=
  161. TotalPriceRoundTo(Rec.ValueByName('PcQuantity').AsFloat * GetBillsPriceDiffer(ABillsID));
  162. fQtyDiffer := Rec.ValueByName('PcQuantity').AsFloat - FBeforeChangeQuantity;
  163. fTPDiffer := Rec.ValueByName('PcTotalPrice').AsFloat - FBeforeChangeTotalPrice;
  164. Rec.ValueByName('EndPcQuantity').AsFloat := QuantityRoundTo(
  165. Rec.ValueByName('EndPcQuantity').AsFloat + fQtyDiffer);
  166. Rec.ValueByName('EndPcTotalPrice').AsFloat := TotalPriceRoundTo(
  167. Rec.ValueByName('EndPcTotalPrice').AsFloat + fTPDiffer);
  168. UpdateParentRecord(ABillsID, fTPDiffer, 'PcTotalPrice');
  169. UpdateComplete(ABillsID, 0, fTPDiffer);
  170. if TPhaseData(FPhaseData).IsLastStage then
  171. with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do
  172. UpdateRecordPc(ABillsID, fQtyDiffer, fTPDiffer);
  173. TPhaseData(FPhaseData).PhasePayData.CalculateAll;
  174. end;
  175. procedure TStageData.CalculateQuantityChange(ABillsID: Integer);
  176. var
  177. Rec: TsdDataRecord;
  178. fQtyDiffer, fTPDiffer: Double;
  179. begin
  180. Rec := sddStage.FindKey('idxBID', ABillsID);
  181. if Rec.ValueByName('QcFlag').AsInteger < 2 then
  182. Rec.ValueByName('QcTotalPrice').AsFloat :=
  183. TotalPriceRoundTo(Rec.ValueByName('QcQuantity').AsFloat * GetBillsPrice(ABillsID));
  184. fQtyDiffer := Rec.ValueByName('QcQuantity').AsFloat - FBeforeChangeQuantity;
  185. fTPDiffer := Rec.ValueByName('QcTotalPrice').AsFloat - FBeforeChangeTotalPrice;
  186. Rec.ValueByName('EndQcQuantity').AsFloat := QuantityRoundTo(
  187. Rec.ValueByName('EndQcQuantity').AsFloat + fQtyDiffer);
  188. Rec.ValueByName('EndQcTotalPrice').AsFloat := TotalPriceRoundTo(
  189. Rec.ValueByName('EndQcTotalPrice').AsFloat + fTPDiffer);
  190. UpdateParentRecord(ABillsID, fTPDiffer, 'QcTotalPrice');
  191. UpdateComplete(ABillsID, fQtyDiffer, fTPDiffer);
  192. if TPhaseData(FPhaseData).IsLastStage then
  193. with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do
  194. UpdateRecordQc(ABillsID, fQtyDiffer, fTPDiffer);
  195. TPhaseData(FPhaseData).PhasePayData.CalculateAll;
  196. end;
  197. constructor TStageData.Create(APhaseData: TObject);
  198. begin
  199. inherited Create(nil);
  200. FPhaseData := APhaseData;
  201. end;
  202. procedure TStageData.DeletePhaseRecord(ABillsID: Integer);
  203. var
  204. Rec: TsdDataRecord;
  205. begin
  206. Rec := sddStage.FindKey('idxBID', ABillsID);
  207. if Assigned(Rec) then
  208. sddStage.Remove(Rec);
  209. end;
  210. destructor TStageData.Destroy;
  211. begin
  212. inherited;
  213. end;
  214. function TStageData.GetBillsNewPrice(ABillsID: Integer): Double;
  215. begin
  216. Result := MainBillsTree.FindNode(ABillsID).Rec.ValueByName('NewPrice').AsFloat;
  217. end;
  218. function TStageData.GetBillsPrice(ABillsID: Integer): Double;
  219. begin
  220. Result := MainBillsTree.FindNode(ABillsID).Rec.ValueByName('Price').AsFloat;
  221. end;
  222. procedure TStageData.Open(AConnection: TADOConnection);
  223. begin
  224. sdpStage.Connection := AConnection;
  225. sddStage.Open;
  226. if not Assigned(sddStage.IndexList.FindByName('idxBID')) then
  227. sddStage.AddIndex('idxBID', 'BillsID');
  228. sddStage.FieldByName('DealQuantity').ValidChars := sddStage.FieldByName('DealQuantity').ValidChars + ArithmeticCharSet;
  229. end;
  230. function TStageData.StageRecord(ABillsID: Integer): TStageRecord;
  231. begin
  232. Result := nil;
  233. if Assigned(sddStage.IndexList.FindByName('idxBID')) then
  234. Result := TStageRecord(sddStage.FindKey('idxBID', ABillsID));
  235. end;
  236. procedure TStageData.ReCalculate(ABillsID: Integer);
  237. var
  238. Rec: TsdDataRecord;
  239. fDiffer: Double;
  240. begin
  241. Rec := sddStage.FindKey('idxBID', ABillsID);
  242. if not Assigned(Rec) then Exit;
  243. if Rec.ValueByName('DealFlag').AsInteger = 1 then
  244. Rec.ValueByName('DealQuantity').AsFloat := QuantityRoundTo(
  245. EvaluateExprs(Rec.ValueByName('DealFormula').AsString));
  246. if Rec.ValueByName('DealFlag').AsInteger < 2 then
  247. begin
  248. fDiffer := Rec.ValueByName('DealQuantity').AsFloat * GetBillsPrice(ABillsID)
  249. - Rec.ValueByName('DealTotalPrice').AsFloat;
  250. Rec.ValueByName('DealTotalPrice').AsFloat := TotalPriceRoundTo(
  251. Rec.ValueByName('DealQuantity').AsFloat * GetBillsPrice(ABillsID));
  252. end;
  253. Rec.ValueByName('EndDealQuantity').AsFloat := QuantityRoundTo(
  254. Rec.ValueByName('PreDealQuantity').AsFloat + Rec.ValueByName('DealQuantity').AsFloat);
  255. Rec.ValueByName('EndDealTotalPrice').AsFloat := TotalPriceRoundTo(
  256. Rec.ValueByName('PreDealTotalPrice').AsFloat + Rec.ValueByName('DealTotalPrice').AsFloat);
  257. if Rec.ValueByName('QcFlag').AsInteger = 1 then
  258. Rec.ValueByName('QcQuantity').AsFloat := QuantityRoundTo(
  259. EvaluateExprs(Rec.ValueByName('QcFormula').AsString));
  260. if Rec.ValueByName('QcFlag').AsInteger < 2 then
  261. begin
  262. fDiffer := Rec.ValueByName('QcQuantity').AsFloat * GetBillsPrice(ABillsID)
  263. - Rec.ValueByName('QcTotalPrice').AsFloat;
  264. Rec.ValueByName('QcTotalPrice').AsFloat := TotalPriceRoundTo(
  265. Rec.ValueByName('QcQuantity').AsFloat * GetBillsPrice(ABillsID));
  266. end;
  267. Rec.ValueByName('EndQcQuantity').AsFloat := QuantityRoundTo(
  268. Rec.ValueByName('PreQcQuantity').AsFloat + Rec.ValueByName('QcQuantity').AsFloat);
  269. Rec.ValueByName('EndQcTotalPrice').AsFloat := TotalPriceRoundTo(
  270. Rec.ValueByName('PreQcTotalPrice').AsFloat + Rec.ValueByName('QcTotalPrice').AsFloat);
  271. if Rec.ValueByName('PcFlag').AsInteger = 1 then
  272. Rec.ValueByName('PcQuantity').AsFloat := QuantityRoundTo(
  273. EvaluateExprs(Rec.ValueByName('PcFormula').AsString));
  274. if Rec.ValueByName('DealFlag').AsInteger < 2 then
  275. begin
  276. fDiffer := Rec.ValueByName('PcQuantity').AsFloat * GetBillsNewPrice(ABillsID)
  277. - Rec.ValueByName('PcTotalPrice').AsFloat;
  278. Rec.ValueByName('PcTotalPrice').AsFloat := TotalPriceRoundTo(
  279. Rec.ValueByName('PcQuantity').AsFloat * GetBillsNewPrice(ABillsID));
  280. end;
  281. Rec.ValueByName('EndPcQuantity').AsFloat := QuantityRoundTo(
  282. Rec.ValueByName('PrePcQuantity').AsFloat + Rec.ValueByName('PcQuantity').AsFloat);
  283. Rec.ValueByName('EndPcTotalPrice').AsFloat := TotalPriceRoundTo(
  284. Rec.ValueByName('PrePcTotalPrice').AsFloat + Rec.ValueByName('PcTotalPrice').AsFloat);
  285. end;
  286. procedure TStageData.Save;
  287. begin
  288. sddStage.Save;
  289. end;
  290. procedure TStageData.sddStageAfterValueChanged(AValue: TsdValue);
  291. var
  292. iBillsID: Integer;
  293. stnNode: TsdIDTreeNode;
  294. begin
  295. iBillsID := AValue.Owner.ValueByName('BillsID').AsInteger;
  296. stnNode := MainBillsTree.FindNode(iBillsID);
  297. if not Assigned(stnNode) or stnNode.HasChildren then Exit;
  298. if (AValue.FieldName = 'DealQuantity') or
  299. (AValue.FieldName = 'DealFormula') or
  300. (AValue.FieldName = 'DealTotalPrice') then
  301. CalculateDeal(AValue.Owner.ValueByName('BillsID').AsInteger);
  302. if (AValue.FieldName = 'QcQuantity') or
  303. (AValue.FieldName = 'QcFormula') or
  304. (AValue.FieldName = 'QcTotalPrice') then
  305. CalculateQuantityChange(AValue.Owner.ValueByName('BillsID').AsInteger);
  306. if (AValue.FieldName = 'PcQuantity') or
  307. (AValue.FieldName = 'PcFormula') or
  308. (AValue.FieldName = 'PcTotalPrice') then
  309. CalculatePriceChange(AValue.Owner.ValueByName('BillsID').AsInteger);
  310. end;
  311. function TStageData.GetMainBillsTree: TBillsIDTree;
  312. begin
  313. with TProjectData(TPhaseData(FPhaseData).ProjectData) do
  314. Result := BillsMeasureData.BillsMeasureTree;
  315. end;
  316. procedure TStageData.sddStageBeforeValueChange(AValue: TsdValue;
  317. const NewValue: Variant; var Allow: Boolean);
  318. procedure SetBeforeChangeValue(const AType: string);
  319. begin
  320. if SameText(AValue.FieldName, AType + 'Quantity') or
  321. SameText(AValue.FieldName, AType + 'Formula') or
  322. SameText(AValue.FieldName, AType + 'TotalPrice') then
  323. begin
  324. FBeforeChangeQuantity := AValue.Owner.ValueByName(AType + 'Quantity').AsFloat;
  325. FBeforeChangeTotalPrice := AValue.Owner.ValueByName(AType + 'TotalPrice').AsFloat;
  326. end;
  327. end;
  328. procedure CheckOverRange;
  329. var
  330. vNode: TsdIDTreeNode;
  331. fAvailableQty: Double;
  332. begin
  333. if SameText(AValue.FieldName, 'DealQuantity') then
  334. begin
  335. vNode := MainBillsTree.FindNode(AValue.Owner.ValueByName('BillsID').AsInteger);
  336. fAvailableQty := vNode.Rec.ValueByName('Quantity').AsFloat
  337. - vNode.Rec.ValueByName('AddDealQuantity').AsFloat + AValue.AsFloat;
  338. if VarToFloatDef(NewValue, 0) > fAvailableQty then
  339. DataSetErrorMessage(Allow, '不可超过0号台账合同数量!');
  340. end;
  341. end;
  342. begin
  343. // 不检查超计
  344. //CheckOverRange;
  345. SetBeforeChangeValue('Deal');
  346. SetBeforeChangeValue('Qc');
  347. SetBeforeChangeValue('Pc');
  348. end;
  349. procedure TStageData.AfterBatchOperation;
  350. begin
  351. sddStage.BeforeValueChange := sddStageBeforeValueChange;
  352. sddStage.AfterValueChanged := sddStageAfterValueChanged;
  353. end;
  354. procedure TStageData.BeforeBatchOperation;
  355. begin
  356. sddStage.BeforeValueChange := nil;
  357. sddStage.AfterValueChanged := nil;
  358. end;
  359. function TStageData.GetBillsPriceDiffer(ABillsID: Integer): Double;
  360. begin
  361. with MainBillsTree.FindNode(ABillsID).Rec do
  362. Result := ValueByName('NewPrice').AsFloat - ValueByName('Price').AsFloat;
  363. end;
  364. procedure TStageData.UpdateComplete(ABillsID: Integer; AQuantity,
  365. ATotalPrice: Double);
  366. var
  367. Rec: TsdDataRecord;
  368. begin
  369. if ABillsID = -1 then Exit;
  370. Rec := StageRecord(ABillsID);
  371. Rec.ValueByName('GatherQuantity').AsFloat := QuantityRoundTo(
  372. Rec.ValueByName('GatherQuantity').AsFloat + AQuantity);
  373. Rec.ValueByName('GatherTotalPrice').AsFloat := TotalPriceRoundTo(
  374. Rec.ValueByName('GatherTotalPrice').AsFloat + ATotalPrice);
  375. Rec.ValueByName('EndGatherQuantity').AsFloat := QuantityRoundTo(
  376. Rec.ValueByName('EndGatherQuantity').AsFloat + AQuantity);
  377. Rec.ValueByName('EndGatherTotalPrice').AsFloat := TotalPriceRoundTo(
  378. Rec.ValueByName('EndGatherTotalPrice').AsFloat + ATotalPrice);
  379. // 数量不向上汇总
  380. UpdateParentRecord(ABillsID, ATotalPrice, 'GatherTotalPrice');
  381. end;
  382. procedure TStageData.UpdateParentRecord(ABillsID: Integer;
  383. ATotalPrice: Double; const AFieldName: string);
  384. var
  385. iParentID: Integer;
  386. Rec: TsdDataRecord;
  387. begin
  388. iParentID := MainBillsTree.FindNode(ABillsID).ParentID;
  389. if iParentID = -1 then Exit;
  390. Rec := StageRecord(iParentID);
  391. if not Assigned(Rec) then
  392. Rec := AddStageRecord(iParentID);
  393. Rec.ValueByName(AFieldName).AsFloat := TotalPriceRoundTo(
  394. Rec.ValueByName(AFieldName).AsFloat + ATotalPrice);
  395. Rec.ValueByName('End' + AFieldName).AsFloat := TotalPriceRoundTo(
  396. Rec.ValueByName('End' + AFieldName).AsFloat + ATotalPrice);
  397. UpdateParentRecord(iParentID, ATotalPrice, AFieldName);
  398. end;
  399. function TStageData.GetBuildLoadInterest(AType, AIndex: Integer): Double;
  400. begin
  401. Result := GetTotalPrice(34, AType, AIndex);
  402. end;
  403. function TStageData.GetFirstPart(AType, AIndex: Integer): Double;
  404. begin
  405. Result := GetTotalPrice(1, AType, AIndex);
  406. end;
  407. function TStageData.GetOtherFee(AType, AIndex: Integer): Double;
  408. begin
  409. Result := GetTotalPrice(15, AType, AIndex);
  410. end;
  411. function TStageData.GetOtherProjectFee(AType, AIndex: Integer): Double;
  412. begin
  413. Result := GetTotalPrice(9, AType, AIndex);
  414. end;
  415. function TStageData.GetRecyclingFee(AType, AIndex: Integer): Double;
  416. begin
  417. Result := GetTotalPrice(16, AType, AIndex);
  418. end;
  419. function TStageData.GetReservedFee(AType, AIndex: Integer): Double;
  420. begin
  421. Result := GetTotalPrice(7, AType, AIndex);
  422. end;
  423. function TStageData.GetSecondPart(AType, AIndex: Integer): Double;
  424. begin
  425. Result := GetTotalPrice(2, AType, AIndex);
  426. end;
  427. function TStageData.GetStageSettlement(AType, AIndex: Integer): Double;
  428. begin
  429. // 全国
  430. // 第一部分+第二部分+第三部分+预备费+新增加费用项目(其他费用_广东)-回收金额
  431. Result := FirstPart[AType, AIndex] + SecondPart[AType, AIndex] + ThirdPart[AType, AIndex]
  432. + ReservedFee[AType, AIndex] + OtherFee[AType, AIndex] - RecyclingFee[AType, AIndex];
  433. // 广东
  434. // 全国的基础上+建设期贷款利息+公路功能以外的项目
  435. if _IsGuangDong then
  436. Result := Result + BuildLoadInterest[AType, AIndex] + OtherProjectFee[AType, AIndex]
  437. end;
  438. function TStageData.GetThirdPart(AType, AIndex: Integer): Double;
  439. begin
  440. Result := GetTotalPrice(3, AType, AIndex);
  441. end;
  442. function TStageData.GetTotalPrice(ABillsID, AType, AStageIndex: Integer): Double;
  443. var
  444. Rec: TsdDataRecord;
  445. sFieldName: string;
  446. begin
  447. Result := 0;
  448. Rec := StageRecord(ABillsID);
  449. if not Assigned(Rec) then Exit;
  450. case AType of
  451. 1: sFieldName := '';
  452. 2: sFieldName := 'End';
  453. 3: sFieldName := 'Pre';
  454. end;
  455. case AStageIndex of
  456. 1: sFieldName := sFieldName + 'DealTotalPrice';
  457. 2: sFieldName := sFieldName + 'QcTotalPrice';
  458. 3: sFieldName := sFieldName + 'PcTotalPrice';
  459. 4: sFieldName := sFieldName + 'GatherTotalPrice';
  460. end;
  461. Result := Rec.ValueByName(sFieldName).AsFloat;
  462. end;
  463. procedure TStageData.CopyPrePhaseData;
  464. var
  465. iRecord: Integer;
  466. Rec, NewRec: TsdDataRecord;
  467. begin
  468. BeforeBatchOperation;
  469. try
  470. with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsData do
  471. for iRecord := 0 to sddBills.RecordCount - 1 do
  472. begin
  473. Rec := sddBills.Records[iRecord];
  474. if (Rec.ValueByName('AddGatherTotalPrice').AsFloat = 0) and
  475. (Rec.ValueByName('AddDealTotalPrice').AsFloat = 0) and
  476. (Rec.ValueByName('AddQcTotalPrice').AsFloat = 0) and
  477. (Rec.ValueByName('AddPcTotalPrice').AsFloat = 0) then Continue;
  478. NewRec := sddStage.Add;
  479. NewRec.ValueByName('BillsID').AsInteger := Rec.ValueByName('ID').AsInteger;
  480. NewRec.ValueByName('EndDealQuantity').AsFloat := Rec.ValueByName('AddDealQuantity').AsFloat;
  481. NewRec.ValueByName('EndDealTotalPrice').AsFloat := Rec.ValueByName('AddDealTotalPrice').AsFloat;
  482. NewRec.ValueByName('EndQcQuantity').AsFloat := Rec.ValueByName('AddQcQuantity').AsFloat;
  483. NewRec.ValueByName('EndQcTotalPrice').AsFloat := Rec.ValueByName('AddQcTotalPrice').AsFloat;
  484. NewRec.ValueByName('EndQcBGLCode').AsString := Rec.ValueByName('AddQcBGLCode').AsString;
  485. NewRec.ValueByName('EndQcBGLNum').AsString := Rec.ValueByName('AddQcBGLNum').AsString;
  486. NewRec.ValueByName('EndPcQuantity').AsFloat := Rec.ValueByName('AddPcQuantity').AsFloat;
  487. NewRec.ValueByName('EndPcTotalPrice').AsFloat := Rec.ValueByName('AddPcTotalPrice').AsFloat;
  488. NewRec.ValueByName('EndPcBGLCode').AsString := Rec.ValueByName('AddPcBGLCode').AsString;
  489. NewRec.ValueByName('EndPcBGLNum').AsString := Rec.ValueByName('AddPcBGLNum').AsString;
  490. NewRec.ValueByName('EndGatherQuantity').AsFloat := Rec.ValueByName('AddGatherQuantity').AsFloat;
  491. NewRec.ValueByName('EndGatherTotalPrice').AsFloat := Rec.ValueByName('AddGatherTotalPrice').AsFloat;
  492. NewRec.ValueByName('PreDealQuantity').AsFloat := Rec.ValueByName('AddDealQuantity').AsFloat;
  493. NewRec.ValueByName('PreDealTotalPrice').AsFloat := Rec.ValueByName('AddDealTotalPrice').AsFloat;
  494. NewRec.ValueByName('PreQcQuantity').AsFloat := Rec.ValueByName('AddQcQuantity').AsFloat;
  495. NewRec.ValueByName('PreQcTotalPrice').AsFloat := Rec.ValueByName('AddQcTotalPrice').AsFloat;
  496. NewRec.ValueByName('PreQcBGLCode').AsString := Rec.ValueByName('AddQcBGLCode').AsString;
  497. NewRec.ValueByName('PreQcBGLNum').AsString := Rec.ValueByName('AddQcBGLNum').AsString;
  498. NewRec.ValueByName('PrePcQuantity').AsFloat := Rec.ValueByName('AddPcQuantity').AsFloat;
  499. NewRec.ValueByName('PrePcTotalPrice').AsFloat := Rec.ValueByName('AddPcTotalPrice').AsFloat;
  500. NewRec.ValueByName('PrePcBGLCode').AsString := Rec.ValueByName('AddPcBGLCode').AsString;
  501. NewRec.ValueByName('PrePcBGLNum').AsString := Rec.ValueByName('AddPcBGLNum').AsString;
  502. NewRec.ValueByName('PreGatherQuantity').AsFloat := Rec.ValueByName('AddGatherQuantity').AsFloat;
  503. NewRec.ValueByName('PreGatherTotalPrice').AsFloat := Rec.ValueByName('AddGatherTotalPrice').AsFloat;
  504. end;
  505. finally
  506. AfterBatchOperation;
  507. end;
  508. end;
  509. procedure TStageData.UpdateBGLInfo(ARec: TsdDataRecord; const AType: string);
  510. var
  511. sPreBGLCode, sPreBGLNum, sCurBGLCode, sCurBGLNum: string;
  512. begin
  513. sPreBGLCode := ARec.ValueByName('Pre' + AType + 'BGLCode').AsString;
  514. sPreBGLNum := ARec.ValueByName('Pre' + AType + 'BGLNum').AsString;
  515. sCurBGLCode := ARec.ValueByName(AType + 'BGLCode').AsString;
  516. sCurBGLNum := ARec.ValueByName(AType + 'BGLNum').AsString;
  517. MergeRelaBGLAndNum(sPreBGLCode, sPreBGLNum, sCurBGLCode, sCurBGLNum);
  518. ARec.ValueByName('End' + AType + 'BGLCode').AsString := sPreBGLCode;
  519. ARec.ValueByName('End' + AType + 'BGLNum').AsString := sPreBGLNum;
  520. end;
  521. procedure TStageData.CalculateAll;
  522. begin
  523. BeforeBatchOperation;
  524. CalculateNode(MainBillsTree.FirstNode);
  525. AfterBatchOperation;
  526. end;
  527. procedure TStageData.CalculateNode(ANode: TsdIDTreeNode);
  528. begin
  529. if not Assigned(ANode) then Exit;
  530. if ANode.HasChildren then
  531. begin
  532. CalculateNode(ANode.FirstChild);
  533. CalculateParent(TBillsIDTreeNode(ANode));
  534. end
  535. else
  536. CalculateLeaf(TBillsIDTreeNode(ANode));
  537. CalculateNode(ANode.NextSibling);
  538. end;
  539. procedure TStageData.CalculateParent(ANode: TBillsIDTreeNode);
  540. var
  541. iChild: Integer;
  542. ChildNode: TBillsIDTreeNode;
  543. fDeal, fQc, fPc: Double;
  544. begin
  545. if not Assigned(ANode.StageRec) then Exit;
  546. fDeal := 0;
  547. fQc := 0;
  548. FPc := 0;
  549. for iChild := 0 to ANode.ChildCount - 1 do
  550. begin
  551. ChildNode := TBillsIDTreeNode(ANode.ChildNodes[iChild]);
  552. if not Assigned(ChildNode.StageRec) then Continue;
  553. fDeal := TotalPriceRoundTo(fDeal + ChildNode.StageRec.DealTotalPrice.AsFloat);
  554. fQc := TotalPriceRoundTo(fQc + ChildNode.StageRec.QcTotalPrice.AsFloat);
  555. fPc := TotalPriceRoundTo(fPc + ChildNode.StageRec.PcTotalPrice.AsFloat);
  556. end;
  557. with ANode.StageRec do
  558. begin
  559. DealTotalPrice.AsFloat := fDeal;
  560. QcTotalPrice.AsFloat := fQc;
  561. PcTotalPrice.AsFloat := fPc;
  562. GatherTotalPrice.AsFloat := TotalPriceRoundTo(fDeal + fQc + fPc);
  563. EndDealTotalPrice.AsFloat := TotalPriceRoundTo(PreDealTotalPrice.AsFloat + fDeal);
  564. EndQcTotalPrice.AsFloat := TotalPriceRoundTo(PreQcTotalPrice.AsFloat + fQc);
  565. EndPcTotalPrice.AsFloat := TotalPriceRoundTo(PrePcTotalPrice.AsFloat + fPc);
  566. EndGatherTotalPrice.AsFloat := TotalPriceRoundTo(
  567. PreGatherTotalPrice.AsFloat + GatherTotalPrice.AsFloat);
  568. end;
  569. end;
  570. procedure TStageData.CalculateLeaf(ANode: TBillsIDTreeNode);
  571. procedure CalculateMeasure(ARec: TsdDataRecord; const AType: string);
  572. var
  573. fPrice: Double;
  574. begin
  575. if ARec.ValueByName(AType + 'Flag').AsInteger = 1 then
  576. ARec.ValueByName(AType + 'Quantity').AsFloat := QuantityRoundTo(
  577. EvaluateExprs(ARec.ValueByName(AType + 'Formula').AsString));
  578. if ARec.ValueByName(AType + 'Flag').AsInteger < 2 then
  579. begin
  580. fPrice := GetBillsPrice(ARec.ValueByName('BillsID').AsInteger);
  581. ARec.ValueByName(AType + 'TotalPrice').AsFloat := TotalPriceRoundTo(
  582. ARec.ValueByName(AType + 'Quantity').AsFloat * fPrice);
  583. end;
  584. ARec.ValueByName('End' + AType + 'Quantity').AsFloat := QuantityRoundTo(
  585. ARec.ValueByName('Pre' + AType + 'Quantity').AsFloat + ARec.ValueByName(AType + 'Quantity').AsFloat);
  586. ARec.ValueByName('End' + AType + 'TotalPrice').AsFloat := TotalPriceRoundTo(
  587. ARec.ValueByName('Pre' + AType + 'TotalPrice').AsFloat + ARec.ValueByName(AType + 'TotalPrice').AsFloat);
  588. end;
  589. var
  590. Rec: TStageRecord;
  591. begin
  592. Rec := ANode.StageRec;
  593. if not Assigned(Rec) then Exit;
  594. CalculateMeasure(Rec, 'Deal');
  595. CalculateMeasure(Rec, 'Pc');
  596. CalculateMeasure(Rec, 'Qc');
  597. Rec.GatherQuantity.AsFloat := QuantityRoundTo(
  598. Rec.DealQuantity.AsFloat + Rec.QcQuantity.AsFloat);
  599. Rec.GatherTotalPrice.AsFloat := TotalPriceRoundTo(
  600. Rec.DealTotalPrice.AsFloat + Rec.QcTotalPrice.AsFloat + Rec.PcTotalPrice.AsFloat);
  601. Rec.EndGatherQuantity.AsFloat := QuantityRoundTo(
  602. Rec.PreGatherQuantity.AsFloat + Rec.GatherQuantity.AsFloat);
  603. Rec.EndGatherTotalPrice.AsFloat := TotalPriceRoundTo(
  604. Rec.PreGatherTotalPrice.AsFloat + Rec.GatherTotalPrice.AsFloat);
  605. end;
  606. function TStageData.GetActive: Boolean;
  607. begin
  608. Result := sddStage.Active;
  609. end;
  610. procedure TStageData.SetTableName(const Value: string);
  611. begin
  612. sdpStage.TableName := Value;
  613. end;
  614. procedure TStageData.sddStageGetRecordClass(
  615. var ARecordClass: TsdRecordClass);
  616. begin
  617. ARecordClass := TStageRecord;
  618. end;
  619. function TStageData.GetChapterStageGather(AChapter: Integer): Double;
  620. function CheckCodeChapter(const ACode: string): Boolean;
  621. var
  622. iFirst: Integer;
  623. sgs: TStrings;
  624. begin
  625. sgs := TStringList.Create;
  626. try
  627. sgs.Delimiter := '-';
  628. sgs.DelimitedText := ACode;
  629. if sgs.Count > 1 then
  630. begin
  631. iFirst := StrToIntDef(sgs[0], 0) div 100;
  632. Result := iFirst = AChapter;
  633. end
  634. else
  635. Result := False;
  636. finally
  637. sgs.Free;
  638. end;
  639. end;
  640. var
  641. iIndex: Integer;
  642. Rec: TsdDataRecord;
  643. stnNode: TsdIDTreeNode;
  644. begin
  645. Result := 0;
  646. for iIndex := 0 to sddStage.RecordCount - 1 do
  647. begin
  648. Rec := sddStage.Records[iIndex];
  649. stnNode := MainBillsTree.FindNode(Rec.ValueByName('BillsID').AsInteger);
  650. if not stnNode.HasChildren and CheckCodeChapter(stnNode.Rec.ValueByName('B_Code').AsString) then
  651. Result := Result + Rec.ValueByName('GatherTotalPrice').AsFloat;
  652. end;
  653. end;
  654. end.