BillsCompileDm.pas 38 KB

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