StageDm.pas 35 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040
  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. with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do
  737. UpdateGather(iPriceMarginID, fDiffer);
  738. UpdateParentRecord(Rec.BillsID.AsInteger, fDiffer, 'GatherTotalPrice');
  739. end;
  740. end;
  741. end;
  742. function TStageData.GetBillsUnitPriceMargin(ABillsID: Integer): Double;
  743. var
  744. vGLs: TList;
  745. iGL: Integer;
  746. GLRec: TDetailGLRecord;
  747. begin
  748. Result := 0;
  749. vGLs := TList.Create;
  750. try
  751. with TProjectData(TPhaseData(FPhaseData).ProjectData).DetailGLData do
  752. LoadDetailGLs(ABillsID, vGLs);
  753. for iGL := 0 to vGLs.Count - 1 do
  754. begin
  755. GLRec := TDetailGLRecord(vGLs.Items[iGL]);
  756. Result := Result + GLRec.Quantity.AsFloat * GLRec.RelaProjectGL.ValidDeltaPrice.AsFloat;
  757. end;
  758. finally
  759. vGLs.Free;
  760. end;
  761. end;
  762. procedure TStageData.CalculatePriceMargin(ABillsID: Integer);
  763. var
  764. Rec: TStageRecord;
  765. fPM, fPMDiffer: Double;
  766. begin
  767. //if not HasPriceMarginBills then Exit;
  768. Rec := StageRecord(ABillsID);
  769. if not Assigned(Rec) then Exit;
  770. fPM := TotalPriceRoundTo(Rec.GatherQuantity.AsFloat * GetBillsUnitPriceMargin(ABillsID));
  771. if fPM <> Rec.PM_TotalPrice.AsFloat then
  772. begin
  773. fPMDiffer := fPM - Rec.PM_TotalPrice.AsFloat;
  774. Rec.PM_TotalPrice.AsFloat := fPM;
  775. UpdateParentPriceMargin(ABillsID, fPMDiffer);
  776. //UpdatePriceMarginNode(fPMDiffer);
  777. with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do
  778. UpdateRecordPM(ABillsID, fPMDiffer);
  779. end;
  780. end;
  781. procedure TStageData.UpdatePriceMarginNode(ADiffer: Double);
  782. var
  783. Rec: TStageRecord;
  784. begin
  785. Rec := StageRecordWithAdd(iPriceMarginID);
  786. Rec.AddDifferValue(Rec.GatherTotalPrice, ADiffer);
  787. Rec.AddDifferValue(Rec.EndGatherTotalPrice, ADiffer);
  788. UpdateParentRecord(iPriceMarginID, ADiffer, 'GatherTotalPrice');
  789. with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do
  790. UpdateGather(Rec.BillsID.AsInteger, ADiffer);
  791. end;
  792. procedure TStageData.UpdateParentPriceMargin(ABillsID: Integer; ADiffer: Double);
  793. var
  794. iParentID: Integer;
  795. Rec: TStageRecord;
  796. begin
  797. iParentID := MainBillsTree.FindNode(ABillsID).ParentID;
  798. if iParentID = -1 then Exit;
  799. Rec := StageRecordWithAdd(iParentID);
  800. Rec.PM_TotalPrice.AsFloat := TotalPriceRoundTo(Rec.PM_TotalPrice.AsFloat + ADiffer);
  801. UpdateParentPriceMargin(iParentID, ADiffer);
  802. end;
  803. function TStageData.StageRecordWithAdd(ABillsID: Integer): TStageRecord;
  804. begin
  805. Result := StageRecord(ABillsID);
  806. if not Assigned(Result) then
  807. Result := AddStageRecord(ABillsID);
  808. end;
  809. procedure TStageData.UpdateProjectGL(ABillsID: Integer);
  810. var
  811. iLeafXmjID: Integer;
  812. vGLs: TList;
  813. begin
  814. vGLs := TList.Create;
  815. try
  816. with TProjectData(TPhaseData(FPhaseData).ProjectData) do
  817. begin
  818. iLeafXmjID := BillsCompileData.GetLeafXmjParentID(ABillsID);
  819. LeafXmjGlData.CalculateLeafXmj(iLeafXmjID);
  820. DetailGLData.LoadDetailGLs(ABillsID, vGLs);
  821. ProjectGLData.CalculateGLs_PM(vGLs);
  822. ProjectGLData.RefreshGatherData;
  823. end;
  824. finally
  825. vGLs.Free;
  826. end;
  827. end;
  828. procedure TStageData.CalculateSpecialLeaf(ANode: TMeasureBillsIDTreeNode);
  829. procedure GatherPriceMargin(ARec: TStageRecord);
  830. begin
  831. with TProjectData(TPhaseData(FPhaseData).ProjectData).ProjectGLData do
  832. ARec.SetFloatValue(ARec.GatherTotalPrice, PM_TotalPrice);
  833. ARec.SetFloatValue(ARec.EndGatherTotalPrice,
  834. ARec.PreGatherTotalPrice.AsFloat + ARec.GatherTotalPrice.AsFloat);
  835. end;
  836. procedure GatherMaterial(ARec: TStageRecord);
  837. begin
  838. with TProjectData(TPhaseData(FPhaseData).ProjectData).ProjectGLData do
  839. ARec.SetFloatValue(ARec.GatherTotalPrice, UsedTotalPrice);
  840. ARec.SetFloatValue(ARec.EndGatherTotalPrice,
  841. ARec.PreGatherTotalPrice.AsFloat + ARec.GatherTotalPrice.AsFloat);
  842. end;
  843. var
  844. StageRec: TStageRecord;
  845. begin
  846. StageRec := ANode.StageRec;
  847. if not Assigned(StageRec) then Exit;
  848. case ANode.ID of
  849. iPriceMarginID: GatherPriceMargin(StageRec);
  850. iMaterialID: GatherMaterial(StageRec);
  851. end;
  852. end;
  853. function TStageData.HasPriceMarginBills: Boolean;
  854. var
  855. vPM_Node: TsdIDTreeNode;
  856. begin
  857. vPM_Node := MainBillsTree.FindNode(iPriceMarginID);
  858. Result := Assigned(vPM_Node);
  859. end;
  860. procedure TStageData.CalculateGather(ABillsID: Integer);
  861. var
  862. Rec: TStageRecord;
  863. fQuantity, fTotalPrice: Double;
  864. begin
  865. Rec := TStageRecord(sddStage.FindKey('idxBID', ABillsID));
  866. if not Assigned(Rec) then Exit;
  867. fQuantity := QuantityRoundTo(Rec.DealQuantity.AsFloat + Rec.QcQuantity.AsFloat) - Rec.GatherQuantity.AsFloat;
  868. fTotalPrice := TotalPriceRoundTo(
  869. Rec.DealTotalPrice.AsFloat + Rec.QcTotalPrice.AsFloat + Rec.PcTotalPrice.AsFloat) - Rec.GatherTotalPrice.AsFloat;
  870. UpdateComplete(ABillsID, fQuantity, fTotalPrice);
  871. end;
  872. procedure TStageData.CalculateMaterialNode;
  873. var
  874. Rec: TStageRecord;
  875. fDiffer: Double;
  876. begin
  877. if not HasMaterialBills then Exit;
  878. with TProjectData(TPhaseData(FPhaseData).ProjectData) do
  879. begin
  880. Rec := StageRecord(iMaterialID);
  881. if not Assigned(Rec) then
  882. Rec := AddStageRecord(iMaterialID);
  883. fDiffer := TotalPriceRoundTo(ProjectGLData.UsedTotalPrice - Rec.GatherTotalPrice.AsFloat);
  884. if fDiffer <> 0 then
  885. begin
  886. Rec.AddDifferValue(Rec.GatherTotalPrice, fDiffer);
  887. Rec.AddDifferValue(Rec.EndGatherTotalPrice, fDiffer);
  888. with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do
  889. UpdateGather(iMaterialID, fDiffer)
  890. UpdateParentRecord(Rec.BillsID.AsInteger, fDiffer, 'GatherTotalPrice');
  891. end;
  892. end;
  893. end;
  894. function TStageData.HasMaterialBills: Boolean;
  895. var
  896. vNode: TsdIDTreeNode;
  897. begin
  898. vNode := MainBillsTree.FindNode(iMaterialID);
  899. Result := Assigned(vNode);
  900. end;
  901. end.