BillsCompileDm.pas 37 KB

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