ProjGatherTree.pas 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487
  1. unit ProjGatherTree;
  2. interface
  3. uses
  4. CacheTree, Classes, CalcData;
  5. type
  6. TProjGatherTreeNode = class(TCacheNode)
  7. private
  8. FCode: string;
  9. FB_Code: string;
  10. FName: string;
  11. FUnits: string;
  12. FPrice: Double;
  13. FSerialNo: Integer;
  14. FXiangCode: string;
  15. FMuCode: string;
  16. FJieCode: string;
  17. FXiMuCode: string;
  18. FIndexCode: string;
  19. FB_CodeChapter: Integer;
  20. FChapterParentID: Integer;
  21. FGatherCalc: TProjCalc;
  22. FProjs: TList;
  23. FSpecialProjs: TList;
  24. function GetProjCount: Integer;
  25. function GetProj(AIndex: Integer): TProjCalc;
  26. function GetChapterParentID: Integer;
  27. function GetLevel: Integer;
  28. function GetSpecialProj(AIndex: Integer): TProjCalc;
  29. function GetSpecialProjCount: Integer;
  30. public
  31. constructor Create(ACacheTree: TCacheTree; AID: Integer; AProjCount, ASpeicalProjCount: Integer);
  32. destructor Destroy; override;
  33. procedure InitTotalPrice_Rc;
  34. procedure UpdateTotalPrice_Rc(ANode: TProjGatherTreeNode);
  35. procedure CalcTotalPrice_Rc;
  36. procedure InitCalcData;
  37. procedure AddCalcData(ANode: TProjGatherTreeNode);
  38. procedure MinusCalcData(ANode: TProjGatherTreeNode);
  39. property Code: string read FCode write FCode;
  40. property B_Code: string read FB_Code write FB_Code;
  41. property Name: string read FName write FName;
  42. property Units: string read FUnits write FUnits;
  43. property Price: Double read FPrice write FPrice;
  44. property SerialNo: Integer read FSerialNo write FSerialNo;
  45. property XiangCode: string read FXiangCode write FXiangCode;
  46. property MuCode: string read FMuCode write FMuCode;
  47. property JieCode: string read FJieCode write FJieCode;
  48. property XiMuCode: string read FXiMuCode write FXiMuCode;
  49. property IndexCode: string read FIndexCode write FIndexCode;
  50. property B_CodeChapter: Integer read FB_CodeChapter write FB_CodeChapter;
  51. property Level: Integer read GetLevel;
  52. property ChapterParentID: Integer read GetChapterParentID;
  53. property GatherCalc: TProjCalc read FGatherCalc;
  54. property ProjCount: Integer read GetProjCount;
  55. property Proj[AIndex: Integer]: TProjCalc read GetProj;
  56. property SpecialProjCount: Integer read GetSpecialProjCount;
  57. property SpecialProj[AIndex: Integer]: TProjCalc read GetSpecialProj;
  58. end;
  59. TProjGatherTree = class(TCacheTree)
  60. private
  61. FProjCount: Integer;
  62. FSpecialProjCount: Integer;
  63. FFixedIDNodes: TList;
  64. FGatherNode: TProjGatherTreeNode;
  65. FSerialNo: Integer;
  66. function GetNewNode(AFixedID: Integer = -1): TProjGatherTreeNode;
  67. procedure Calculate(ANode: TProjGatherTreeNode);
  68. procedure CalcGatherNode;
  69. public
  70. constructor Create(AProjCount, ASpecialProjCount: Integer);
  71. destructor Destroy; override;
  72. function AddNode(AParent, ANextSibling: TProjGatherTreeNode; AFixedID: Integer = -1): TProjGatherTreeNode;
  73. function FindNode(AParent: TProjGatherTreeNode; const ACode, AB_Code, AName: string; APrice: Double): TProjGatherTreeNode; overload;
  74. function FindNode(AParent: TProjGatherTreeNode; const ACode, AB_Code: string; APrice: Double): TProjGatherTreeNode; overload;
  75. function FindNode(AParent: TProjGatherTreeNode; const AName: string; APrice: Double): TProjGatherTreeNode; overload;
  76. function FindNode(AFixedID: Integer): TProjGatherTreeNode; overload;
  77. function FindNextSibling(AParent: TProjGatherTreeNode; const ACode, AB_Code: string): TProjGatherTreeNode;
  78. procedure CalculateAll;
  79. procedure SaveDebugFile(const AFileName: string);
  80. property GatherNode: TProjGatherTreeNode read FGatherNode;
  81. property ProjCount: Integer read FProjCount;
  82. property SpecialProjCount: Integer read FSpecialProjCount;
  83. end;
  84. implementation
  85. uses
  86. ZhAPI, SysUtils, ConditionalDefines;
  87. { TProjGatherTreeNode }
  88. procedure TProjGatherTreeNode.AddCalcData(ANode: TProjGatherTreeNode);
  89. var
  90. iProj: Integer;
  91. begin
  92. GatherCalc.AddCalcData(ANode.GatherCalc);
  93. for iProj := 0 to ProjCount - 1 do
  94. Proj[iProj].AddCalcData(ANode.Proj[iProj]);
  95. end;
  96. procedure TProjGatherTreeNode.CalcTotalPrice_Rc;
  97. var
  98. iProj: Integer;
  99. begin
  100. GatherCalc.CalcTotalPrice_Rc(Price);
  101. for iProj := 0 to ProjCount - 1 do
  102. Proj[iProj].CalcTotalPrice_Rc(Price);
  103. end;
  104. constructor TProjGatherTreeNode.Create(ACacheTree: TCacheTree; AID: Integer; AProjCount, ASpeicalProjCount: Integer);
  105. var
  106. i: Integer;
  107. ProjCalc: TProjCalc;
  108. begin
  109. inherited Create(ACacheTree, AID);
  110. FGatherCalc := TProjCalc.Create;
  111. FProjs := TList.Create;
  112. for i := 0 to AProjCount - 1 do
  113. begin
  114. ProjCalc := TProjCalc.Create;
  115. FProjs.Add(ProjCalc);
  116. end;
  117. FSpecialProjs := TList.Create;
  118. for i := 0 to ASpeicalProjCount - 1 do
  119. begin
  120. ProjCalc := TProjCalc.Create;
  121. FSpecialProjs.Add(ProjCalc);
  122. end;
  123. end;
  124. destructor TProjGatherTreeNode.Destroy;
  125. begin
  126. FGatherCalc.free;
  127. ClearObjects(FProjs);
  128. FProjs.Free;
  129. ClearObjects(FSpecialProjs);
  130. FSpecialProjs.Free;
  131. inherited;
  132. end;
  133. function TProjGatherTreeNode.GetChapterParentID: Integer;
  134. var
  135. vNode: TProjGatherTreeNode;
  136. begin
  137. Result := -1;
  138. if Self.Level > 2 then
  139. begin
  140. vNode := TProjGatherTreeNode(Self.Parent);
  141. while vNode.Level > 2 do
  142. vNode := TProjGatherTreeNode(vNode.Parent);
  143. Result := vNode.ID
  144. end;
  145. end;
  146. function TProjGatherTreeNode.GetLevel: Integer;
  147. begin
  148. if Assigned(Parent) and (Parent.ID <> -1) then
  149. Result := TProjGatherTreeNode(Parent).Level + 1
  150. else
  151. Result := 1;
  152. end;
  153. function TProjGatherTreeNode.GetProj(AIndex: Integer): TProjCalc;
  154. begin
  155. Result := TProjCalc(FProjs.Items[AIndex]);
  156. end;
  157. function TProjGatherTreeNode.GetProjCount: Integer;
  158. begin
  159. Result := FProjs.Count;
  160. end;
  161. function TProjGatherTreeNode.GetSpecialProj(AIndex: Integer): TProjCalc;
  162. begin
  163. Result := TProjCalc(FSpecialProjs.Items[AIndex]);
  164. end;
  165. function TProjGatherTreeNode.GetSpecialProjCount: Integer;
  166. begin
  167. Result := FSpecialProjs.Count;
  168. end;
  169. procedure TProjGatherTreeNode.InitCalcData;
  170. var
  171. iProj: Integer;
  172. begin
  173. GatherCalc.InitCalcData;
  174. for iProj := 0 to ProjCount - 1 do
  175. Proj[iProj].InitCalcData;
  176. end;
  177. procedure TProjGatherTreeNode.InitTotalPrice_Rc;
  178. var
  179. iProj: Integer;
  180. begin
  181. GatherCalc.InitTotalPrice_Rc;
  182. for iProj := 0 to ProjCount - 1 do
  183. Proj[iProj].InitTotalPrice_Rc;
  184. end;
  185. procedure TProjGatherTreeNode.MinusCalcData(ANode: TProjGatherTreeNode);
  186. var
  187. iProj: Integer;
  188. begin
  189. GatherCalc.MinusCalcData(ANode.GatherCalc);
  190. for iProj := 0 to ProjCount - 1 do
  191. Proj[iProj].MinusCalcData(ANode.Proj[iProj]);
  192. end;
  193. procedure TProjGatherTreeNode.UpdateTotalPrice_Rc(ANode: TProjGatherTreeNode);
  194. var
  195. iProj: Integer;
  196. begin
  197. GatherCalc.UpdateTotalPrice_Rc(ANode.GatherCalc);
  198. for iProj := 0 to ANode.ProjCount - 1 do
  199. Proj[iProj].UpdateTotalPrice_Rc(ANode.Proj[iProj]);
  200. end;
  201. { TProjGatherTree }
  202. procedure TProjGatherTree.Calculate(ANode: TProjGatherTreeNode);
  203. var
  204. iChild: Integer;
  205. vChild: TProjGatherTreeNode;
  206. begin
  207. ANode.SerialNo := FSerialNo;
  208. Inc(FSerialNo);
  209. ANode.InitTotalPrice_Rc;
  210. if ANode.Children.Count > 0 then
  211. begin
  212. for iChild := 0 to ANode.Children.Count - 1 do
  213. begin
  214. vChild := TProjGatherTreeNode(ANode.Children.Items[iChild]);
  215. Calculate(vChild);
  216. ANode.UpdateTotalPrice_Rc(vChild);
  217. end;
  218. end
  219. else
  220. ANode.CalcTotalPrice_Rc;
  221. end;
  222. procedure TProjGatherTree.CalculateAll;
  223. var
  224. vNode: TProjGatherTreeNode;
  225. begin
  226. FSerialNo := 1;
  227. vNode := TProjGatherTreeNode(FirstNode);
  228. while Assigned(vNode) do
  229. begin
  230. Calculate(vNode);
  231. vNode := TProjGatherTreeNode(vNode.NextSibling);
  232. end;
  233. CalcGatherNode;
  234. end;
  235. constructor TProjGatherTree.Create(AProjCount, ASpecialProjCount: Integer);
  236. begin
  237. inherited Create;
  238. FProjCount := AProjCount;
  239. FSpecialProjCount := ASpecialProjCount;
  240. FFixedIDNodes := TList.Create;
  241. FGatherNode := TProjGatherTreeNode.Create(nil, -2, AProjCount, ASpecialProjCount);
  242. end;
  243. destructor TProjGatherTree.Destroy;
  244. begin
  245. FGatherNode.Free;
  246. FFixedIDNodes.Free;
  247. inherited;
  248. end;
  249. function TProjGatherTree.FindNode(AParent: TProjGatherTreeNode;
  250. const ACode, AB_Code, AName: string;
  251. APrice: Double): TProjGatherTreeNode;
  252. var
  253. iChild: Integer;
  254. vChild: TProjGatherTreeNode;
  255. begin
  256. Result := nil;
  257. for iChild := 0 to AParent.Children.Count - 1 do
  258. begin
  259. vChild := TProjGatherTreeNode(AParent.Children.Items[iChild]);
  260. if (vChild.Code = ACode) and (vChild.B_Code = AB_Code) and
  261. (vChild.Name = AName) and (abs(vChild.Price - APrice) < 0.00001) then
  262. begin
  263. Result := vChild;
  264. Break;
  265. end;
  266. end;
  267. end;
  268. function TProjGatherTree.FindNode(AParent: TProjGatherTreeNode;
  269. const ACode, AB_Code: string; APrice: Double): TProjGatherTreeNode;
  270. var
  271. iChild: Integer;
  272. vChild: TProjGatherTreeNode;
  273. begin
  274. Result := nil;
  275. for iChild := 0 to AParent.Children.Count - 1 do
  276. begin
  277. vChild := TProjGatherTreeNode(AParent.Children.Items[iChild]);
  278. if (vChild.Code = ACode) and (vChild.B_Code = AB_Code) and
  279. (abs(vChild.Price - APrice) < 0.00001) then
  280. begin
  281. Result := vChild;
  282. Break;
  283. end;
  284. end;
  285. end;
  286. function TProjGatherTree.FindNode(AParent: TProjGatherTreeNode;
  287. const AName: string; APrice: Double): TProjGatherTreeNode;
  288. var
  289. iChild: Integer;
  290. vChild: TProjGatherTreeNode;
  291. begin
  292. Result := nil;
  293. for iChild := 0 to AParent.Children.Count - 1 do
  294. begin
  295. vChild := TProjGatherTreeNode(AParent.Children.Items[iChild]);
  296. if (vChild.Name = AName) and (abs(vChild.Price - APrice) < 0.00001) then
  297. begin
  298. Result := vChild;
  299. Break;
  300. end;
  301. end;
  302. end;
  303. function TProjGatherTree.FindNextSibling(AParent: TProjGatherTreeNode;
  304. const ACode, AB_Code: string): TProjGatherTreeNode;
  305. var
  306. vNext: TProjGatherTreeNode;
  307. sCodeID, sCodeID2, sB_CodeID, sB_CodeID2: string;
  308. begin
  309. Result := nil;
  310. if Assigned(AParent) then
  311. vNext := TProjGatherTreeNode(AParent.FirstChild)
  312. else
  313. vNext := TProjGatherTreeNode(Root.FirstChild);
  314. if (ACode = '') and (AB_Code = '') then Exit;
  315. sCodeID := ConvertDigitCode(ACode, 3, '-');
  316. sB_CodeID := ConvertDigitCode(AB_Code, 4, '-');
  317. while Assigned(vNext) do
  318. begin
  319. sCodeID2 := ConvertDigitCode(vNext.Code, 3, '-');
  320. sB_CodeID2 := ConvertDigitCode(vNext.B_Code, 4, '-');
  321. if sCodeID < sCodeID2 then
  322. begin
  323. Result := vNext;
  324. Break;
  325. end
  326. else if sB_CodeID < sB_CodeID2 then
  327. begin
  328. Result := vNext;
  329. Break;
  330. end;
  331. vNext := TProjGatherTreeNode(vNext.NextSibling);
  332. end;
  333. end;
  334. function TProjGatherTree.FindNode(AFixedID: Integer): TProjGatherTreeNode;
  335. var
  336. i: Integer;
  337. vNode: TProjGatherTreeNode;
  338. begin
  339. Result := nil;
  340. for i := 0 to FFixedIDNodes.Count - 1 do
  341. begin
  342. vNode := TProjGatherTreeNode(FFixedIDNodes.Items[i]);
  343. if vNode.ID = AFixedID then
  344. begin
  345. Result := vNode;
  346. Break;
  347. end;
  348. end;
  349. end;
  350. function TProjGatherTree.GetNewNode(AFixedID: Integer): TProjGatherTreeNode;
  351. begin
  352. if AFixedID <> -1 then
  353. begin
  354. Result := TProjGatherTreeNode.Create(Self, AFixedID, FProjCount, FSpecialProjCount);
  355. FFixedIDNodes.Add(Result);
  356. end
  357. else
  358. Result := TProjGatherTreeNode.Create(Self, GetNewNodeID, FProjCount, FSpecialProjCount);
  359. CacheNodes.Add(Result);
  360. end;
  361. function TProjGatherTree.AddNode(AParent, ANextSibling: TProjGatherTreeNode;
  362. AFixedID: Integer): TProjGatherTreeNode;
  363. begin
  364. Result := GetNewNode(AFixedID);
  365. if Assigned(ANextSibling) then
  366. ANextSibling.InsertPreSibling(Result)
  367. else if Assigned(AParent) then
  368. AParent.InsertChild(Result)
  369. else
  370. Root.InsertChild(Result);
  371. end;
  372. procedure TProjGatherTree.SaveDebugFile(const AFileName: string);
  373. var
  374. sgs: TStringList;
  375. i: Integer;
  376. vNode: TProjGatherTreeNode;
  377. begin
  378. sgs := TStringList.Create;
  379. try
  380. for i := 0 to CacheNodes.Count - 1 do
  381. begin
  382. vNode := TProjGatherTreeNode(CacheNodes.Items[i]);
  383. sgs.Add(Format('ID: %d; Code: %s; B_Code: %s; Name: %s', [vNode.ID, vNode.Code, vNode.B_Code, vNode.Name]));
  384. end;
  385. sgs.SaveToFile(AFileName);
  386. finally
  387. sgs.Free;
  388. end;
  389. end;
  390. procedure TProjGatherTree.CalcGatherNode;
  391. procedure AddGatherCalc(AID: Integer);
  392. var
  393. vNode: TProjGatherTreeNode;
  394. begin
  395. vNode := FindNode(AID);
  396. if Assigned(vNode) then
  397. GatherNode.AddCalcData(vNode);
  398. end;
  399. procedure MinusGatherCalc(AID: Integer);
  400. var
  401. vNode: TProjGatherTreeNode;
  402. begin
  403. vNode := FindNode(AID);
  404. if Assigned(vNode) then
  405. GatherNode.MinusCalcData(vNode);
  406. end;
  407. begin
  408. GatherNode.InitCalcData;
  409. // 全国
  410. // 第一部分(1)+第二部分(2)+第三部分(3)+预备费(7)+新增加费用项目(其他费用_广东)(15)-回收金额(16)
  411. AddGatherCalc(1);
  412. AddGatherCalc(2);
  413. AddGatherCalc(3);
  414. AddGatherCalc(7);
  415. AddGatherCalc(15);
  416. MinusGatherCalc(16);
  417. // 广东
  418. // 全国的基础上+建设期贷款利息(34)+公路功能以外的项目(9)
  419. if _IsGuangDong then
  420. begin
  421. AddGatherCalc(34);
  422. AddGatherCalc(9);
  423. end;
  424. end;
  425. end.