BillsCompileDm.pas 36 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168
  1. unit BillsCompileDm;
  2. interface
  3. uses
  4. BillsDm, StandardBillsFme,
  5. SysUtils, Classes, sdDB, BillsTree, sdIDTree;
  6. type
  7. TBillsCompileData = class(TDataModule)
  8. sdvBillsCompile: TsdDataView;
  9. procedure sdvBillsCompileGetText(var Text: String;
  10. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  11. DisplayText: Boolean);
  12. procedure sdvBillsCompileAfterValueChanged(AValue: TsdValue);
  13. procedure sdvBillsCompileBeforeValueChange(AValue: TsdValue;
  14. const NewValue: Variant; var Allow: Boolean);
  15. procedure sdvBillsCompileSetText(var Text: String;
  16. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  17. var Allow: Boolean);
  18. procedure sdvBillsCompileAfterOpen(Sender: TObject);
  19. procedure sdvBillsCompileAfterClose(Sender: TObject);
  20. procedure sdvBillsCompileAfterAddRecord(ARecord: TsdDataRecord);
  21. procedure sdvBillsCompileCurrentChanged(ARecord: TsdDataRecord);
  22. private
  23. FProjectData: TObject;
  24. FBillsData: TBillsData;
  25. FBillsCompileTree: TBillsIDTree;
  26. FOnRecChange: TRecChangeEvent;
  27. function GatherChildrenOrg(ANode: TsdIDTreeNode): Double;
  28. procedure UpdateRecordOrg(ABillsID: Integer; ATotalPrice: Double);
  29. function FindChild(AParentNode, ANode: TsdIDTreeNode): TsdIDTreeNode;
  30. function InsertChild(AParentNode, ANode: TsdIDTreeNode): TsdIDTreeNode;
  31. function CompareNodeCode(ANode, ACompareNode: TsdIDTreeNode): Integer;
  32. function GetNextSiblingID(AParent, ANode: TsdIDTreeNode): Integer;
  33. function IsSameNode(ANode, ACompareNode: TsdIDTreeNode): Boolean;
  34. function GetTopParentNode(ANode: TsdIDTreeNode; ALevel: Integer): TsdIDTreeNode;
  35. procedure AddXmjBillsFromLib(AStdBillsNode: TsdIDTreeNode);
  36. function CanAddGclBills: Boolean;
  37. function GetGclBillsParent(AChildNode: TsdIDTreeNode): TsdIDTreeNode;
  38. procedure AddGclBillsFromLib(AStdBillsNode: TsdIDTreeNode);
  39. procedure DoOnAfterDeleteNode(AParent: TsdIDTreeNode);
  40. function GatherChildren(ANode: TsdIDTreeNode; const AFieldName: string): Double;
  41. procedure UpdateParent(ABillsID: Integer; ADifferTotalPrice: Double; const AFieldName: string);
  42. // 经济指标[与其他节点无关]
  43. procedure CalculateDesignPrice(ANode: TBillsIDTreeNode);
  44. // 施工图原设计[增量]
  45. procedure CalculateOrg(ABillsID: Integer);
  46. // 设计错漏增减[增量]
  47. procedure CalculateMis(ABillsID: Integer);
  48. // 其他错漏增减[增量]
  49. procedure CalculateOth(ABillsID: Integer);
  50. procedure CalculateTotal(ABillsID: Integer);
  51. procedure CalculateLeaf(ANode: TBillsIDTreeNode);
  52. procedure GatherNode(ANode: TBillsIDTreeNode);
  53. procedure CalculateBills(ANode: TsdIDTreeNode);
  54. function GetActive: Boolean;
  55. procedure SetOnRecChange(const Value: TRecChangeEvent);
  56. public
  57. constructor Create(AProjectData: TObject);
  58. destructor Destroy; override;
  59. procedure Open;
  60. procedure Close;
  61. procedure ReConnectTree;
  62. procedure AddBillsFromLib(ANode: TsdIDTreeNode; ABillsType: TBillsType);
  63. procedure AddBillsFromDealBills(ARec: TsdDataRecord);
  64. procedure Calculate(ABillsID: Integer);
  65. procedure CalculateAll;
  66. function GetLeafXmjParentID(ABillsID: Integer): Integer;
  67. procedure ExpandNodeTo(ALevel: Integer);
  68. procedure ExpandXmjNode;
  69. procedure ExpandPegXmjNode;
  70. procedure ReorderChildrenCode(ANode: TsdIDTreeNode);
  71. // 所有解锁的节点全部重新锁定
  72. procedure ReLockBaseData;
  73. property ProjectData: TObject read FProjectData;
  74. property BillsData: TBillsData read FBillsData;
  75. property BillsCompileTree: TBillsIDTree read FBillsCompileTree;
  76. property Active: Boolean read GetActive;
  77. property OnRecChange: TRecChangeEvent read FOnRecChange write SetOnRecChange;
  78. end;
  79. implementation
  80. uses
  81. ProjectData, Math, ZhAPI, UtilMethods, ConstUnit, mDataRecord;
  82. {$R *.dfm}
  83. { TBillsCompileData }
  84. constructor TBillsCompileData.Create(AProjectData: TObject);
  85. begin
  86. inherited Create(nil);
  87. FProjectData := AProjectData;
  88. FBillsData := TProjectData(FProjectData).BillsData;
  89. FBillsCompileTree := TBillsIDTree.Create;
  90. FBillsCompileTree.KeyFieldName := 'ID';
  91. FBillsCompileTree.ParentFieldName := 'ParentID';
  92. FBillsCompileTree.NextSiblingFieldName := 'NextSiblingID';
  93. FBillsCompileTree.AutoCreateKeyID := True;
  94. FBillsCompileTree.AutoExpand := True;
  95. FBillsCompileTree.DataView := sdvBillsCompile;
  96. FBillsCompileTree.SeedID := Max(FBillsCompileTree.SeedID, 100);
  97. FBillsCompileTree.DoOnAfterDeleteNode := DoOnAfterDeleteNode;
  98. FBillsCompileTree.OnReCalcParent := Calculate;
  99. end;
  100. destructor TBillsCompileData.Destroy;
  101. begin
  102. FBillsCompileTree.Free;
  103. inherited;
  104. end;
  105. procedure TBillsCompileData.Open;
  106. begin
  107. sdvBillsCompile.DataSet := TProjectData(FProjectData).BillsData.sddBills;
  108. sdvBillsCompile.Open;
  109. FBillsCompileTree.SeedID := Max(FBillsCompileTree.SeedID, 100);
  110. end;
  111. procedure TBillsCompileData.ReConnectTree;
  112. begin
  113. FBillsCompileTree.DataView := nil;
  114. FBillsCompileTree.DataView := sdvBillsCompile;
  115. end;
  116. procedure TBillsCompileData.sdvBillsCompileGetText(var Text: String;
  117. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  118. DisplayText: Boolean);
  119. function GetQtyEditText(const AFormulaField: string): Boolean;
  120. begin
  121. end;
  122. procedure GetEditText;
  123. var
  124. sFormula: string;
  125. sFormulaField: string;
  126. begin
  127. sFormula := '';
  128. if ARecord.ValueByName('CalcType').AsInteger = 0 then
  129. begin
  130. if SameText('OrgQuantity', AColumn.FieldName) then
  131. sFormula := ARecord.ValueByName('OrgFormula').AsString
  132. else if SameText('MisQuantity', AColumn.FieldName) then
  133. sFormula := ARecord.ValueByName('MisFormula').AsString
  134. else if SameText('OthQuantity', AColumn.FieldName) then
  135. sFormula := ARecord.ValueByName('OthFormula').AsString;
  136. end
  137. else if ARecord.ValueByName('CalcType').AsInteger = 1 then
  138. begin
  139. if SameText('OrgTotalPrice', AColumn.FieldName) then
  140. sFormula := ARecord.ValueByName('OrgFormula').AsString
  141. else if SameText('MisTotalPrice', AColumn.FieldName) then
  142. sFormula := ARecord.ValueByName('MisFormula').AsString
  143. else if SameText('OthTotalPrice', AColumn.FieldName) then
  144. sFormula := ARecord.ValueByName('OthFormula').AsString;
  145. end;
  146. if sFormula <> '' then
  147. Text := sFormula;
  148. end;
  149. procedure GetDisplayText;
  150. begin
  151. if (Pos('Price', AColumn.FieldName) > 0) or
  152. (Pos('Quantity', AColumn.FieldName) > 0) then
  153. begin
  154. if not Assigned(AValue) or (AValue.AsFloat = 0) then
  155. Text := '';
  156. end;
  157. end;
  158. begin
  159. if DisplayText then
  160. GetDisplayText
  161. else
  162. GetEditText;
  163. end;
  164. procedure TBillsCompileData.ExpandNodeTo(ALevel: Integer);
  165. begin
  166. BillsCompileTree.ExpandLevel := ALevel;
  167. end;
  168. procedure TBillsCompileData.ExpandXmjNode;
  169. var
  170. iIndex: Integer;
  171. stnNode: TsdIDTreeNode;
  172. begin
  173. for iIndex := 0 to BillsCompileTree.Count - 1 do
  174. begin
  175. stnNode := BillsCompileTree.Items[iIndex];
  176. if (stnNode.ParentID <> -1) then
  177. stnNode.Parent.Expanded := stnNode.Rec.ValueByName('B_Code').AsString = '';
  178. end;
  179. end;
  180. procedure TBillsCompileData.sdvBillsCompileAfterValueChanged(
  181. AValue: TsdValue);
  182. procedure ResetChildrenLockedInfo(ANode: TsdIDTreeNode; ALockedInfo: Boolean);
  183. var
  184. iChild: Integer;
  185. begin
  186. if not Assigned(ANode) then Exit;
  187. if ANode.Rec.ValueByName('LockedLevel').AsBoolean then
  188. ANode.Rec.ValueByName('LockedInfo').AsBoolean := ALockedInfo;
  189. if ANode.HasChildren then
  190. for iChild := 0 to ANode.ChildCount - 1 do
  191. ResetChildrenLockedInfo(ANode.ChildNodes[iChild], ALockedInfo);
  192. end;
  193. var
  194. stnNode: TsdIDTreeNode;
  195. begin
  196. if SameText(AValue.FieldName, 'OrgQuantity') or
  197. SameText(AValue.FieldName, 'OrgTotalPrice') then
  198. CalculateOrg(AValue.Owner.ValueByName('ID').AsInteger)
  199. else if SameText(AValue.FieldName, 'MisQuantity') or
  200. SameText(AValue.FieldName, 'MisTotalPrice') then
  201. CalculateMis(AValue.Owner.ValueByName('ID').AsInteger)
  202. else if SameText(AValue.FieldName, 'OthQuantity') or
  203. SameText(AValue.FieldName, 'OthTotalPrice') then
  204. CalculateOth(AValue.Owner.ValueByName('ID').AsInteger)
  205. else if SameText(AValue.FieldName, 'Price') or
  206. SameText(AValue.FieldName, 'DgnQuantity1') then
  207. CalculateTotal(AValue.Owner.ValueByName('ID').AsInteger);
  208. if (AValue.FieldName = 'LockedInfo') then
  209. begin
  210. stnNode := BillsCompileTree.FindNode(AValue.Owner.ValueByName('ID').AsInteger);
  211. ResetChildrenLockedInfo(stnNode, AValue.AsBoolean);
  212. end;
  213. end;
  214. function TBillsCompileData.GatherChildrenOrg(ANode: TsdIDTreeNode): Double;
  215. var
  216. iChild: Integer;
  217. begin
  218. if ANode = nil then Exit;
  219. if ANode.HasChildren and Assigned(ANode.FirstChild) then
  220. begin
  221. Result := 0;
  222. for iChild := 0 to ANode.ChildCount - 1 do
  223. Result := Result + GatherChildrenOrg(ANode.ChildNodes[iChild]);
  224. Result := TotalPriceRoundTo(Result);
  225. end
  226. else
  227. if Assigned(ANode.Rec) and Assigned(ANode.Rec.ValueByName('TotalPrice')) then
  228. Result := ANode.Rec.ValueByName('TotalPrice').AsFloat
  229. else
  230. Result := 0;
  231. end;
  232. procedure TBillsCompileData.UpdateRecordOrg(ABillsID: Integer;
  233. ATotalPrice: Double);
  234. var
  235. stnNode: TsdIDTreeNode;
  236. begin
  237. stnNode := BillsCompileTree.FindNode(ABillsID);
  238. if not Assigned(stnNode) then Exit;
  239. with stnNode.Rec do
  240. begin
  241. ValueByName('TotalPrice').AsFloat := TotalPriceRoundTo(
  242. ValueByName('TotalPrice').AsFloat + ATotalPrice);
  243. if ValueByName('DgnQuantity1').AsFloat <> 0 then
  244. ValueByName('DgnPrice').AsFloat := PriceRoundTo(
  245. ValueByName('TotalPrice').AsFloat/ValueByName('DgnQuantity1').AsFloat);
  246. end;
  247. UpdateRecordOrg(stnNode.ParentID, ATotalPrice);
  248. end;
  249. procedure TBillsCompileData.sdvBillsCompileBeforeValueChange(
  250. AValue: TsdValue; const NewValue: Variant; var Allow: Boolean);
  251. begin
  252. if SameText(AValue.FieldName, 'OrgQuantity') or
  253. SameText(AValue.FieldName, 'MisQuantity') or
  254. SameText(AValue.FieldName, 'OthQuantity') or
  255. SameText(AValue.FieldName, 'OrgTotalPrice') or
  256. SameText(AValue.FieldName, 'MisTotalPrice') or
  257. SameText(AValue.FieldName, 'OthTotalPrice') or
  258. SameText(AValue.FieldName, 'Price') then
  259. begin
  260. TBillsRecord(AValue.Owner).CacheOrgTP := AValue.Owner.ValueByName('OrgTotalPrice').AsFloat;
  261. TBillsRecord(AValue.Owner).CacheMisTP := AValue.Owner.ValueByName('MisTotalPrice').AsFloat;
  262. TBillsRecord(AValue.Owner).CacheOthTP := AValue.Owner.ValueByName('OthTotalPrice').AsFloat;
  263. end;
  264. end;
  265. procedure TBillsCompileData.CalculateAll;
  266. procedure RecursiveCalc(ANode: TsdIDTreeNode);
  267. begin
  268. if not Assigned(ANode) then Exit;
  269. if ANode.HasChildren then
  270. begin
  271. RecursiveCalc(ANode.FirstChild);
  272. GatherNode(TBillsIDTreeNode(ANode));
  273. end
  274. else
  275. CalculateLeaf(TBillsIDTreeNode(ANode));
  276. RecursiveCalc(ANode.NextSibling);
  277. end;
  278. procedure BeginCalc;
  279. begin
  280. sdvBillsCompile.BeforeValueChange := nil;
  281. sdvBillsCompile.AfterValueChanged := nil;
  282. end;
  283. procedure EndCalc;
  284. begin
  285. sdvBillsCompile.BeforeValueChange := sdvBillsCompileBeforeValueChange;
  286. sdvBillsCompile.AfterValueChanged := sdvBillsCompileAfterValueChanged;
  287. end;
  288. begin
  289. BeginCalc;
  290. try
  291. RecursiveCalc(BillsCompileTree.FirstNode);
  292. finally
  293. EndCalc;
  294. end;
  295. end;
  296. procedure TBillsCompileData.AddBillsFromLib(ANode: TsdIDTreeNode;
  297. ABillsType: TBillsType);
  298. begin
  299. if not Assigned(ANode) then Exit;
  300. if ABillsType = btXm then
  301. AddXmjBillsFromLib(ANode)
  302. else if ABillsType = btGcl then
  303. AddGclBillsFromLib(ANode);
  304. end;
  305. procedure TBillsCompileData.AddGclBillsFromLib(
  306. AStdBillsNode: TsdIDTreeNode);
  307. var
  308. stnParent, stnStdNode: TsdIDTreeNode;
  309. iLevel: Integer;
  310. begin
  311. if not CanAddGclBills then
  312. raise Exception.Create('当前节点下不可添加工程量清单!');
  313. stnParent := GetGclBillsParent(BillsCompileTree.Selected);
  314. if TBillsIDTreeNode(stnParent).HasLedger or
  315. (not stnParent.HasChildren and TBillsIDTreeNode(stnParent).HasMeasure) then
  316. raise Exception.Create('当前节点不可添加工程量清单!');
  317. stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level);
  318. for iLevel := 1 to AStdBillsNode.Level + 1 do
  319. begin
  320. if stnStdNode.Rec.ValueByName('B_Code').AsString <> '' then
  321. if FindChild(stnParent, stnStdNode) <> nil then
  322. stnParent := FindChild(stnParent, stnStdNode)
  323. else
  324. stnParent := InsertChild(stnParent, stnStdNode);
  325. stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level - iLevel);
  326. end;
  327. end;
  328. procedure TBillsCompileData.AddXmjBillsFromLib(
  329. AStdBillsNode: TsdIDTreeNode);
  330. var
  331. stnStdNode, stnCurNode: TsdIDTreeNode;
  332. iLevel: Integer;
  333. begin
  334. stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level);
  335. stnCurNode := nil;
  336. for iLevel := 1 to AStdBillsNode.Level + 1 do
  337. begin
  338. if FindChild(stnCurNode, stnStdNode) <> nil then
  339. stnCurNode := FindChild(stnCurNode, stnStdNode)
  340. else
  341. begin
  342. if TBillsIDTreeNode(stnCurNode).HasLedger or
  343. (not stnCurNode.HasChildren and TBillsIDTreeNode(stnCurNode).HasMeasure) then
  344. raise Exception.Create('不可添加该项目节数据!')
  345. else
  346. stnCurNode := InsertChild(stnCurNode, stnStdNode);
  347. end;
  348. stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level - iLevel);
  349. end;
  350. end;
  351. function TBillsCompileData.CanAddGclBills: Boolean;
  352. function CheckChildrenHasXmj(ANode: TsdIDTreeNode): Boolean;
  353. var
  354. stnCurNode: TsdIDTreeNode;
  355. begin
  356. Result := False;
  357. if not ANode.HasChildren then Exit;
  358. stnCurNode := ANode.FirstChild;
  359. while not Result and Assigned(stnCurNode) do
  360. begin
  361. Result := Result or (stnCurNode.Rec.ValueByName('Code').AsString <> '');
  362. if stnCurNode.HasChildren then
  363. Result := Result or CheckChildrenHasXmj(stnCurNode);
  364. stnCurNode := stnCurNode.NextSibling;
  365. end;
  366. end;
  367. function CheckParentIsXmj(ANode: TsdIDTreeNode): Boolean;
  368. begin
  369. Result := False;
  370. if not Assigned(ANode) then Exit;
  371. Result := ANode.Rec.ValueByName('Code').AsString <> '';
  372. if not Result then
  373. Result := Result or CheckParentIsXmj(ANode.Parent);
  374. end;
  375. begin
  376. Result := False;
  377. if not Assigned(BillsCompileTree.Selected) then Exit;
  378. Result := CheckParentIsXmj(BillsCompileTree.Selected)
  379. and not CheckChildrenHasXmj(BillsCompileTree.Selected);
  380. end;
  381. function TBillsCompileData.CompareNodeCode(ANode,
  382. ACompareNode: TsdIDTreeNode): Integer;
  383. begin
  384. if ANode.Rec.ValueByName('Code').AsString <> '' then
  385. Result := CompareCode(ANode.Rec.ValueByName('Code').AsString,
  386. ACompareNode.Rec.ValueByName('Code').AsString)
  387. else if ANode.Rec.ValueByName('B_Code').AsString <> '' then
  388. Result := CompareCode(ANode.Rec.ValueByName('B_Code').AsString,
  389. ACompareNode.Rec.ValueByName('B_Code').AsString);
  390. end;
  391. function TBillsCompileData.GetGclBillsParent(
  392. AChildNode: TsdIDTreeNode): TsdIDTreeNode;
  393. begin
  394. if AChildNode.Rec.ValueByName('B_Code').AsString <> '' then
  395. Result := GetGclBillsParent(AChildNode.Parent)
  396. else
  397. Result := AChildNode;
  398. end;
  399. function TBillsCompileData.GetNextSiblingID(AParent,
  400. ANode: TsdIDTreeNode): Integer;
  401. var
  402. stnCurNode: TsdIDTreeNode;
  403. begin
  404. Result := -1;
  405. if Assigned(AParent) then
  406. stnCurNode := AParent.FirstChild
  407. else
  408. stnCurNode := BillsCompileTree.FirstNode;
  409. if not Assigned(stnCurNode) then Exit;
  410. while Assigned(stnCurNode) do
  411. begin
  412. if CompareNodeCode(stnCurNode, ANode) >= 0 then
  413. begin
  414. Result := stnCurNode.ID;
  415. Exit;
  416. end;
  417. stnCurNode := stnCurNode.NextSibling;
  418. end;
  419. end;
  420. function TBillsCompileData.GetTopParentNode(ANode: TsdIDTreeNode;
  421. ALevel: Integer): TsdIDTreeNode;
  422. begin
  423. Result := ANode;
  424. while Assigned(Result.Parent) and (Result.Level + ALevel > ANode.Level) do
  425. Result := Result.Parent;
  426. end;
  427. function TBillsCompileData.IsSameNode(ANode,
  428. ACompareNode: TsdIDTreeNode): Boolean;
  429. begin
  430. Result := (ANode.Rec.ValueByName('Code').AsString = ACompareNode.Rec.ValueByName('Code').AsString)
  431. and (ANode.Rec.ValueByName('B_Code').AsString = ACompareNode.Rec.ValueByName('B_Code').AsString)
  432. and (ANode.Rec.ValueByName('Name').AsString = ACompareNode.Rec.ValueByName('Name').AsString);
  433. end;
  434. function TBillsCompileData.FindChild(AParentNode,
  435. ANode: TsdIDTreeNode): TsdIDTreeNode;
  436. function FindSibling(AFirstNode, ANode: TsdIDTreeNode): TsdIDTreeNode;
  437. var
  438. stnCurNode: TsdIDTreeNode;
  439. begin
  440. Result := nil;
  441. stnCurNode := AFirstNode;
  442. while Assigned(stnCurNode) and not Assigned(Result) do
  443. begin
  444. if IsSameNode(ANode, stnCurNode) then
  445. Result := stnCurNode;
  446. stnCurNode := stnCurNode.NextSibling;
  447. end;
  448. end;
  449. begin
  450. if not Assigned(AParentNode) then
  451. Result := FindSibling(BillsCompileTree.FirstNode, ANode)
  452. else
  453. Result := FindSibling(AParentNode.FirstChild, ANode);
  454. end;
  455. function TBillsCompileData.InsertChild(AParentNode,
  456. ANode: TsdIDTreeNode): TsdIDTreeNode;
  457. var
  458. iNextSiblingID: Integer;
  459. begin
  460. iNextSiblingID := GetNextSiblingID(AParentNode, ANode);
  461. if Assigned(AParentNode) then
  462. Result := BillsCompileTree.Add(AParentNode.ID, iNextSiblingID)
  463. else
  464. Result := BillsCompileTree.Add(-1, iNextSiblingID);
  465. Result.Rec.ValueByName('Code').AsString := ANode.Rec.ValueByName('Code').AsString;
  466. Result.Rec.ValueByName('B_Code').AsString := ANode.Rec.ValueByName('B_Code').AsString;
  467. Result.Rec.ValueByName('Name').AsString := ANode.Rec.ValueByName('Name').AsString;
  468. Result.Rec.ValueByName('Units').AsString := ANode.Rec.ValueByName('Unit').AsString;
  469. end;
  470. procedure TBillsCompileData.sdvBillsCompileSetText(var Text: String;
  471. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  472. var Allow: Boolean);
  473. procedure SetTextErrorHint(const AHint: string);
  474. begin
  475. ErrorMessage(AHint);
  476. Allow := False;
  477. end;
  478. procedure SetQuantity(const AFieldName: string);
  479. var
  480. sPre: string;
  481. begin
  482. sPre := StringReplace(AFieldName, 'Quantity', '', [rfIgnoreCase, rfReplaceAll]);
  483. if CheckStringNull(Text) or CheckNumeric(Text) then
  484. Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)))
  485. else
  486. begin
  487. ARecord.ValueByName(sPre + 'Formula').AsString := Text;
  488. Text := FloatToStr(QuantityRoundTo(EvaluateExprs(Text)));
  489. end;
  490. ARecord.ValueByName('CalcType').AsInteger := 0;
  491. end;
  492. procedure SetTotalPrice(const AFieldName: string);
  493. var
  494. sPre: string;
  495. begin
  496. sPre := StringReplace(AFieldName, 'TotalPrice', '', [rfIgnoreCase, rfReplaceAll]);
  497. if CheckStringNull(Text) or CheckNumeric(Text) then
  498. Text := FloatToStr(TotalPriceRoundTo(StrToFloatDef(Text, 0)))
  499. else
  500. begin
  501. ARecord.ValueByName(sPre + 'Formula').AsString := Text;
  502. Text := FloatToStr(TotalPriceRoundTo(EvaluateExprs(Text)));
  503. end;
  504. ARecord.ValueByName('CalcType').AsInteger := 1;
  505. end;
  506. procedure SetDgnQuantity;
  507. begin
  508. Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)));
  509. end;
  510. procedure SetPrice;
  511. begin
  512. Text := FloatToStr(PriceRoundTo(StrToFloatDef(Text, 0)));
  513. ARecord.ValueByName('CalcType').AsInteger := 0;
  514. end;
  515. procedure DoCurChanged;
  516. begin
  517. if SameText(AColumn.FieldName, 'OrgQuantity') or
  518. SameText(AColumn.FieldName, 'MisQuantity') or
  519. SameText(AColumn.FieldName, 'OthQuantity')then
  520. SetQuantity(AColumn.FieldName)
  521. else if SameText(AColumn.FieldName, 'OrgTotalPrice') or
  522. SameText(AColumn.FieldName, 'MisTotalPrice') or
  523. SameText(AColumn.FieldName, 'OthTotalPrice') then
  524. SetTotalPrice(AColumn.FieldName)
  525. else if Pos('DgnQuantity', AColumn.FieldName) = 1 then
  526. SetDgnQuantity
  527. else if SameText(AColumn.FieldName, 'Price') then
  528. SetPrice;
  529. end;
  530. procedure CheckLockedData;
  531. begin
  532. if SameText(AColumn.FieldName, 'Code') or
  533. SameText(AColumn.FieldName, 'B_Code') or
  534. SameText(AColumn.FieldName, 'Name') or
  535. SameText(AColumn.FieldName, 'Units') or
  536. SameText(AColumn.FieldName, 'Price') or
  537. SameText(AColumn.FieldName, 'OrgQuantity') or
  538. SameText(AColumn.FieldName, 'OrgTotalPrice') or
  539. SameText(AColumn.FieldName, 'MisQuantity') or
  540. SameText(AColumn.FieldName, 'MisTotalPrice') or
  541. SameText(AColumn.FieldName, 'OthQuantity') or
  542. SameText(AColumn.FieldName, 'OthTotalPrice') or
  543. SameText(AColumn.FieldName, 'DrawingCode')then
  544. if ARecord.ValueByName('LockedInfo').AsBoolean then
  545. SetTextErrorHint('清单信息已被锁定,不允许修改编号、名称、单位、清单单价、0号台账数量与金额、图号!');
  546. end;
  547. procedure CheckNodeWritable;
  548. var
  549. vNode: TBillsIDTreeNode;
  550. iCreatePhase: Integer;
  551. begin
  552. if not Allow then Exit;
  553. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ARecord.ValueByName('ID').AsInteger));
  554. iCreatePhase := vNode.Rec.ValueByName('CreatePhaseID').AsInteger;
  555. if vNode.ID = iPriceMarginID then
  556. SetTextErrorHint(sBills_PMHint);
  557. if vNode.HasChildren then
  558. begin
  559. if Text = '' then
  560. Exit
  561. else if ((Pos('Quantity', AColumn.FieldName) > 0) and (Pos('Dgn', AColumn.FieldName) <=0)) or
  562. (Pos('TotalPrice', AColumn.FieldName) > 0) then
  563. SetTextErrorHint('该清单有子计算项,不能直接修改!')
  564. else if (Pos('Price', AColumn.FieldName) > 0) then
  565. SetTextErrorHint('仅最底层清单可输入单价!');
  566. if not Allow then Exit;
  567. end
  568. else
  569. begin
  570. if SameText('OrgTotalPrice', AColumn.FieldName) or
  571. SameText('MisTotalPrice', AColumn.FieldName) or
  572. SameText('OthTotalPrice', AColumn.FieldName) then
  573. begin
  574. if not vNode.TotalPriceEnable then
  575. SetTextErrorHint('该清单不可直接输入金额,如需直接输入金额,请先清空所有数量、单价!');
  576. end;
  577. if not Allow then Exit;
  578. if SameText('Price', AColumn.FieldName) or
  579. SameText('OrgQuantity', AColumn.FieldName) or
  580. SameText('MisQuantity', AColumn.FieldName) or
  581. SameText('OthQuantity', AColumn.FieldName) then
  582. begin
  583. if not vNode.CountPriceEnable then
  584. SetTextErrorHint('该清单不可输入数量单价,如需使用数量×单价计算,请先清空所有直接输入的金额!');
  585. end;
  586. if not Allow then Exit;
  587. end;
  588. // 清单编号和项目节编号不可同时存在
  589. if SameText(AValue.FieldName, 'Code') then
  590. begin
  591. if AValue.Owner.ValueByName('B_Code').AsString <> '' then
  592. SetTextErrorHint('已存在清单编号,不可输入项目节编号!');
  593. end
  594. else if SameText(AValue.FieldName, 'B_Code') then
  595. begin
  596. if AValue.Owner.ValueByName('Code').AsString <> '' then
  597. SetTextErrorHint('已存在项目节编号,不可输入清单编号!');
  598. end
  599. //
  600. else if SameText(AValue.FieldName, 'Price') then
  601. begin
  602. if AValue.Owner.ValueByName('AddGatherTotalPrice').AsFloat <> 0 then
  603. SetTextErrorHint('该清单已经开始计量,不可修改单价!');
  604. end
  605. // 变更清单不可修改0号台账数据
  606. else if SameText(AValue.FieldName, 'OrgQuantity') or
  607. SameText(AValue.FieldName, 'OrgTotalPrice') or
  608. SameText(AValue.FieldName, 'MisQuantity') or
  609. SameText(AValue.FieldName, 'MisTotalPrice') or
  610. SameText(AValue.FieldName, 'OthQuantity') or
  611. SameText(AValue.FieldName, 'OthTotalPrice') then
  612. begin
  613. if AValue.Owner.ValueByName('IsMeasureAdd').AsBoolean then
  614. SetTextErrorHint('变更清单不可填写0号台账数量与金额');
  615. end;
  616. if not Allow then Exit;
  617. if SameText('Code', AColumn.FieldName) or
  618. SameText('B_Code', AColumn.FieldName) or
  619. SameText('Name', AColumn.FieldName) or
  620. SameText('Units', AColumn.FieldName) or
  621. SameText('Price', AColumn.FieldName) then
  622. if TBillsIDTreeNode(vNode).HasMeasure then
  623. SetTextErrorHint('该清单已经计量,不可修改清单编号');
  624. end;
  625. function CheckValidData: Boolean;
  626. begin
  627. Result := (AValue.AsString <> Text);
  628. if SameText(AColumn.FieldName, 'OrgQuantity') or
  629. SameText(AColumn.FieldName, 'OrgTotalPrice') or
  630. SameText(AColumn.FieldName, 'MisQuantity') or
  631. SameText(AColumn.FieldName, 'MisTotalPrice') or
  632. SameText(AColumn.FieldName, 'OthQuantity') or
  633. SameText(AColumn.FieldName, 'OthTotalPrice') or
  634. SameText(AColumn.FieldName, 'Price') then
  635. begin
  636. if (AValue.AsFloat = 0) and (Text = '') then
  637. Result := False;
  638. end;
  639. end;
  640. begin
  641. if not Assigned(AValue) then Exit;
  642. // 修改后数据与原数据相同则不提交
  643. if not CheckValidData then
  644. Allow := False;
  645. if not Allow then Exit;
  646. CheckLockedData;
  647. if not Allow then Exit;
  648. CheckNodeWritable;
  649. if not Allow then Exit;
  650. Text := Trim(Text);
  651. if Pos('=', Text) = 1 then
  652. Text := Copy(Text, 2, Length(Text) - 1);
  653. DoCurChanged;
  654. end;
  655. function TBillsCompileData.GetActive: Boolean;
  656. begin
  657. Result := sdvBillsCompile.Active;
  658. end;
  659. function TBillsCompileData.GetLeafXmjParentID(ABillsID: Integer): Integer;
  660. var
  661. stnNode: TsdIDTreeNode;
  662. begin
  663. stnNode := BillsCompileTree.FindNode(ABillsID);
  664. Result := GetGclBillsParent(stnNode).ID;
  665. end;
  666. procedure TBillsCompileData.sdvBillsCompileAfterOpen(Sender: TObject);
  667. begin
  668. BillsCompileTree.Active := True;
  669. end;
  670. procedure TBillsCompileData.sdvBillsCompileAfterClose(Sender: TObject);
  671. begin
  672. BillsCompileTree.Active := False;
  673. end;
  674. procedure TBillsCompileData.ReorderChildrenCode(ANode: TsdIDTreeNode);
  675. var
  676. iChild: Integer;
  677. sParentCode: string;
  678. stnChild: TsdIDTreeNode;
  679. begin
  680. if not Assigned(ANode) then Exit;
  681. sParentCode := ANode.Rec.ValueByName('Code').AsString;
  682. for iChild := 0 to ANode.ChildCount - 1 do
  683. begin
  684. stnChild := ANode.ChildNodes[iChild];
  685. if stnChild.Rec.ValueByName('Code').AsString <> '' then
  686. stnChild.Rec.ValueByName('Code').AsString := sParentCode + '-' + IntToStr(iChild + 1);
  687. ReorderChildrenCode(stnChild);
  688. end;
  689. end;
  690. procedure TBillsCompileData.sdvBillsCompileAfterAddRecord(
  691. ARecord: TsdDataRecord);
  692. begin
  693. // 解锁前,新增清单为变更清单,解锁后,新增清单为0号台账清单
  694. if TProjectData(FProjectData).ProjProperties.PhaseCount > 0 then
  695. ARecord.ValueByName('IsMeasureAdd').AsBoolean := not TProjectData(FProjectData).CanUnlockInfo;
  696. end;
  697. procedure TBillsCompileData.DoOnAfterDeleteNode(AParent: TsdIDTreeNode);
  698. begin
  699. if Assigned(AParent) and (AParent.ID > 0) then
  700. Calculate(AParent.ID);
  701. end;
  702. procedure TBillsCompileData.Close;
  703. begin
  704. sdvBillsCompile.Close;
  705. end;
  706. procedure TBillsCompileData.SetOnRecChange(const Value: TRecChangeEvent);
  707. begin
  708. FOnRecChange := Value;
  709. end;
  710. procedure TBillsCompileData.sdvBillsCompileCurrentChanged(
  711. ARecord: TsdDataRecord);
  712. begin
  713. if Assigned(FOnRecChange) then
  714. FOnRecChange(ARecord);
  715. end;
  716. procedure TBillsCompileData.ReLockBaseData;
  717. procedure LockNodeBaseData(ANode: TsdIDTreeNode);
  718. begin
  719. if not Assigned(ANode) then Exit;
  720. if ANode.Rec.ValueByName('LockedLevel').AsBoolean then
  721. if not ANode.Rec.ValueByName('LockedInfo').AsBoolean then
  722. ANode.Rec.ValueByName('LockedInfo').AsBoolean := True;
  723. LockNodeBaseData(ANode.FirstChild);
  724. LockNodeBaseData(ANode.NextSibling);
  725. end;
  726. begin
  727. sdvBillsCompile.AfterValueChanged := nil;
  728. try
  729. LockNodeBaseData(FBillsCompileTree.FirstNode);
  730. finally
  731. sdvBillsCompile.AfterValueChanged := sdvBillsCompileAfterValueChanged;
  732. end;
  733. end;
  734. procedure TBillsCompileData.AddBillsFromDealBills(ARec: TsdDataRecord);
  735. var
  736. stnParent, stnNode: TsdIDTreeNode;
  737. begin
  738. if not CanAddGclBills then
  739. raise Exception.Create('当前节点下不可添加工程量清单!');
  740. stnParent := GetGclBillsParent(BillsCompileTree.Selected);
  741. if TBillsIDTreeNode(stnParent).HasLedger or
  742. (not stnParent.HasChildren and TBillsIDTreeNode(stnParent).HasMeasure) then
  743. raise Exception.Create('当前节点不可添加工程量清单!');
  744. stnNode := BillsCompileTree.Add(stnParent.ID, -1);
  745. stnNode.Rec.ValueByName('B_Code').AsString := ARec.ValueByName('B_Code').AsString;
  746. stnNode.Rec.ValueByName('Name').AsString := ARec.ValueByName('Name').AsString;
  747. stnNode.Rec.ValueByName('Units').AsString := ARec.ValueByName('Units').AsString;
  748. stnNode.Rec.ValueByName('Price').AsString := ARec.ValueByName('Price').AsString;
  749. end;
  750. procedure TBillsCompileData.CalculateMis(ABillsID: Integer);
  751. var
  752. vNode: TBillsIDTreeNode;
  753. iChild: Integer;
  754. begin
  755. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  756. if not Assigned(vNode) then Exit;
  757. if vNode.HasChildren then
  758. begin
  759. for iChild := 0 to vNode.ChildCount - 1 do
  760. CalculateMis(vNode.ChildNodes[iChild].ID);
  761. end
  762. else
  763. begin
  764. with vNode.Rec do
  765. begin
  766. // 数量单价模式则计算金额
  767. if CalcType.AsInteger = 0 then
  768. MisTotalPrice.AsFloat := TotalPriceRoundTo(MisQuantity.AsFloat * Price.AsFloat);
  769. // 金额与修改前不一样,则向父项增量
  770. if MisTotalPrice.AsFloat <> CacheMisTP then
  771. begin
  772. UpdateParent(vNode.ParentID, MisTotalPrice.AsFloat - CacheMisTP, 'MisTotalPrice');
  773. Quantity.AsFloat := QuantityRoundTo(
  774. OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
  775. TotalPrice.AsFloat := TotalPriceRoundTo(
  776. OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
  777. end;
  778. end;
  779. end;
  780. CalculateDesignPrice(vNode);
  781. end;
  782. procedure TBillsCompileData.CalculateOrg(ABillsID: Integer);
  783. var
  784. vNode: TBillsIDTreeNode;
  785. iChild: Integer;
  786. begin
  787. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  788. if not Assigned(vNode) then Exit;
  789. if vNode.HasChildren then
  790. begin
  791. for iChild := 0 to vNode.ChildCount - 1 do
  792. CalculateOrg(vNode.ChildNodes[iChild].ID);
  793. end
  794. else
  795. begin
  796. with vNode.Rec do
  797. begin
  798. // 数量单价模式则计算金额
  799. if CalcType.AsInteger = 0 then
  800. OrgTotalPrice.AsFloat := TotalPriceRoundTo(OrgQuantity.AsFloat * Price.AsFloat);
  801. // 金额与修改前不一样,则向父项增量
  802. if CacheOrgTP <> OrgTotalPrice.AsFloat then
  803. begin
  804. UpdateParent(vNode.ParentID, OrgTotalPrice.AsFloat - CacheOrgTP, 'OrgTotalPrice');
  805. Quantity.AsFloat := QuantityRoundTo(
  806. OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
  807. TotalPrice.AsFloat := TotalPriceRoundTo(
  808. OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
  809. end;
  810. end;
  811. end;
  812. CalculateDesignPrice(vNode);
  813. end;
  814. procedure TBillsCompileData.CalculateOth(ABillsID: Integer);
  815. var
  816. vNode: TBillsIDTreeNode;
  817. iChild: Integer;
  818. begin
  819. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  820. if not Assigned(vNode) then Exit;
  821. if vNode.HasChildren then
  822. begin
  823. for iChild := 0 to vNode.ChildCount - 1 do
  824. CalculateOth(vNode.ChildNodes[iChild].ID);
  825. end
  826. else
  827. begin
  828. with vNode.Rec do
  829. begin
  830. // 数量单价模式则计算金额
  831. if CalcType.AsInteger = 0 then
  832. OthTotalPrice.AsFloat := TotalPriceRoundTo(OthQuantity.AsFloat * Price.AsFloat);
  833. // 金额与修改前不一样,则向父项增量
  834. if OthTotalPrice.AsFloat <> CacheOthTP then
  835. begin
  836. UpdateParent(vNode.ParentID, OthTotalPrice.AsFloat - CacheOthTP, 'OthTotalPrice');
  837. Quantity.AsFloat := QuantityRoundTo(
  838. OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
  839. TotalPrice.AsFloat := TotalPriceRoundTo(
  840. OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat+ OthTotalPrice.AsFloat);
  841. end;
  842. end;
  843. end;
  844. CalculateDesignPrice(vNode);
  845. end;
  846. function TBillsCompileData.GatherChildren(ANode: TsdIDTreeNode;
  847. const AFieldName: string): Double;
  848. var
  849. iChild: Integer;
  850. begin
  851. Result := 0;
  852. if not Assigned(ANode) then Exit;
  853. if ANode.HasChildren and Assigned(ANode.FirstChild) then
  854. begin
  855. Result := 0;
  856. for iChild := 0 to ANode.ChildCount - 1 do
  857. Result := Result + ANode.Rec.ValueByName(AFieldName).AsFloat;
  858. Result := TotalPriceRoundTo(Result);
  859. end
  860. else
  861. if Assigned(ANode.Rec) and Assigned(ANode.Rec.ValueByName(AFieldName)) then
  862. Result := ANode.Rec.ValueByName(AFieldName).AsFloat;
  863. end;
  864. procedure TBillsCompileData.UpdateParent(ABillsID: Integer;
  865. ADifferTotalPrice: Double; const AFieldName: string);
  866. var
  867. vNode: TBillsIDTreeNode;
  868. begin
  869. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  870. if not Assigned(vNode) then Exit;
  871. with vNode.Rec do
  872. begin
  873. ValueByName(AFieldName).AsFloat := TotalPriceRoundTo(
  874. ValueByName(AFieldName).AsFloat + ADifferTotalPrice);
  875. TotalPrice.AsFloat := TotalPriceRoundTo(TotalPrice.AsFloat + ADifferTotalPrice);
  876. end;
  877. CalculateDesignPrice(vNode);
  878. UpdateParent(vNode.ParentID, ADifferTotalPrice, AFieldName);
  879. end;
  880. procedure TBillsCompileData.CalculateTotal(ABillsID: Integer);
  881. begin
  882. CalculateOrg(ABillsID);
  883. CalculateMis(ABillsID);
  884. CalculateOth(ABillsID);
  885. end;
  886. procedure TBillsCompileData.CalculateBills(ANode: TsdIDTreeNode);
  887. var
  888. iChild: Integer;
  889. begin
  890. if not Assigned(ANode) then Exit;
  891. if ANode.HasChildren then
  892. begin
  893. for iChild := 0 to ANode.ChildCount - 1 do
  894. CalculateBills(ANode.ChildNodes[iChild]);
  895. GatherNode(TBillsIDTreeNode(ANode));
  896. end
  897. else
  898. CalculateLeaf(TBillsIDTreeNode(ANode));
  899. end;
  900. procedure TBillsCompileData.CalculateLeaf(ANode: TBillsIDTreeNode);
  901. begin
  902. if not Assigned(ANode) or ANode.HasChildren then Exit;
  903. with ANode.Rec do
  904. begin
  905. // 分项
  906. if CalcType.AsFloat = 0 then
  907. begin
  908. OrgTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OrgQuantity.AsFloat);
  909. MisTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * MisQuantity.AsFloat);
  910. OthTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OthQuantity.AsFloat);
  911. end;
  912. // 汇总
  913. Quantity.AsFloat := QuantityRoundTo(
  914. OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
  915. TotalPrice.AsFloat := TotalPriceRoundTo(
  916. OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
  917. end;
  918. CalculateDesignPrice(ANode);
  919. end;
  920. procedure TBillsCompileData.GatherNode(ANode: TBillsIDTreeNode);
  921. var
  922. iChild: Integer;
  923. fOrg, fMis, fOth: Double;
  924. vChild: TBillsIDTreeNode;
  925. begin
  926. fOrg := 0;
  927. fMis := 0;
  928. fOth := 0;
  929. for iChild := 0 to ANode.ChildCount - 1 do
  930. begin
  931. vChild := TBillsIDTreeNode(ANode.ChildNodes[iChild]);
  932. fOrg := fOrg + vChild.Rec.OrgTotalPrice.AsFloat;
  933. fMis := fMis + vChild.Rec.MisTotalPrice.AsFloat;
  934. fOth := fOth + vChild.Rec.OthTotalPrice.AsFloat;
  935. end;
  936. ANode.Rec.OrgTotalPrice.AsFloat := TotalPriceRoundTo(fOrg);
  937. ANode.Rec.MisTotalPrice.AsFloat := TotalPriceRoundTo(fMis);
  938. ANode.Rec.OthTotalPrice.AsFloat := TotalPriceRoundTo(fOth);
  939. ANode.Rec.TotalPrice.AsFloat := TotalPriceRoundTo(fOrg + fMis + fOth);
  940. CalculateDesignPrice(ANode);
  941. end;
  942. procedure TBillsCompileData.Calculate(ABillsID: Integer);
  943. procedure UpdateParent(ANode: TBillsIDTreeNode; ADifferOrg, ADifferMis, ADifferOth: Double);
  944. begin
  945. if not Assigned(ANode) then Exit;
  946. with ANode.Rec do
  947. begin
  948. OrgTotalPrice.AsFloat := TotalPriceRoundTo(OrgTotalPrice.AsFloat + ADifferOrg);
  949. MisTotalPrice.AsFloat := TotalPriceRoundTo(MisTotalPrice.AsFloat + ADifferMis);
  950. OthTotalPrice.AsFloat := TotalPriceRoundTo(OthTotalPrice.AsFloat + ADifferOth);
  951. TotalPrice.AsFloat := TotalPriceRoundTo(
  952. TotalPrice.AsFloat + ADifferOrg + ADifferMis + ADifferOth);
  953. if DgnQuantity1.AsFloat <> 0 then
  954. DgnPrice.AsFloat := PriceRoundTo(TotalPrice.AsFloat/DgnQuantity1.AsFloat);
  955. end;
  956. UpdateParent(TBillsIDTreeNode(ANode.Parent), ADifferOrg, ADifferMis, ADifferOth);
  957. end;
  958. var
  959. vNode: TBillsIDTreeNode;
  960. iChild: Integer;
  961. fOrg, fMis, fOth: Double;
  962. begin
  963. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  964. if not Assigned(vNode) then Exit;
  965. fOrg := vNode.Rec.OrgTotalPrice.AsFloat;
  966. fMis := vNode.Rec.MisTotalPrice.AsFloat;
  967. fOth := vNode.Rec.OthTotalPrice.AsFloat;
  968. CalculateBills(vNode);
  969. fOrg := vNode.Rec.OrgTotalPrice.AsFloat - fOrg;
  970. fMis := vNode.Rec.MisTotalPrice.AsFloat - fMis;
  971. fOth := vNode.Rec.OthTotalPrice.AsFloat - fOth;
  972. UpdateParent(TBillsIDTreeNode(vNode.Parent), fOrg, fMis, fOth);
  973. end;
  974. procedure TBillsCompileData.CalculateDesignPrice(ANode: TBillsIDTreeNode);
  975. begin
  976. if ANode.Rec.DgnQuantity1.AsFloat <> 0 then
  977. ANode.Rec.DgnPrice.AsFloat := PriceRoundTo(
  978. ANode.Rec.TotalPrice.AsFloat/ANode.Rec.DgnQuantity1.AsFloat)
  979. else
  980. ANode.Rec.DgnPrice.Clear;
  981. end;
  982. procedure TBillsCompileData.ExpandPegXmjNode;
  983. function HasPegChild(ANode: TBillsIDTreeNode): Boolean;
  984. var
  985. NextNode: TBillsIDTreeNode;
  986. begin
  987. Result := False;
  988. NextNode := TBillsIDTreeNode(ANode.NextNode);
  989. while ((NextNode.MajorIndex - ANode.MajorIndex) <= ANode.PosterityCount) do
  990. begin
  991. if CheckPeg(NextNode.Rec.Name.AsString) then
  992. begin
  993. Result := True;
  994. Break;
  995. end;
  996. NextNode := TBillsIDTreeNode(NextNode.NextNode);
  997. end;
  998. end;
  999. function HasGclChild(ANode: TBillsIDTreeNode): Boolean;
  1000. var
  1001. vChild: TBillsIDTreeNode;
  1002. begin
  1003. Result := True;
  1004. vChild := TBillsIDTreeNode(ANode.FirstChild);
  1005. while Assigned(vChild) and not Result do
  1006. begin
  1007. if vChild.Rec.B_Code.AsString <> '' then
  1008. Result := False;
  1009. vChild := TBillsIDTreeNode(vChild.NextSibling);
  1010. end;
  1011. end;
  1012. var
  1013. iIndex: Integer;
  1014. vNode: TBillsIDTreeNode;
  1015. begin
  1016. for iIndex := 0 to BillsCompileTree.Count - 1 do
  1017. begin
  1018. vNode := TBillsIDTreeNode(BillsCompileTree.Items[iIndex]);
  1019. if vNode.HasChildren then
  1020. vNode.Expanded := HasPegChild(vNode) or not HasGclChild(vNode);
  1021. end;
  1022. end;
  1023. end.