BillsCompileDm.pas 36 KB

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