StageDm.pas 27 KB

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