BillsCompileDm.pas 40 KB

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