BillsCompileDm.pas 37 KB

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