BillsCompileDm.pas 37 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178
  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. begin
  486. ARecord.ValueByName(sPre + 'Formula').AsString := '';
  487. Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)));
  488. end
  489. else
  490. begin
  491. ARecord.ValueByName(sPre + 'Formula').AsString := Text;
  492. Text := FloatToStr(QuantityRoundTo(EvaluateExprs(Text)));
  493. end;
  494. ARecord.ValueByName('CalcType').AsInteger := 0;
  495. end;
  496. procedure SetTotalPrice(const AFieldName: string);
  497. var
  498. sPre: string;
  499. begin
  500. sPre := StringReplace(AFieldName, 'TotalPrice', '', [rfIgnoreCase, rfReplaceAll]);
  501. if CheckStringNull(Text) or CheckNumeric(Text) then
  502. begin
  503. ARecord.ValueByName(sPre + 'Formula').AsString := '';
  504. Text := FloatToStr(TotalPriceRoundTo(StrToFloatDef(Text, 0)));
  505. end
  506. else
  507. begin
  508. ARecord.ValueByName(sPre + 'Formula').AsString := Text;
  509. Text := FloatToStr(TotalPriceRoundTo(EvaluateExprs(Text)));
  510. end;
  511. ARecord.ValueByName('CalcType').AsInteger := 1;
  512. end;
  513. procedure SetDgnQuantity;
  514. begin
  515. Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)));
  516. end;
  517. procedure SetPrice;
  518. begin
  519. Text := FloatToStr(PriceRoundTo(StrToFloatDef(Text, 0)));
  520. ARecord.ValueByName('CalcType').AsInteger := 0;
  521. end;
  522. procedure DoCurChanged;
  523. begin
  524. if SameText(AColumn.FieldName, 'OrgQuantity') or
  525. SameText(AColumn.FieldName, 'MisQuantity') or
  526. SameText(AColumn.FieldName, 'OthQuantity')then
  527. SetQuantity(AColumn.FieldName)
  528. else if SameText(AColumn.FieldName, 'OrgTotalPrice') or
  529. SameText(AColumn.FieldName, 'MisTotalPrice') or
  530. SameText(AColumn.FieldName, 'OthTotalPrice') then
  531. SetTotalPrice(AColumn.FieldName)
  532. else if Pos('DgnQuantity', AColumn.FieldName) = 1 then
  533. SetDgnQuantity
  534. else if SameText(AColumn.FieldName, 'Price') then
  535. SetPrice;
  536. end;
  537. procedure CheckLockedData;
  538. begin
  539. if SameText(AColumn.FieldName, 'Code') or
  540. SameText(AColumn.FieldName, 'B_Code') or
  541. SameText(AColumn.FieldName, 'Name') or
  542. SameText(AColumn.FieldName, 'Units') or
  543. SameText(AColumn.FieldName, 'Price') or
  544. SameText(AColumn.FieldName, 'OrgQuantity') or
  545. SameText(AColumn.FieldName, 'OrgTotalPrice') or
  546. SameText(AColumn.FieldName, 'MisQuantity') or
  547. SameText(AColumn.FieldName, 'MisTotalPrice') or
  548. SameText(AColumn.FieldName, 'OthQuantity') or
  549. SameText(AColumn.FieldName, 'OthTotalPrice') or
  550. SameText(AColumn.FieldName, 'DrawingCode')then
  551. if ARecord.ValueByName('LockedInfo').AsBoolean then
  552. SetTextErrorHint('清单信息已被锁定,不允许修改编号、名称、单位、清单单价、0号台账数量与金额、图号!');
  553. end;
  554. procedure CheckNodeWritable;
  555. var
  556. vNode: TBillsIDTreeNode;
  557. iCreatePhase: Integer;
  558. begin
  559. if not Allow then Exit;
  560. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ARecord.ValueByName('ID').AsInteger));
  561. iCreatePhase := vNode.Rec.ValueByName('CreatePhaseID').AsInteger;
  562. if vNode.ID = iPriceMarginID then
  563. SetTextErrorHint(sBills_PMHint);
  564. if vNode.HasChildren then
  565. begin
  566. if Text = '' then
  567. Exit
  568. else if ((Pos('Quantity', AColumn.FieldName) > 0) and (Pos('Dgn', AColumn.FieldName) <=0)) or
  569. (Pos('TotalPrice', AColumn.FieldName) > 0) then
  570. SetTextErrorHint('该清单有子计算项,不能直接修改!')
  571. else if (Pos('Price', AColumn.FieldName) > 0) then
  572. SetTextErrorHint('仅最底层清单可输入单价!');
  573. if not Allow then Exit;
  574. end
  575. else
  576. begin
  577. if SameText('OrgTotalPrice', AColumn.FieldName) or
  578. SameText('MisTotalPrice', AColumn.FieldName) or
  579. SameText('OthTotalPrice', AColumn.FieldName) then
  580. begin
  581. if not vNode.TotalPriceEnable then
  582. SetTextErrorHint('该清单不可直接输入金额,如需直接输入金额,请先清空所有数量、单价!');
  583. end;
  584. if not Allow then Exit;
  585. if SameText('Price', AColumn.FieldName) or
  586. SameText('OrgQuantity', AColumn.FieldName) or
  587. SameText('MisQuantity', AColumn.FieldName) or
  588. SameText('OthQuantity', AColumn.FieldName) then
  589. begin
  590. if not vNode.CountPriceEnable then
  591. SetTextErrorHint('该清单不可输入数量单价,如需使用数量×单价计算,请先清空所有直接输入的金额!');
  592. end;
  593. if not Allow then Exit;
  594. end;
  595. // 清单编号和项目节编号不可同时存在
  596. if SameText(AValue.FieldName, 'Code') then
  597. begin
  598. if AValue.Owner.ValueByName('B_Code').AsString <> '' then
  599. SetTextErrorHint('已存在清单编号,不可输入项目节编号!');
  600. end
  601. else if SameText(AValue.FieldName, 'B_Code') then
  602. begin
  603. if AValue.Owner.ValueByName('Code').AsString <> '' then
  604. SetTextErrorHint('已存在项目节编号,不可输入清单编号!');
  605. end
  606. //
  607. else if SameText(AValue.FieldName, 'Price') then
  608. begin
  609. if AValue.Owner.ValueByName('AddGatherTotalPrice').AsFloat <> 0 then
  610. SetTextErrorHint('该清单已经开始计量,不可修改单价!');
  611. end
  612. // 变更清单不可修改0号台账数据
  613. else if SameText(AValue.FieldName, 'OrgQuantity') or
  614. SameText(AValue.FieldName, 'OrgTotalPrice') or
  615. SameText(AValue.FieldName, 'MisQuantity') or
  616. SameText(AValue.FieldName, 'MisTotalPrice') or
  617. SameText(AValue.FieldName, 'OthQuantity') or
  618. SameText(AValue.FieldName, 'OthTotalPrice') then
  619. begin
  620. if AValue.Owner.ValueByName('IsMeasureAdd').AsBoolean then
  621. SetTextErrorHint('变更清单不可填写0号台账数量与金额');
  622. end;
  623. if not Allow then Exit;
  624. if SameText('Code', AColumn.FieldName) or
  625. SameText('B_Code', AColumn.FieldName) or
  626. SameText('Name', AColumn.FieldName) or
  627. SameText('Units', AColumn.FieldName) or
  628. SameText('Price', AColumn.FieldName) then
  629. if TBillsIDTreeNode(vNode).HasMeasure then
  630. SetTextErrorHint('该清单已经计量,不可修改清单编号');
  631. end;
  632. function CheckValidData: Boolean;
  633. begin
  634. Result := (AValue.AsString <> Text);
  635. if SameText(AColumn.FieldName, 'OrgQuantity') or
  636. SameText(AColumn.FieldName, 'OrgTotalPrice') or
  637. SameText(AColumn.FieldName, 'MisQuantity') or
  638. SameText(AColumn.FieldName, 'MisTotalPrice') or
  639. SameText(AColumn.FieldName, 'OthQuantity') or
  640. SameText(AColumn.FieldName, 'OthTotalPrice') or
  641. SameText(AColumn.FieldName, 'Price') then
  642. begin
  643. if (AValue.AsFloat = 0) and (Text = '') then
  644. Result := False;
  645. end;
  646. end;
  647. begin
  648. if not Assigned(AValue) then Exit;
  649. // 修改后数据与原数据相同则不提交
  650. if not CheckValidData then
  651. Allow := False;
  652. if not Allow then Exit;
  653. CheckLockedData;
  654. if not Allow then Exit;
  655. CheckNodeWritable;
  656. if not Allow then Exit;
  657. Text := Trim(Text);
  658. if Pos('=', Text) = 1 then
  659. Text := Copy(Text, 2, Length(Text) - 1);
  660. DoCurChanged;
  661. end;
  662. function TBillsCompileData.GetActive: Boolean;
  663. begin
  664. Result := sdvBillsCompile.Active;
  665. end;
  666. function TBillsCompileData.GetLeafXmjParentID(ABillsID: Integer): Integer;
  667. var
  668. stnNode: TsdIDTreeNode;
  669. begin
  670. stnNode := BillsCompileTree.FindNode(ABillsID);
  671. Result := GetGclBillsParent(stnNode).ID;
  672. end;
  673. procedure TBillsCompileData.sdvBillsCompileAfterOpen(Sender: TObject);
  674. begin
  675. BillsCompileTree.Active := True;
  676. end;
  677. procedure TBillsCompileData.sdvBillsCompileAfterClose(Sender: TObject);
  678. begin
  679. BillsCompileTree.Active := False;
  680. end;
  681. procedure TBillsCompileData.ReorderChildrenCode(ANode: TsdIDTreeNode);
  682. var
  683. iChild: Integer;
  684. sParentCode: string;
  685. stnChild: TsdIDTreeNode;
  686. begin
  687. if not Assigned(ANode) then Exit;
  688. sParentCode := ANode.Rec.ValueByName('Code').AsString;
  689. for iChild := 0 to ANode.ChildCount - 1 do
  690. begin
  691. stnChild := ANode.ChildNodes[iChild];
  692. if stnChild.Rec.ValueByName('Code').AsString <> '' then
  693. stnChild.Rec.ValueByName('Code').AsString := sParentCode + '-' + IntToStr(iChild + 1);
  694. ReorderChildrenCode(stnChild);
  695. end;
  696. end;
  697. procedure TBillsCompileData.sdvBillsCompileAfterAddRecord(
  698. ARecord: TsdDataRecord);
  699. begin
  700. // 解锁前,新增清单为变更清单,解锁后,新增清单为0号台账清单
  701. if TProjectData(FProjectData).ProjProperties.PhaseCount > 0 then
  702. ARecord.ValueByName('IsMeasureAdd').AsBoolean := not TProjectData(FProjectData).CanUnlockInfo;
  703. end;
  704. procedure TBillsCompileData.DoOnAfterDeleteNode(AParent: TsdIDTreeNode);
  705. begin
  706. if Assigned(AParent) and (AParent.ID > 0) then
  707. Calculate(AParent.ID);
  708. end;
  709. procedure TBillsCompileData.Close;
  710. begin
  711. sdvBillsCompile.Close;
  712. end;
  713. procedure TBillsCompileData.SetOnRecChange(const Value: TRecChangeEvent);
  714. begin
  715. FOnRecChange := Value;
  716. end;
  717. procedure TBillsCompileData.sdvBillsCompileCurrentChanged(
  718. ARecord: TsdDataRecord);
  719. begin
  720. if Assigned(FOnRecChange) then
  721. FOnRecChange(ARecord);
  722. end;
  723. procedure TBillsCompileData.ReLockBaseData;
  724. procedure LockNodeBaseData(ANode: TsdIDTreeNode);
  725. begin
  726. if not Assigned(ANode) then Exit;
  727. if ANode.Rec.ValueByName('LockedLevel').AsBoolean then
  728. if not ANode.Rec.ValueByName('LockedInfo').AsBoolean then
  729. ANode.Rec.ValueByName('LockedInfo').AsBoolean := True;
  730. LockNodeBaseData(ANode.FirstChild);
  731. LockNodeBaseData(ANode.NextSibling);
  732. end;
  733. begin
  734. sdvBillsCompile.AfterValueChanged := nil;
  735. try
  736. LockNodeBaseData(FBillsCompileTree.FirstNode);
  737. finally
  738. sdvBillsCompile.AfterValueChanged := sdvBillsCompileAfterValueChanged;
  739. end;
  740. end;
  741. procedure TBillsCompileData.AddBillsFromDealBills(ARec: TsdDataRecord);
  742. var
  743. stnParent, stnNode: TsdIDTreeNode;
  744. begin
  745. if not CanAddGclBills then
  746. raise Exception.Create('当前节点下不可添加工程量清单!');
  747. stnParent := GetGclBillsParent(BillsCompileTree.Selected);
  748. if TBillsIDTreeNode(stnParent).HasLedger or
  749. (not stnParent.HasChildren and TBillsIDTreeNode(stnParent).HasMeasure) then
  750. raise Exception.Create('当前节点不可添加工程量清单!');
  751. stnNode := BillsCompileTree.Add(stnParent.ID, -1);
  752. stnNode.Rec.ValueByName('B_Code').AsString := ARec.ValueByName('B_Code').AsString;
  753. stnNode.Rec.ValueByName('Name').AsString := ARec.ValueByName('Name').AsString;
  754. stnNode.Rec.ValueByName('Units').AsString := ARec.ValueByName('Units').AsString;
  755. stnNode.Rec.ValueByName('Price').AsString := ARec.ValueByName('Price').AsString;
  756. end;
  757. procedure TBillsCompileData.CalculateMis(ABillsID: Integer);
  758. var
  759. vNode: TBillsIDTreeNode;
  760. iChild: Integer;
  761. begin
  762. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  763. if not Assigned(vNode) then Exit;
  764. if vNode.HasChildren then
  765. begin
  766. for iChild := 0 to vNode.ChildCount - 1 do
  767. CalculateMis(vNode.ChildNodes[iChild].ID);
  768. end
  769. else
  770. begin
  771. with vNode.Rec do
  772. begin
  773. // 数量单价模式则计算金额
  774. if CalcType.AsInteger = 0 then
  775. MisTotalPrice.AsFloat := TotalPriceRoundTo(MisQuantity.AsFloat * Price.AsFloat);
  776. SetFloatValue(Quantity, QuantityRoundTo(
  777. OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat));
  778. // 金额与修改前不一样,则向父项增量
  779. if MisTotalPrice.AsFloat <> CacheMisTP then
  780. begin
  781. UpdateParent(vNode.ParentID, MisTotalPrice.AsFloat - CacheMisTP, 'MisTotalPrice');
  782. TotalPrice.AsFloat := TotalPriceRoundTo(
  783. OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
  784. end;
  785. end;
  786. end;
  787. CalculateDesignPrice(vNode);
  788. end;
  789. procedure TBillsCompileData.CalculateOrg(ABillsID: Integer);
  790. var
  791. vNode: TBillsIDTreeNode;
  792. iChild: Integer;
  793. begin
  794. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  795. if not Assigned(vNode) then Exit;
  796. if vNode.HasChildren then
  797. begin
  798. for iChild := 0 to vNode.ChildCount - 1 do
  799. CalculateOrg(vNode.ChildNodes[iChild].ID);
  800. end
  801. else
  802. begin
  803. with vNode.Rec do
  804. begin
  805. // 数量单价模式则计算金额
  806. if CalcType.AsInteger = 0 then
  807. OrgTotalPrice.AsFloat := TotalPriceRoundTo(OrgQuantity.AsFloat * Price.AsFloat);
  808. SetFloatValue(Quantity, QuantityRoundTo(
  809. OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat));
  810. // 金额与修改前不一样,则向父项增量
  811. if CacheOrgTP <> OrgTotalPrice.AsFloat then
  812. begin
  813. UpdateParent(vNode.ParentID, OrgTotalPrice.AsFloat - CacheOrgTP, 'OrgTotalPrice');
  814. TotalPrice.AsFloat := TotalPriceRoundTo(
  815. OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
  816. end;
  817. end;
  818. end;
  819. CalculateDesignPrice(vNode);
  820. end;
  821. procedure TBillsCompileData.CalculateOth(ABillsID: Integer);
  822. var
  823. vNode: TBillsIDTreeNode;
  824. iChild: Integer;
  825. begin
  826. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  827. if not Assigned(vNode) then Exit;
  828. if vNode.HasChildren then
  829. begin
  830. for iChild := 0 to vNode.ChildCount - 1 do
  831. CalculateOth(vNode.ChildNodes[iChild].ID);
  832. end
  833. else
  834. begin
  835. with vNode.Rec do
  836. begin
  837. // 数量单价模式则计算金额
  838. if CalcType.AsInteger = 0 then
  839. OthTotalPrice.AsFloat := TotalPriceRoundTo(OthQuantity.AsFloat * Price.AsFloat);
  840. SetFloatValue(Quantity, QuantityRoundTo(
  841. OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat));
  842. // 金额与修改前不一样,则向父项增量
  843. if OthTotalPrice.AsFloat <> CacheOthTP then
  844. begin
  845. UpdateParent(vNode.ParentID, OthTotalPrice.AsFloat - CacheOthTP, 'OthTotalPrice');
  846. TotalPrice.AsFloat := TotalPriceRoundTo(
  847. OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat+ OthTotalPrice.AsFloat);
  848. end;
  849. end;
  850. end;
  851. CalculateDesignPrice(vNode);
  852. end;
  853. function TBillsCompileData.GatherChildren(ANode: TsdIDTreeNode;
  854. const AFieldName: string): Double;
  855. var
  856. iChild: Integer;
  857. begin
  858. Result := 0;
  859. if not Assigned(ANode) then Exit;
  860. if ANode.HasChildren and Assigned(ANode.FirstChild) then
  861. begin
  862. Result := 0;
  863. for iChild := 0 to ANode.ChildCount - 1 do
  864. Result := Result + ANode.Rec.ValueByName(AFieldName).AsFloat;
  865. Result := TotalPriceRoundTo(Result);
  866. end
  867. else
  868. if Assigned(ANode.Rec) and Assigned(ANode.Rec.ValueByName(AFieldName)) then
  869. Result := ANode.Rec.ValueByName(AFieldName).AsFloat;
  870. end;
  871. procedure TBillsCompileData.UpdateParent(ABillsID: Integer;
  872. ADifferTotalPrice: Double; const AFieldName: string);
  873. var
  874. vNode: TBillsIDTreeNode;
  875. begin
  876. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  877. if not Assigned(vNode) then Exit;
  878. with vNode.Rec do
  879. begin
  880. ValueByName(AFieldName).AsFloat := TotalPriceRoundTo(
  881. ValueByName(AFieldName).AsFloat + ADifferTotalPrice);
  882. TotalPrice.AsFloat := TotalPriceRoundTo(TotalPrice.AsFloat + ADifferTotalPrice);
  883. end;
  884. CalculateDesignPrice(vNode);
  885. UpdateParent(vNode.ParentID, ADifferTotalPrice, AFieldName);
  886. end;
  887. procedure TBillsCompileData.CalculateTotal(ABillsID: Integer);
  888. begin
  889. CalculateOrg(ABillsID);
  890. CalculateMis(ABillsID);
  891. CalculateOth(ABillsID);
  892. end;
  893. procedure TBillsCompileData.CalculateBills(ANode: TsdIDTreeNode);
  894. var
  895. iChild: Integer;
  896. begin
  897. if not Assigned(ANode) then Exit;
  898. if ANode.HasChildren then
  899. begin
  900. for iChild := 0 to ANode.ChildCount - 1 do
  901. CalculateBills(ANode.ChildNodes[iChild]);
  902. GatherNode(TBillsIDTreeNode(ANode));
  903. end
  904. else
  905. CalculateLeaf(TBillsIDTreeNode(ANode));
  906. end;
  907. procedure TBillsCompileData.CalculateLeaf(ANode: TBillsIDTreeNode);
  908. begin
  909. if not Assigned(ANode) or ANode.HasChildren then Exit;
  910. with ANode.Rec do
  911. begin
  912. // 分项
  913. if CalcType.AsFloat = 0 then
  914. begin
  915. OrgTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OrgQuantity.AsFloat);
  916. MisTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * MisQuantity.AsFloat);
  917. OthTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OthQuantity.AsFloat);
  918. end;
  919. // 汇总
  920. Quantity.AsFloat := QuantityRoundTo(
  921. OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
  922. TotalPrice.AsFloat := TotalPriceRoundTo(
  923. OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
  924. end;
  925. CalculateDesignPrice(ANode);
  926. end;
  927. procedure TBillsCompileData.GatherNode(ANode: TBillsIDTreeNode);
  928. var
  929. iChild: Integer;
  930. fOrg, fMis, fOth: Double;
  931. vChild: TBillsIDTreeNode;
  932. begin
  933. fOrg := 0;
  934. fMis := 0;
  935. fOth := 0;
  936. for iChild := 0 to ANode.ChildCount - 1 do
  937. begin
  938. vChild := TBillsIDTreeNode(ANode.ChildNodes[iChild]);
  939. fOrg := fOrg + vChild.Rec.OrgTotalPrice.AsFloat;
  940. fMis := fMis + vChild.Rec.MisTotalPrice.AsFloat;
  941. fOth := fOth + vChild.Rec.OthTotalPrice.AsFloat;
  942. end;
  943. ANode.Rec.OrgTotalPrice.AsFloat := TotalPriceRoundTo(fOrg);
  944. ANode.Rec.MisTotalPrice.AsFloat := TotalPriceRoundTo(fMis);
  945. ANode.Rec.OthTotalPrice.AsFloat := TotalPriceRoundTo(fOth);
  946. ANode.Rec.TotalPrice.AsFloat := TotalPriceRoundTo(fOrg + fMis + fOth);
  947. CalculateDesignPrice(ANode);
  948. end;
  949. procedure TBillsCompileData.Calculate(ABillsID: Integer);
  950. procedure UpdateParent(ANode: TBillsIDTreeNode; ADifferOrg, ADifferMis, ADifferOth: Double);
  951. begin
  952. if not Assigned(ANode) then Exit;
  953. with ANode.Rec do
  954. begin
  955. OrgTotalPrice.AsFloat := TotalPriceRoundTo(OrgTotalPrice.AsFloat + ADifferOrg);
  956. MisTotalPrice.AsFloat := TotalPriceRoundTo(MisTotalPrice.AsFloat + ADifferMis);
  957. OthTotalPrice.AsFloat := TotalPriceRoundTo(OthTotalPrice.AsFloat + ADifferOth);
  958. TotalPrice.AsFloat := TotalPriceRoundTo(
  959. TotalPrice.AsFloat + ADifferOrg + ADifferMis + ADifferOth);
  960. if DgnQuantity1.AsFloat <> 0 then
  961. DgnPrice.AsFloat := PriceRoundTo(TotalPrice.AsFloat/DgnQuantity1.AsFloat);
  962. end;
  963. UpdateParent(TBillsIDTreeNode(ANode.Parent), ADifferOrg, ADifferMis, ADifferOth);
  964. end;
  965. var
  966. vNode: TBillsIDTreeNode;
  967. iChild: Integer;
  968. fOrg, fMis, fOth: Double;
  969. begin
  970. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  971. if not Assigned(vNode) then Exit;
  972. fOrg := vNode.Rec.OrgTotalPrice.AsFloat;
  973. fMis := vNode.Rec.MisTotalPrice.AsFloat;
  974. fOth := vNode.Rec.OthTotalPrice.AsFloat;
  975. CalculateBills(vNode);
  976. fOrg := vNode.Rec.OrgTotalPrice.AsFloat - fOrg;
  977. fMis := vNode.Rec.MisTotalPrice.AsFloat - fMis;
  978. fOth := vNode.Rec.OthTotalPrice.AsFloat - fOth;
  979. UpdateParent(TBillsIDTreeNode(vNode.Parent), fOrg, fMis, fOth);
  980. end;
  981. procedure TBillsCompileData.CalculateDesignPrice(ANode: TBillsIDTreeNode);
  982. begin
  983. if ANode.Rec.DgnQuantity1.AsFloat <> 0 then
  984. ANode.Rec.DgnPrice.AsFloat := PriceRoundTo(
  985. ANode.Rec.TotalPrice.AsFloat/ANode.Rec.DgnQuantity1.AsFloat)
  986. else
  987. ANode.Rec.DgnPrice.Clear;
  988. end;
  989. procedure TBillsCompileData.ExpandPegXmjNode;
  990. function HasPegChild(ANode: TBillsIDTreeNode): Boolean;
  991. var
  992. NextNode: TBillsIDTreeNode;
  993. begin
  994. Result := False;
  995. NextNode := TBillsIDTreeNode(ANode.NextNode);
  996. while ((NextNode.MajorIndex - ANode.MajorIndex) <= ANode.PosterityCount) do
  997. begin
  998. if CheckPeg(NextNode.Rec.Name.AsString) then
  999. begin
  1000. Result := True;
  1001. Break;
  1002. end;
  1003. NextNode := TBillsIDTreeNode(NextNode.NextNode);
  1004. end;
  1005. end;
  1006. function HasGclChild(ANode: TBillsIDTreeNode): Boolean;
  1007. var
  1008. vChild: TBillsIDTreeNode;
  1009. begin
  1010. Result := True;
  1011. vChild := TBillsIDTreeNode(ANode.FirstChild);
  1012. while Assigned(vChild) and not Result do
  1013. begin
  1014. if vChild.Rec.B_Code.AsString <> '' then
  1015. Result := False;
  1016. vChild := TBillsIDTreeNode(vChild.NextSibling);
  1017. end;
  1018. end;
  1019. var
  1020. iIndex: Integer;
  1021. vNode: TBillsIDTreeNode;
  1022. begin
  1023. for iIndex := 0 to BillsCompileTree.Count - 1 do
  1024. begin
  1025. vNode := TBillsIDTreeNode(BillsCompileTree.Items[iIndex]);
  1026. if vNode.HasChildren then
  1027. vNode.Expanded := HasPegChild(vNode) or not HasGclChild(vNode);
  1028. end;
  1029. end;
  1030. end.