BillsCompileDm.pas 37 KB

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