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