BillsCompileDm.pas 36 KB

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