StageDm.pas 35 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036
  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. function HasPriceMarginBills: Boolean;
  27. function HasMaterialBills: Boolean;
  28. // 向父项增量--PM_TotalPrice
  29. procedure UpdateParentPriceMargin(ABillsID: Integer; ADiffer: Double);
  30. // 向价差调整节点增量--GatherTotalPrice
  31. procedure UpdatePriceMarginNode(ADiffer: Double);
  32. // 重新计算相关的项目工料的价差数据
  33. procedure UpdateProjectGL(ABillsID: Integer);
  34. procedure CalculateDeal(ABillsID: Integer);
  35. procedure CalculateQuantityChange(ABillsID: Integer);
  36. procedure CalculatePriceChange(ABillsID: Integer);
  37. procedure CalculateGather(ABillsID: Integer);
  38. procedure CalculateParent(ANode: TMeasureBillsIDTreeNode);
  39. procedure CalculateLeaf(ANode: TMeasureBillsIDTreeNode);
  40. procedure CalculateSpecialLeaf(ANode: TMeasureBillsIDTreeNode);
  41. function GetTotalPrice(ABillsID, AType, AStageIndex: Integer): Double;
  42. function GetCalcType(ABillsID: Integer): Integer;
  43. function GetBillsUnitPriceMargin(ABillsID: Integer): Double;
  44. function GetBillsPrice(ABillsID: Integer): Double;
  45. function GetBillsNewPrice(ABillsID: Integer): Double;
  46. function GetBillsPriceDiffer(ABillsID: Integer): Double;
  47. function GetMainBillsTree: TBillsIDTree;
  48. function GetBuildLoadInterest(AType, AIndex: Integer): Double;
  49. function GetFirstPart(AType, AIndex: Integer): Double;
  50. function GetOtherFee(AType, AIndex: Integer): Double;
  51. function GetOtherProjectFee(AType, AIndex: Integer): Double;
  52. function GetRecyclingFee(AType, AIndex: Integer): Double;
  53. function GetReservedFee(AType, AIndex: Integer): Double;
  54. function GetSecondPart(AType, AIndex: Integer): Double;
  55. function GetStageSettlement(AType, AIndex: Integer): Double;
  56. function GetThirdPart(AType, AIndex: Integer): Double;
  57. function GetActive: Boolean;
  58. procedure SetTableName(const Value: string);
  59. function GetChapterStageGather(AChapter: Integer): Double;
  60. public
  61. constructor Create(APhaseData: TObject);
  62. destructor Destroy; override;
  63. procedure Open(AConnection: TADOConnection);
  64. procedure Save;
  65. // 计算任一清单节点的价差金额,并增量汇总至父项
  66. procedure CalculatePriceMargin(ABillsID: Integer);
  67. // 计算材料调差节点
  68. procedure CalculatePriceMarginNode;
  69. // 四川交投,计算材料摊销成本节点
  70. procedure CalculateMaterialNode;
  71. procedure CalculateNode(ANode: TsdIDTreeNode);
  72. procedure CalculateAll;
  73. function AddPhaseData(ABillsID: Integer;
  74. const AField, ANewValue: string): Boolean;
  75. function AddStageRecord(ABillsID: Integer): TStageRecord;
  76. procedure DeletePhaseRecord(ABillsID: Integer);
  77. procedure ReCalculate(ABillsID: Integer);
  78. procedure UpdateBGLInfo(ARec: TsdDataRecord; const AType: string);
  79. // 查找
  80. function StageRecord(ABillsID: Integer): TStageRecord;
  81. // 查找,如未找到则新增
  82. function StageRecordWithAdd(ABillsID: Integer): TStageRecord;
  83. // 将Bills表中存的累计计量数据拷贝至截止本期计量、截止上期计量,除新增一期计量外不可调用
  84. procedure CopyPrePhaseData;
  85. property Active: Boolean read GetActive;
  86. property TableName: string Write SetTableName;
  87. property MainBillsTree: TBillsIDTree read GetMainBillsTree;
  88. {可选计算数}
  89. // AType表示不同类型,取值如下:
  90. // 1: 本期数据 2: 截止本期数据 3: 截止上期数据
  91. // AIndex表示AType下不同数据类型,取值如下:
  92. // 1: 合同计量 2: 数量变更计量 3: 单价变更计量 4: 完成计量
  93. // 第一部分
  94. property FirstPart[AType, AIndex: Integer]: Double read GetFirstPart;
  95. // 第二部分
  96. property SecondPart[AType, AIndex: Integer]: Double read GetSecondPart;
  97. // 第三部分
  98. property ThirdPart[AType, AIndex: Integer]: Double read GetThirdPart;
  99. // 预留费用
  100. property ReservedFee[AType, AIndex: Integer]: Double read GetReservedFee;
  101. // 其他费用项目
  102. property OtherFee[AType, AIndex: Integer]: Double read GetOtherFee;
  103. // 建设期贷款利息
  104. property BuildLoadInterest[AType, AIndex: Integer]: Double read GetBuildLoadInterest;
  105. // 回收金额
  106. property RecyclingFee[AType, AIndex: Integer]: Double read GetRecyclingFee;
  107. // 公路工程以外的工程费用
  108. property OtherProjectFee[AType, AIndex: Integer]: Double read GetOtherProjectFee;
  109. // 本期结算价
  110. property StageSettlement[AType, AIndex: Integer]: Double read GetStageSettlement;
  111. // 100/200/.../900章本期完成计量
  112. property ChapterStageGather[AChapter: Integer]: Double read GetChapterStageGather;
  113. end;
  114. implementation
  115. uses
  116. ProjectData, BillsDm, PhaseData, Math, BGLDm, BillsMeasureDm,
  117. UtilMethods, ConditionalDefines, FormulaCalc, DetailGLDm, ConstUnit,
  118. ProjectGLDm;
  119. {$R *.dfm}
  120. { TPhaseData }
  121. function TStageData.AddPhaseData(ABillsID: Integer;
  122. const AField, ANewValue: string): Boolean;
  123. procedure SetPhaseRecord(ARec: TsdDataRecord; const AField, AValue: string);
  124. begin
  125. if CheckNumeric(ANewValue) then
  126. ARec.ValueByName(AField).AsString := AValue
  127. else
  128. begin
  129. ARec.ValueByName(AField).AsFloat := EvaluateExprs(AValue);
  130. ARec.ValueByName(StringReplace(AField, 'Quantity', 'Flag', [])).AsInteger := 1;
  131. ARec.ValueByName(StringReplace(AField, 'Quantity', 'Formula', [])).AsString := AValue;
  132. end;
  133. end;
  134. var
  135. Rec: TsdDataRecord;
  136. begin
  137. if Assigned(sddStage.FindKey('idxBID', ABillsID)) then Exit;
  138. Rec := sddStage.Add;
  139. Rec.ValueByName('BillsID').AsInteger := ABillsID;
  140. SetPhaseRecord(Rec, AField, ANewValue);
  141. end;
  142. function TStageData.AddStageRecord(ABillsID: Integer): TStageRecord;
  143. begin
  144. Result := TStageRecord(sddStage.FindKey('idxBID', ABillsID));
  145. if Assigned(Result) then Exit;
  146. Result := TStageRecord(sddStage.Add(True));
  147. try
  148. Result.ValueByName('BillsID').AsInteger := ABillsID;
  149. finally
  150. Result.EndUpdate;
  151. end;
  152. end;
  153. procedure TStageData.CalculateDeal(ABillsID: Integer);
  154. var
  155. Rec: TsdDataRecord;
  156. fQtyDiffer, fTPDiffer: Double;
  157. begin
  158. Rec := sddStage.FindKey('idxBID', ABillsID);
  159. if GetCalcType(ABillsID) = 0 then
  160. Rec.ValueByName('DealTotalPrice').AsFloat :=
  161. TotalPriceRoundTo(Rec.ValueByName('DealQuantity').AsFloat * GetBillsPrice(ABillsID));
  162. fQtyDiffer := Rec.ValueByName('DealQuantity').AsFloat - FBeforeChangeQuantity;
  163. fTPDiffer := Rec.ValueByName('DealTotalPrice').AsFloat - FBeforeChangeTotalPrice;
  164. Rec.ValueByName('EndDealQuantity').AsFloat := QuantityRoundTo(
  165. Rec.ValueByName('EndDealQuantity').AsFloat + fQtyDiffer);
  166. Rec.ValueByName('EndDealTotalPrice').AsFloat := TotalPriceRoundTo(
  167. Rec.ValueByName('EndDealTotalPrice').AsFloat + fTPDiffer);
  168. UpdateParentRecord(ABillsID, fTPDiffer, 'DealTotalPrice');
  169. UpdateComplete(ABillsID, fQtyDiffer, fTPDiffer);
  170. if TPhaseData(FPhaseData).IsLastStage then
  171. with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do
  172. UpdateRecordDeal(ABillsID, fQtyDiffer, fTPDiffer);
  173. CalculatePriceMargin(ABillsID);
  174. if ABillsID = iPriceMarginID then
  175. CalculateGather(ABillsID);
  176. TPhaseData(FPhaseData).PhasePayData.CalculateAll;
  177. end;
  178. procedure TStageData.CalculatePriceChange(ABillsID: Integer);
  179. var
  180. Rec: TsdDataRecord;
  181. fQtyDiffer, fTPDiffer: Double;
  182. begin
  183. Rec := sddStage.FindKey('idxBID', ABillsID);
  184. if GetCalcType(ABillsID) < 2 then
  185. Rec.ValueByName('PcTotalPrice').AsFloat :=
  186. TotalPriceRoundTo(Rec.ValueByName('PcQuantity').AsFloat * GetBillsPriceDiffer(ABillsID));
  187. fQtyDiffer := Rec.ValueByName('PcQuantity').AsFloat - FBeforeChangeQuantity;
  188. fTPDiffer := Rec.ValueByName('PcTotalPrice').AsFloat - FBeforeChangeTotalPrice;
  189. Rec.ValueByName('EndPcQuantity').AsFloat := QuantityRoundTo(
  190. Rec.ValueByName('EndPcQuantity').AsFloat + fQtyDiffer);
  191. Rec.ValueByName('EndPcTotalPrice').AsFloat := TotalPriceRoundTo(
  192. Rec.ValueByName('EndPcTotalPrice').AsFloat + fTPDiffer);
  193. UpdateParentRecord(ABillsID, fTPDiffer, 'PcTotalPrice');
  194. UpdateComplete(ABillsID, 0, fTPDiffer);
  195. if TPhaseData(FPhaseData).IsLastStage then
  196. with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do
  197. UpdateRecordPc(ABillsID, fQtyDiffer, fTPDiffer);
  198. TPhaseData(FPhaseData).PhasePayData.CalculateAll;
  199. end;
  200. procedure TStageData.CalculateQuantityChange(ABillsID: Integer);
  201. var
  202. Rec: TsdDataRecord;
  203. fQtyDiffer, fTPDiffer: Double;
  204. begin
  205. Rec := sddStage.FindKey('idxBID', ABillsID);
  206. if GetCalcType(ABillsID) = 0 then
  207. Rec.ValueByName('QcTotalPrice').AsFloat :=
  208. TotalPriceRoundTo(Rec.ValueByName('QcQuantity').AsFloat * GetBillsPrice(ABillsID));
  209. fQtyDiffer := Rec.ValueByName('QcQuantity').AsFloat - FBeforeChangeQuantity;
  210. fTPDiffer := Rec.ValueByName('QcTotalPrice').AsFloat - FBeforeChangeTotalPrice;
  211. Rec.ValueByName('EndQcQuantity').AsFloat := QuantityRoundTo(
  212. Rec.ValueByName('EndQcQuantity').AsFloat + fQtyDiffer);
  213. Rec.ValueByName('EndQcTotalPrice').AsFloat := TotalPriceRoundTo(
  214. Rec.ValueByName('EndQcTotalPrice').AsFloat + fTPDiffer);
  215. UpdateParentRecord(ABillsID, fTPDiffer, 'QcTotalPrice');
  216. UpdateComplete(ABillsID, fQtyDiffer, fTPDiffer);
  217. if TPhaseData(FPhaseData).IsLastStage then
  218. with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do
  219. UpdateRecordQc(ABillsID, fQtyDiffer, fTPDiffer);
  220. CalculatePriceMargin(ABillsID);
  221. if ABillsID = iPriceMarginID then
  222. CalculateGather(ABillsID);
  223. TPhaseData(FPhaseData).PhasePayData.CalculateAll;
  224. end;
  225. constructor TStageData.Create(APhaseData: TObject);
  226. begin
  227. inherited Create(nil);
  228. FPhaseData := APhaseData;
  229. end;
  230. procedure TStageData.DeletePhaseRecord(ABillsID: Integer);
  231. var
  232. Rec: TsdDataRecord;
  233. begin
  234. Rec := sddStage.FindKey('idxBID', ABillsID);
  235. if Assigned(Rec) then
  236. sddStage.Remove(Rec);
  237. end;
  238. destructor TStageData.Destroy;
  239. begin
  240. inherited;
  241. end;
  242. function TStageData.GetBillsNewPrice(ABillsID: Integer): Double;
  243. begin
  244. Result := MainBillsTree.FindNode(ABillsID).Rec.ValueByName('NewPrice').AsFloat;
  245. end;
  246. function TStageData.GetBillsPrice(ABillsID: Integer): Double;
  247. begin
  248. Result := MainBillsTree.FindNode(ABillsID).Rec.ValueByName('Price').AsFloat;
  249. end;
  250. procedure TStageData.Open(AConnection: TADOConnection);
  251. begin
  252. sdpStage.Connection := AConnection;
  253. sddStage.Open;
  254. if not Assigned(sddStage.IndexList.FindByName('idxBID')) then
  255. sddStage.AddIndex('idxBID', 'BillsID');
  256. sddStage.FieldByName('DealQuantity').ValidChars := sddStage.FieldByName('DealQuantity').ValidChars + ArithmeticCharSet;
  257. sddStage.FieldByName('DealTotalPrice').ValidChars := sddStage.FieldByName('DealQuantity').ValidChars;
  258. end;
  259. function TStageData.StageRecord(ABillsID: Integer): TStageRecord;
  260. begin
  261. Result := nil;
  262. if Assigned(sddStage.IndexList.FindByName('idxBID')) then
  263. Result := TStageRecord(sddStage.FindKey('idxBID', ABillsID));
  264. end;
  265. procedure TStageData.ReCalculate(ABillsID: Integer);
  266. var
  267. Rec: TsdDataRecord;
  268. fDiffer: Double;
  269. begin
  270. Rec := sddStage.FindKey('idxBID', ABillsID);
  271. if not Assigned(Rec) then Exit;
  272. if Rec.ValueByName('DealFlag').AsInteger = 1 then
  273. Rec.ValueByName('DealQuantity').AsFloat := QuantityRoundTo(
  274. EvaluateExprs(Rec.ValueByName('DealFormula').AsString));
  275. if Rec.ValueByName('DealFlag').AsInteger < 2 then
  276. begin
  277. fDiffer := Rec.ValueByName('DealQuantity').AsFloat * GetBillsPrice(ABillsID)
  278. - Rec.ValueByName('DealTotalPrice').AsFloat;
  279. Rec.ValueByName('DealTotalPrice').AsFloat := TotalPriceRoundTo(
  280. Rec.ValueByName('DealQuantity').AsFloat * GetBillsPrice(ABillsID));
  281. end;
  282. Rec.ValueByName('EndDealQuantity').AsFloat := QuantityRoundTo(
  283. Rec.ValueByName('PreDealQuantity').AsFloat + Rec.ValueByName('DealQuantity').AsFloat);
  284. Rec.ValueByName('EndDealTotalPrice').AsFloat := TotalPriceRoundTo(
  285. Rec.ValueByName('PreDealTotalPrice').AsFloat + Rec.ValueByName('DealTotalPrice').AsFloat);
  286. if Rec.ValueByName('QcFlag').AsInteger = 1 then
  287. Rec.ValueByName('QcQuantity').AsFloat := QuantityRoundTo(
  288. EvaluateExprs(Rec.ValueByName('QcFormula').AsString));
  289. if Rec.ValueByName('QcFlag').AsInteger < 2 then
  290. begin
  291. fDiffer := Rec.ValueByName('QcQuantity').AsFloat * GetBillsPrice(ABillsID)
  292. - Rec.ValueByName('QcTotalPrice').AsFloat;
  293. Rec.ValueByName('QcTotalPrice').AsFloat := TotalPriceRoundTo(
  294. Rec.ValueByName('QcQuantity').AsFloat * GetBillsPrice(ABillsID));
  295. end;
  296. Rec.ValueByName('EndQcQuantity').AsFloat := QuantityRoundTo(
  297. Rec.ValueByName('PreQcQuantity').AsFloat + Rec.ValueByName('QcQuantity').AsFloat);
  298. Rec.ValueByName('EndQcTotalPrice').AsFloat := TotalPriceRoundTo(
  299. Rec.ValueByName('PreQcTotalPrice').AsFloat + Rec.ValueByName('QcTotalPrice').AsFloat);
  300. if Rec.ValueByName('PcFlag').AsInteger = 1 then
  301. Rec.ValueByName('PcQuantity').AsFloat := QuantityRoundTo(
  302. EvaluateExprs(Rec.ValueByName('PcFormula').AsString));
  303. if Rec.ValueByName('DealFlag').AsInteger < 2 then
  304. begin
  305. fDiffer := Rec.ValueByName('PcQuantity').AsFloat * GetBillsNewPrice(ABillsID)
  306. - Rec.ValueByName('PcTotalPrice').AsFloat;
  307. Rec.ValueByName('PcTotalPrice').AsFloat := TotalPriceRoundTo(
  308. Rec.ValueByName('PcQuantity').AsFloat * GetBillsNewPrice(ABillsID));
  309. end;
  310. Rec.ValueByName('EndPcQuantity').AsFloat := QuantityRoundTo(
  311. Rec.ValueByName('PrePcQuantity').AsFloat + Rec.ValueByName('PcQuantity').AsFloat);
  312. Rec.ValueByName('EndPcTotalPrice').AsFloat := TotalPriceRoundTo(
  313. Rec.ValueByName('PrePcTotalPrice').AsFloat + Rec.ValueByName('PcTotalPrice').AsFloat);
  314. end;
  315. procedure TStageData.Save;
  316. begin
  317. sddStage.Save;
  318. end;
  319. procedure TStageData.sddStageAfterValueChanged(AValue: TsdValue);
  320. var
  321. iBillsID: Integer;
  322. stnNode: TsdIDTreeNode;
  323. begin
  324. iBillsID := AValue.Owner.ValueByName('BillsID').AsInteger;
  325. stnNode := MainBillsTree.FindNode(iBillsID);
  326. if not Assigned(stnNode) or stnNode.HasChildren then Exit;
  327. if (AValue.FieldName = 'DealQuantity') or
  328. (AValue.FieldName = 'DealFormula') or
  329. (AValue.FieldName = 'DealTotalPrice') then
  330. CalculateDeal(iBillsID);
  331. if (AValue.FieldName = 'QcQuantity') or
  332. (AValue.FieldName = 'QcFormula') or
  333. (AValue.FieldName = 'QcTotalPrice') then
  334. CalculateQuantityChange(iBillsID);
  335. if (AValue.FieldName = 'PcQuantity') or
  336. (AValue.FieldName = 'PcFormula') or
  337. (AValue.FieldName = 'PcTotalPrice') then
  338. CalculatePriceChange(iBillsID);
  339. if (AValue.FieldName = 'DealQuantity') or
  340. (AValue.FieldName = 'QcQuantity') then
  341. UpdateProjectGL(iBillsID);
  342. end;
  343. function TStageData.GetMainBillsTree: TBillsIDTree;
  344. begin
  345. with TProjectData(TPhaseData(FPhaseData).ProjectData) do
  346. Result := BillsMeasureData.BillsMeasureTree;
  347. end;
  348. procedure TStageData.sddStageBeforeValueChange(AValue: TsdValue;
  349. const NewValue: Variant; var Allow: Boolean);
  350. procedure SetBeforeChangeValue(const AType: string);
  351. begin
  352. if SameText(AValue.FieldName, AType + 'Quantity') or
  353. SameText(AValue.FieldName, AType + 'Formula') or
  354. SameText(AValue.FieldName, AType + 'TotalPrice') then
  355. begin
  356. FBeforeChangeQuantity := AValue.Owner.ValueByName(AType + 'Quantity').AsFloat;
  357. FBeforeChangeTotalPrice := AValue.Owner.ValueByName(AType + 'TotalPrice').AsFloat;
  358. end;
  359. end;
  360. procedure CheckOverRange;
  361. var
  362. vNode: TsdIDTreeNode;
  363. fAvailableQty: Double;
  364. begin
  365. if SameText(AValue.FieldName, 'DealQuantity') then
  366. begin
  367. vNode := MainBillsTree.FindNode(AValue.Owner.ValueByName('BillsID').AsInteger);
  368. fAvailableQty := vNode.Rec.ValueByName('Quantity').AsFloat
  369. - vNode.Rec.ValueByName('AddDealQuantity').AsFloat + AValue.AsFloat;
  370. if VarToFloatDef(NewValue, 0) > fAvailableQty then
  371. DataSetErrorMessage(Allow, '不可超过0号台账合同数量!');
  372. end;
  373. end;
  374. begin
  375. // 不检查超计
  376. //CheckOverRange;
  377. SetBeforeChangeValue('Deal');
  378. SetBeforeChangeValue('Qc');
  379. SetBeforeChangeValue('Pc');
  380. end;
  381. procedure TStageData.AfterBatchOperation;
  382. begin
  383. sddStage.BeforeValueChange := sddStageBeforeValueChange;
  384. sddStage.AfterValueChanged := sddStageAfterValueChanged;
  385. end;
  386. procedure TStageData.BeforeBatchOperation;
  387. begin
  388. sddStage.BeforeValueChange := nil;
  389. sddStage.AfterValueChanged := nil;
  390. end;
  391. function TStageData.GetBillsPriceDiffer(ABillsID: Integer): Double;
  392. begin
  393. with MainBillsTree.FindNode(ABillsID).Rec do
  394. Result := ValueByName('NewPrice').AsFloat - ValueByName('Price').AsFloat;
  395. end;
  396. procedure TStageData.UpdateComplete(ABillsID: Integer; AQuantity,
  397. ATotalPrice: Double);
  398. var
  399. Rec: TStageRecord;
  400. begin
  401. if ABillsID = -1 then Exit;
  402. Rec := StageRecord(ABillsID);
  403. Rec.GatherQuantity.AsFloat := QuantityRoundTo(Rec.GatherQuantity.AsFloat + AQuantity);
  404. Rec.GatherTotalPrice.AsFloat := TotalPriceRoundTo(Rec.GatherTotalPrice.AsFloat + ATotalPrice);
  405. Rec.EndGatherQuantity.AsFloat := QuantityRoundTo(Rec.EndGatherQuantity.AsFloat + AQuantity);
  406. Rec.EndGatherTotalPrice.AsFloat := TotalPriceRoundTo(Rec.EndGatherTotalPrice.AsFloat + ATotalPrice);
  407. // 数量不向上汇总
  408. UpdateParentRecord(ABillsID, ATotalPrice, 'GatherTotalPrice');
  409. end;
  410. procedure TStageData.UpdateParentRecord(ABillsID: Integer;
  411. ATotalPrice: Double; const AFieldName: string);
  412. var
  413. iParentID: Integer;
  414. Rec: TsdDataRecord;
  415. begin
  416. iParentID := MainBillsTree.FindNode(ABillsID).ParentID;
  417. if iParentID = -1 then Exit;
  418. Rec := StageRecordWithAdd(iParentID);
  419. Rec.ValueByName(AFieldName).AsFloat := TotalPriceRoundTo(
  420. Rec.ValueByName(AFieldName).AsFloat + ATotalPrice);
  421. Rec.ValueByName('End' + AFieldName).AsFloat := TotalPriceRoundTo(
  422. Rec.ValueByName('End' + AFieldName).AsFloat + ATotalPrice);
  423. UpdateParentRecord(iParentID, ATotalPrice, AFieldName);
  424. end;
  425. function TStageData.GetBuildLoadInterest(AType, AIndex: Integer): Double;
  426. begin
  427. Result := GetTotalPrice(34, AType, AIndex);
  428. end;
  429. function TStageData.GetFirstPart(AType, AIndex: Integer): Double;
  430. begin
  431. Result := GetTotalPrice(1, AType, AIndex);
  432. end;
  433. function TStageData.GetOtherFee(AType, AIndex: Integer): Double;
  434. begin
  435. Result := GetTotalPrice(15, AType, AIndex);
  436. end;
  437. function TStageData.GetOtherProjectFee(AType, AIndex: Integer): Double;
  438. begin
  439. Result := GetTotalPrice(9, AType, AIndex);
  440. end;
  441. function TStageData.GetRecyclingFee(AType, AIndex: Integer): Double;
  442. begin
  443. Result := GetTotalPrice(16, AType, AIndex);
  444. end;
  445. function TStageData.GetReservedFee(AType, AIndex: Integer): Double;
  446. begin
  447. Result := GetTotalPrice(7, AType, AIndex);
  448. end;
  449. function TStageData.GetSecondPart(AType, AIndex: Integer): Double;
  450. begin
  451. Result := GetTotalPrice(2, AType, AIndex);
  452. end;
  453. function TStageData.GetStageSettlement(AType, AIndex: Integer): Double;
  454. begin
  455. // 全国
  456. // 第一部分+第二部分+第三部分+预备费+新增加费用项目(其他费用_广东)-回收金额
  457. Result := FirstPart[AType, AIndex] + SecondPart[AType, AIndex] + ThirdPart[AType, AIndex]
  458. + ReservedFee[AType, AIndex] + OtherFee[AType, AIndex] - RecyclingFee[AType, AIndex];
  459. // 广东
  460. // 全国的基础上+建设期贷款利息+公路功能以外的项目
  461. if _IsGuangDong then
  462. Result := Result + BuildLoadInterest[AType, AIndex] + OtherProjectFee[AType, AIndex]
  463. end;
  464. function TStageData.GetThirdPart(AType, AIndex: Integer): Double;
  465. begin
  466. Result := GetTotalPrice(3, AType, AIndex);
  467. end;
  468. function TStageData.GetTotalPrice(ABillsID, AType, AStageIndex: Integer): Double;
  469. var
  470. Rec: TsdDataRecord;
  471. sFieldName: string;
  472. begin
  473. Result := 0;
  474. Rec := StageRecord(ABillsID);
  475. if not Assigned(Rec) then Exit;
  476. case AType of
  477. 1: sFieldName := '';
  478. 2: sFieldName := 'End';
  479. 3: sFieldName := 'Pre';
  480. end;
  481. case AStageIndex of
  482. 1: sFieldName := sFieldName + 'DealTotalPrice';
  483. 2: sFieldName := sFieldName + 'QcTotalPrice';
  484. 3: sFieldName := sFieldName + 'PcTotalPrice';
  485. 4: sFieldName := sFieldName + 'GatherTotalPrice';
  486. end;
  487. Result := Rec.ValueByName(sFieldName).AsFloat;
  488. end;
  489. procedure TStageData.CopyPrePhaseData;
  490. var
  491. iRecord: Integer;
  492. Rec: TBillsRecord;
  493. NewRec: TStageRecord;
  494. begin
  495. BeforeBatchOperation;
  496. try
  497. with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsData do
  498. for iRecord := 0 to sddBills.RecordCount - 1 do
  499. begin
  500. Rec := TBillsRecord(sddBills.Records[iRecord]);
  501. if (Rec.AddGatherTotalPrice.AsFloat = 0) and
  502. (Rec.AddDealTotalPrice.AsFloat = 0) and
  503. (Rec.AddQcTotalPrice.AsFloat = 0) and
  504. (Rec.AddPcTotalPrice.AsFloat = 0) and
  505. (Rec.PM_AddTotalPrice.AsFloat = 0) then Continue;
  506. NewRec := TStageRecord(sddStage.Add);
  507. NewRec.BillsID.AsInteger := Rec.ID.AsInteger;
  508. NewRec.EndDealQuantity.AsFloat := Rec.AddDealQuantity.AsFloat;
  509. NewRec.EndDealTotalPrice.AsFloat := Rec.AddDealTotalPrice.AsFloat;
  510. NewRec.EndQcQuantity.AsFloat := Rec.AddQcQuantity.AsFloat;
  511. NewRec.EndQcTotalPrice.AsFloat := Rec.AddQcTotalPrice.AsFloat;
  512. NewRec.EndQcBGLCode.AsString := Rec.AddQcBGLCode.AsString;
  513. NewRec.EndQcBGLNum.AsString := Rec.AddQcBGLNum.AsString;
  514. NewRec.EndPcQuantity.AsFloat := Rec.AddPcQuantity.AsFloat;
  515. NewRec.EndPcTotalPrice.AsFloat := Rec.AddPcTotalPrice.AsFloat;
  516. NewRec.EndPcBGLCode.AsString := Rec.AddPcBGLCode.AsString;
  517. NewRec.EndPcBGLNum.AsString := Rec.AddPcBGLNum.AsString;
  518. NewRec.EndGatherQuantity.AsFloat := Rec.AddGatherQuantity.AsFloat;
  519. NewRec.EndGatherTotalPrice.AsFloat := Rec.AddGatherTotalPrice.AsFloat;
  520. NewRec.PreDealQuantity.AsFloat := Rec.AddDealQuantity.AsFloat;
  521. NewRec.PreDealTotalPrice.AsFloat := Rec.AddDealTotalPrice.AsFloat;
  522. NewRec.PreQcQuantity.AsFloat := Rec.AddQcQuantity.AsFloat;
  523. NewRec.PreQcTotalPrice.AsFloat := Rec.AddQcTotalPrice.AsFloat;
  524. NewRec.PreQcBGLCode.AsString := Rec.AddQcBGLCode.AsString;
  525. NewRec.PreQcBGLNum.AsString := Rec.AddQcBGLNum.AsString;
  526. NewRec.PrePcQuantity.AsFloat := Rec.AddPcQuantity.AsFloat;
  527. NewRec.PrePcTotalPrice.AsFloat := Rec.AddPcTotalPrice.AsFloat;
  528. NewRec.PrePcBGLCode.AsString := Rec.AddPcBGLCode.AsString;
  529. NewRec.PrePcBGLNum.AsString := Rec.AddPcBGLNum.AsString;
  530. NewRec.PreGatherQuantity.AsFloat := Rec.AddGatherQuantity.AsFloat;
  531. NewRec.PreGatherTotalPrice.AsFloat := Rec.AddGatherTotalPrice.AsFloat;
  532. NewRec.PM_PreTotalPrice.AsFloat := Rec.PM_AddTotalPrice.AsFloat;
  533. end;
  534. finally
  535. AfterBatchOperation;
  536. end;
  537. end;
  538. procedure TStageData.UpdateBGLInfo(ARec: TsdDataRecord; const AType: string);
  539. var
  540. sPreBGLCode, sPreBGLNum, sCurBGLCode, sCurBGLNum: string;
  541. begin
  542. sPreBGLCode := ARec.ValueByName('Pre' + AType + 'BGLCode').AsString;
  543. sPreBGLNum := ARec.ValueByName('Pre' + AType + 'BGLNum').AsString;
  544. sCurBGLCode := ARec.ValueByName(AType + 'BGLCode').AsString;
  545. sCurBGLNum := ARec.ValueByName(AType + 'BGLNum').AsString;
  546. MergeRelaBGLAndNum(sPreBGLCode, sPreBGLNum, sCurBGLCode, sCurBGLNum);
  547. ARec.ValueByName('End' + AType + 'BGLCode').AsString := sPreBGLCode;
  548. ARec.ValueByName('End' + AType + 'BGLNum').AsString := sPreBGLNum;
  549. end;
  550. procedure TStageData.CalculateAll;
  551. begin
  552. BeforeBatchOperation;
  553. CalculateNode(MainBillsTree.FirstNode);
  554. AfterBatchOperation;
  555. end;
  556. procedure TStageData.CalculateNode(ANode: TsdIDTreeNode);
  557. function IsSpecialNode: Boolean;
  558. begin
  559. //Result := ANode.ID = iPriceMarginID;
  560. //Result := False;
  561. Result := ANode.ID = iMaterialID;
  562. end;
  563. begin
  564. if not Assigned(ANode) then Exit;
  565. if ANode.HasChildren then
  566. begin
  567. CalculateNode(ANode.FirstChild);
  568. CalculateParent(TMeasureBillsIDTreeNode(ANode));
  569. end
  570. else
  571. begin
  572. if IsSpecialNode then
  573. CalculateSpecialLeaf(TMeasureBillsIDTreeNode(ANode))
  574. else
  575. CalculateLeaf(TMeasureBillsIDTreeNode(ANode));
  576. end;
  577. CalculateNode(ANode.NextSibling);
  578. end;
  579. procedure TStageData.CalculateParent(ANode: TMeasureBillsIDTreeNode);
  580. var
  581. iChild: Integer;
  582. ChildNode: TMeasureBillsIDTreeNode;
  583. fDeal, fQc, fPc, fTotal, fPM: Double;
  584. begin
  585. if not Assigned(ANode.StageRec) then Exit;
  586. fDeal := 0;
  587. fQc := 0;
  588. fPc := 0;
  589. fPM := 0;
  590. for iChild := 0 to ANode.ChildCount - 1 do
  591. begin
  592. ChildNode := TMeasureBillsIDTreeNode(ANode.ChildNodes[iChild]);
  593. if not Assigned(ChildNode.StageRec) then Continue;
  594. fDeal := TotalPriceRoundTo(fDeal + ChildNode.StageRec.DealTotalPrice.AsFloat);
  595. fQc := TotalPriceRoundTo(fQc + ChildNode.StageRec.QcTotalPrice.AsFloat);
  596. fPc := TotalPriceRoundTo(fPc + ChildNode.StageRec.PcTotalPrice.AsFloat);
  597. fPM := TotalPriceRoundTo(fPM + ChildNode.StageRec.PM_TotalPrice.AsFloat);
  598. fTotal := TotalPriceRoundTo(fTotal + ChildNode.StageRec.GatherTotalPrice.AsFloat);
  599. end;
  600. //fTotal := TotalPriceRoundTo(fDeal + fQc + fPc);
  601. with ANode.StageRec do
  602. begin
  603. if DealTotalPrice.AsFloat <> fDeal then
  604. begin
  605. DealTotalPrice.AsFloat := fDeal;
  606. EndDealTotalPrice.AsFloat := TotalPriceRoundTo(PreDealTotalPrice.AsFloat + fDeal);
  607. end;
  608. if QcTotalPrice.AsFloat <> fQc then
  609. begin
  610. QcTotalPrice.AsFloat := fQc;
  611. EndQcTotalPrice.AsFloat := TotalPriceRoundTo(PreQcTotalPrice.AsFloat + fQc);
  612. end;
  613. if PcTotalPrice.AsFloat <> fPc then
  614. begin
  615. PcTotalPrice.AsFloat := fPc;
  616. EndPcTotalPrice.AsFloat := TotalPriceRoundTo(PrePcTotalPrice.AsFloat + fPc);
  617. end;
  618. if GatherTotalPrice.AsFloat <> fTotal then
  619. begin
  620. GatherTotalPrice.AsFloat := fTotal;
  621. EndGatherTotalPrice.AsFloat := TotalPriceRoundTo(PreGatherTotalPrice.AsFloat + fTotal);
  622. end;
  623. if PM_TotalPrice.AsFloat <> fPM then
  624. PM_TotalPrice.AsFloat := fPM;
  625. end;
  626. end;
  627. procedure TStageData.CalculateLeaf(ANode: TMeasureBillsIDTreeNode);
  628. procedure CalculateMeasure(ARec: TsdDataRecord; const AType: string);
  629. begin
  630. if GetCalcType(ANode.ID) = 0 then
  631. begin
  632. if ARec.ValueByName(AType + 'Formula').AsString <> '' then
  633. ARec.ValueByName(AType + 'Quantity').AsFloat :=
  634. EvaluateExprs(ARec.ValueByName(AType + 'Formula').AsString);
  635. ARec.ValueByName(AType + 'TotalPrice').AsFloat := TotalPriceRoundTo(
  636. ARec.ValueByName(AType + 'Quantity').AsFloat * GetBillsPrice(ANode.ID));
  637. end;
  638. ARec.ValueByName('End' + AType + 'Quantity').AsFloat := QuantityRoundTo(
  639. ARec.ValueByName('Pre' + AType + 'Quantity').AsFloat + ARec.ValueByName(AType + 'Quantity').AsFloat);
  640. ARec.ValueByName('End' + AType + 'TotalPrice').AsFloat := TotalPriceRoundTo(
  641. ARec.ValueByName('Pre' + AType + 'TotalPrice').AsFloat + ARec.ValueByName(AType + 'TotalPrice').AsFloat);
  642. end;
  643. procedure CalculatePriceMargin(ARec: TStageRecord);
  644. var
  645. fPrice: Double;
  646. begin
  647. fPrice := GetBillsUnitPriceMargin(ARec.BillsID.AsInteger);
  648. ARec.SetFloatValue(ARec.PM_TotalPrice, TotalPriceRoundTo(ARec.GatherQuantity.AsFloat * fPrice));
  649. end;
  650. var
  651. Rec: TStageRecord;
  652. begin
  653. Rec := ANode.StageRec;
  654. if not Assigned(Rec) then Exit;
  655. CalculateMeasure(Rec, 'Deal');
  656. CalculateMeasure(Rec, 'Pc');
  657. CalculateMeasure(Rec, 'Qc');
  658. Rec.GatherQuantity.AsFloat := QuantityRoundTo(
  659. Rec.DealQuantity.AsFloat + Rec.QcQuantity.AsFloat);
  660. Rec.GatherTotalPrice.AsFloat := TotalPriceRoundTo(
  661. Rec.DealTotalPrice.AsFloat + Rec.QcTotalPrice.AsFloat + Rec.PcTotalPrice.AsFloat);
  662. Rec.EndGatherQuantity.AsFloat := QuantityRoundTo(
  663. Rec.PreGatherQuantity.AsFloat + Rec.GatherQuantity.AsFloat);
  664. Rec.EndGatherTotalPrice.AsFloat := TotalPriceRoundTo(
  665. Rec.PreGatherTotalPrice.AsFloat + Rec.GatherTotalPrice.AsFloat);
  666. CalculatePriceMargin(Rec);
  667. end;
  668. function TStageData.GetActive: Boolean;
  669. begin
  670. Result := sddStage.Active;
  671. end;
  672. procedure TStageData.SetTableName(const Value: string);
  673. begin
  674. sdpStage.TableName := Value;
  675. end;
  676. procedure TStageData.sddStageGetRecordClass(
  677. var ARecordClass: TsdRecordClass);
  678. begin
  679. ARecordClass := TStageRecord;
  680. end;
  681. function TStageData.GetChapterStageGather(AChapter: Integer): Double;
  682. function CheckCodeChapter(const ACode: string): Boolean;
  683. var
  684. iFirst: Integer;
  685. sgs: TStrings;
  686. begin
  687. sgs := TStringList.Create;
  688. try
  689. sgs.Delimiter := '-';
  690. sgs.DelimitedText := ACode;
  691. if sgs.Count > 1 then
  692. begin
  693. iFirst := StrToIntDef(sgs[0], 0) div 100;
  694. Result := iFirst = AChapter;
  695. end
  696. else
  697. Result := False;
  698. finally
  699. sgs.Free;
  700. end;
  701. end;
  702. var
  703. iIndex: Integer;
  704. Rec: TsdDataRecord;
  705. stnNode: TsdIDTreeNode;
  706. begin
  707. Result := 0;
  708. for iIndex := 0 to sddStage.RecordCount - 1 do
  709. begin
  710. Rec := sddStage.Records[iIndex];
  711. stnNode := MainBillsTree.FindNode(Rec.ValueByName('BillsID').AsInteger);
  712. if not stnNode.HasChildren and CheckCodeChapter(stnNode.Rec.ValueByName('B_Code').AsString) then
  713. Result := Result + Rec.ValueByName('GatherTotalPrice').AsFloat;
  714. end;
  715. end;
  716. function TStageData.GetCalcType(ABillsID: Integer): Integer;
  717. begin
  718. Result := MainBillsTree.FindNode(ABillsID).Rec.ValueByName('CalcType').AsInteger;
  719. end;
  720. procedure TStageData.CalculatePriceMarginNode;
  721. var
  722. Rec: TStageRecord;
  723. fDiffer: Double;
  724. begin
  725. if not HasPriceMarginBills then Exit;
  726. with TProjectData(TPhaseData(FPhaseData).ProjectData) do
  727. begin
  728. Rec := StageRecord(iPriceMarginID);
  729. if not Assigned(Rec) then
  730. Rec := AddStageRecord(iPriceMarginID);
  731. fDiffer := TotalPriceRoundTo(ProjectGLData.PM_TotalPrice - Rec.GatherTotalPrice.AsFloat);
  732. if fDiffer <> 0 then
  733. begin
  734. Rec.AddDifferValue(Rec.GatherTotalPrice, fDiffer);
  735. Rec.AddDifferValue(Rec.EndGatherTotalPrice, fDiffer);
  736. UpdateParentRecord(Rec.BillsID.AsInteger, fDiffer, 'GatherTotalPrice');
  737. end;
  738. end;
  739. end;
  740. function TStageData.GetBillsUnitPriceMargin(ABillsID: Integer): Double;
  741. var
  742. vGLs: TList;
  743. iGL: Integer;
  744. GLRec: TDetailGLRecord;
  745. begin
  746. Result := 0;
  747. vGLs := TList.Create;
  748. try
  749. with TProjectData(TPhaseData(FPhaseData).ProjectData).DetailGLData do
  750. LoadDetailGLs(ABillsID, vGLs);
  751. for iGL := 0 to vGLs.Count - 1 do
  752. begin
  753. GLRec := TDetailGLRecord(vGLs.Items[iGL]);
  754. Result := Result + GLRec.Quantity.AsFloat * GLRec.RelaProjectGL.ValidDeltaPrice.AsFloat;
  755. end;
  756. finally
  757. vGLs.Free;
  758. end;
  759. end;
  760. procedure TStageData.CalculatePriceMargin(ABillsID: Integer);
  761. var
  762. Rec: TStageRecord;
  763. fPM, fPMDiffer: Double;
  764. begin
  765. //if not HasPriceMarginBills then Exit;
  766. Rec := StageRecord(ABillsID);
  767. if not Assigned(Rec) then Exit;
  768. fPM := TotalPriceRoundTo(Rec.GatherQuantity.AsFloat * GetBillsUnitPriceMargin(ABillsID));
  769. if fPM <> Rec.PM_TotalPrice.AsFloat then
  770. begin
  771. fPMDiffer := fPM - Rec.PM_TotalPrice.AsFloat;
  772. Rec.PM_TotalPrice.AsFloat := fPM;
  773. UpdateParentPriceMargin(ABillsID, fPMDiffer);
  774. //UpdatePriceMarginNode(fPMDiffer);
  775. with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do
  776. UpdateRecordPM(ABillsID, fPMDiffer);
  777. end;
  778. end;
  779. procedure TStageData.UpdatePriceMarginNode(ADiffer: Double);
  780. var
  781. Rec: TStageRecord;
  782. begin
  783. Rec := StageRecordWithAdd(iPriceMarginID);
  784. Rec.AddDifferValue(Rec.GatherTotalPrice, ADiffer);
  785. Rec.AddDifferValue(Rec.EndGatherTotalPrice, ADiffer);
  786. UpdateParentRecord(iPriceMarginID, ADiffer, 'GatherTotalPrice');
  787. with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do
  788. UpdateGather(Rec.BillsID.AsInteger, ADiffer);
  789. end;
  790. procedure TStageData.UpdateParentPriceMargin(ABillsID: Integer; ADiffer: Double);
  791. var
  792. iParentID: Integer;
  793. Rec: TStageRecord;
  794. begin
  795. iParentID := MainBillsTree.FindNode(ABillsID).ParentID;
  796. if iParentID = -1 then Exit;
  797. Rec := StageRecordWithAdd(iParentID);
  798. Rec.PM_TotalPrice.AsFloat := TotalPriceRoundTo(Rec.PM_TotalPrice.AsFloat + ADiffer);
  799. UpdateParentPriceMargin(iParentID, ADiffer);
  800. end;
  801. function TStageData.StageRecordWithAdd(ABillsID: Integer): TStageRecord;
  802. begin
  803. Result := StageRecord(ABillsID);
  804. if not Assigned(Result) then
  805. Result := AddStageRecord(ABillsID);
  806. end;
  807. procedure TStageData.UpdateProjectGL(ABillsID: Integer);
  808. var
  809. iLeafXmjID: Integer;
  810. vGLs: TList;
  811. begin
  812. vGLs := TList.Create;
  813. try
  814. with TProjectData(TPhaseData(FPhaseData).ProjectData) do
  815. begin
  816. iLeafXmjID := BillsCompileData.GetLeafXmjParentID(ABillsID);
  817. LeafXmjGlData.CalculateLeafXmj(iLeafXmjID);
  818. DetailGLData.LoadDetailGLs(ABillsID, vGLs);
  819. ProjectGLData.CalculateGLs_PM(vGLs);
  820. ProjectGLData.RefreshGatherData;
  821. end;
  822. finally
  823. vGLs.Free;
  824. end;
  825. end;
  826. procedure TStageData.CalculateSpecialLeaf(ANode: TMeasureBillsIDTreeNode);
  827. procedure GatherPriceMargin(ARec: TStageRecord);
  828. begin
  829. with TProjectData(TPhaseData(FPhaseData).ProjectData).ProjectGLData do
  830. ARec.SetFloatValue(ARec.GatherTotalPrice, PM_TotalPrice);
  831. ARec.SetFloatValue(ARec.EndGatherTotalPrice,
  832. ARec.PreGatherTotalPrice.AsFloat + ARec.GatherTotalPrice.AsFloat);
  833. end;
  834. procedure GatherMaterial(ARec: TStageRecord);
  835. begin
  836. with TProjectData(TPhaseData(FPhaseData).ProjectData).ProjectGLData do
  837. ARec.SetFloatValue(ARec.GatherTotalPrice, UsedTotalPrice);
  838. ARec.SetFloatValue(ARec.EndGatherTotalPrice,
  839. ARec.PreGatherTotalPrice.AsFloat + ARec.GatherTotalPrice.AsFloat);
  840. end;
  841. var
  842. StageRec: TStageRecord;
  843. begin
  844. StageRec := ANode.StageRec;
  845. if not Assigned(StageRec) then Exit;
  846. case ANode.ID of
  847. iPriceMarginID: GatherPriceMargin(StageRec);
  848. iMaterialID: GatherMaterial(StageRec);
  849. end;
  850. end;
  851. function TStageData.HasPriceMarginBills: Boolean;
  852. var
  853. vPM_Node: TsdIDTreeNode;
  854. begin
  855. vPM_Node := MainBillsTree.FindNode(iPriceMarginID);
  856. Result := Assigned(vPM_Node);
  857. end;
  858. procedure TStageData.CalculateGather(ABillsID: Integer);
  859. var
  860. Rec: TStageRecord;
  861. fQuantity, fTotalPrice: Double;
  862. begin
  863. Rec := TStageRecord(sddStage.FindKey('idxBID', ABillsID));
  864. if not Assigned(Rec) then Exit;
  865. fQuantity := QuantityRoundTo(Rec.DealQuantity.AsFloat + Rec.QcQuantity.AsFloat) - Rec.GatherQuantity.AsFloat;
  866. fTotalPrice := TotalPriceRoundTo(
  867. Rec.DealTotalPrice.AsFloat + Rec.QcTotalPrice.AsFloat + Rec.PcTotalPrice.AsFloat) - Rec.GatherTotalPrice.AsFloat;
  868. UpdateComplete(ABillsID, fQuantity, fTotalPrice);
  869. end;
  870. procedure TStageData.CalculateMaterialNode;
  871. var
  872. Rec: TStageRecord;
  873. fDiffer: Double;
  874. begin
  875. if not HasMaterialBills then Exit;
  876. with TProjectData(TPhaseData(FPhaseData).ProjectData) do
  877. begin
  878. Rec := StageRecord(iMaterialID);
  879. if not Assigned(Rec) then
  880. Rec := AddStageRecord(iMaterialID);
  881. fDiffer := TotalPriceRoundTo(ProjectGLData.UsedTotalPrice - Rec.GatherTotalPrice.AsFloat);
  882. if fDiffer <> 0 then
  883. begin
  884. Rec.AddDifferValue(Rec.GatherTotalPrice, fDiffer);
  885. Rec.AddDifferValue(Rec.EndGatherTotalPrice, fDiffer);
  886. UpdateParentRecord(Rec.BillsID.AsInteger, fDiffer, 'GatherTotalPrice');
  887. end;
  888. end;
  889. end;
  890. function TStageData.HasMaterialBills: Boolean;
  891. var
  892. vNode: TsdIDTreeNode;
  893. begin
  894. vNode := MainBillsTree.FindNode(iMaterialID);
  895. Result := Assigned(vNode);
  896. end;
  897. end.