BillsCompileDm.pas 40 KB

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