StageDm.pas 35 KB

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