BillsCompileDm.pas 37 KB

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