ProjGather.pas 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328
  1. unit ProjGather;
  2. interface
  3. uses
  4. Classes, ProjGatherTree, GatherProjInfo, ProjectData, BillsTree, CalcData;
  5. type
  6. TProjGather = class;
  7. TWriteGatherData = procedure (AGather: TProjGather) of Object;
  8. TProjGather = class
  9. private
  10. FWriter: TWriteGatherData;
  11. FXmjCompare: Integer;
  12. FGclCompare: Integer;
  13. FTree: TProjGatherTree;
  14. FProjs: TList;
  15. FCommonProjs: TList;
  16. FSpecialProjs: TList;
  17. FSpecialProjTypes: TStrings;
  18. FProjectData: TProjectData;
  19. procedure OpenProjectData(AProj: TGatherProjInfo);
  20. procedure FreeProjectData;
  21. function FindBillsNode(ANode: TBillsIDTreeNode; AParent: TProjGatherTreeNode): TProjGatherTreeNode;
  22. function CreateBillsNode(ANode: TBillsIDTreeNode; AParent: TProjGatherTreeNode): TProjGatherTreeNode;
  23. procedure AddProjCalcData(AProjCalc: TProjCalc; ANode: TMeasureBillsIDTreeNode);
  24. function GatherBillsNode(ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode;
  25. AProjIndex: Integer): TProjGatherTreeNode;
  26. procedure GatherBills(ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode; AProjIndex: Integer);
  27. procedure GatherProj(AProj: TGatherProjInfo; AProjIndex: Integer);
  28. function GatherSpecialBillsNode(ANode: TMeasureBillsIDTreeNode;
  29. AParent: TProjGatherTreeNode; AProjType: Integer): TProjGatherTreeNode;
  30. procedure GatherSpecialBills(ANode: TMeasureBillsIDTreeNode;
  31. AParent: TProjGatherTreeNode; AProjType: Integer);
  32. procedure GatherSpecialProj(AProj: TGatherProjInfo);
  33. procedure FilterProjs;
  34. public
  35. constructor Create(AWriter: TWriteGatherData; AXmjCompare, AGclCompare: Integer);
  36. destructor Destroy; override;
  37. procedure Gather(AProjs: TList; ASpecialProjTypes: TStrings);
  38. property Tree: TProjGatherTree read FTree;
  39. property Projs: TList read FProjs;
  40. property CommonProj: TList read FCommonProjs;
  41. property SpecialProj: TList read FSpecialProjs;
  42. property SpecialProjTypes: TStrings read FSpecialProjTypes;
  43. end;
  44. implementation
  45. uses
  46. Globals, UtilMethods, sdIDTree, sdDB, mDataRecord, BillsMeasureDm;
  47. { TProjGather }
  48. procedure TProjGather.AddProjCalcData(AProjCalc: TProjCalc;
  49. ANode: TMeasureBillsIDTreeNode);
  50. var
  51. StageRec: TStageRecord;
  52. begin
  53. AProjCalc.Compile.Org.AddQuantity(ANode.Rec.OrgQuantity.AsFloat);
  54. AProjCalc.Compile.Org.AddTotalPrice(ANode.Rec.OrgTotalPrice.AsFloat);
  55. AProjCalc.Compile.Mis.AddQuantity(ANode.Rec.MisQuantity.AsFloat);
  56. AProjCalc.Compile.Mis.AddTotalPrice(ANode.Rec.MisTotalPrice.AsFloat);
  57. AProjCalc.Compile.Oth.AddQuantity(ANode.Rec.OthQuantity.AsFloat);
  58. AProjCalc.Compile.Oth.AddTotalPrice(ANode.Rec.OthTotalPrice.AsFloat);
  59. AProjCalc.Compile.SubTotal.AddQuantity(ANode.Rec.Quantity.AsFloat);
  60. AProjCalc.Compile.SubTotal.AddTotalPrice(ANode.Rec.TotalPrice.AsFloat);
  61. AProjCalc.AddMeasure.Deal.AddQuantity(ANode.Rec.AddDealQuantity.AsFloat);
  62. AProjCalc.AddMeasure.Deal.AddTotalPrice(ANode.Rec.AddDealTotalPrice.AsFloat);
  63. AProjCalc.AddMeasure.Qc.AddQuantity(ANode.Rec.AddQcQuantity.AsFloat);
  64. AProjCalc.AddMeasure.Qc.AddTotalPrice(ANode.Rec.AddQcTotalPrice.AsFloat);
  65. AProjCalc.AddMeasure.Gather.AddQuantity(ANode.Rec.AddGatherQuantity.AsFloat);
  66. AProjCalc.AddMeasure.Gather.AddTotalPrice(ANode.Rec.AddGatherTotalPrice.AsFloat);
  67. AProjCalc.DgnQuantity1 := AProjCalc.DgnQuantity1 + ANode.Rec.DgnQuantity1.AsFloat;
  68. AProjCalc.DgnQuantity2 := AProjCalc.DgnQuantity2 + ANode.Rec.DgnQuantity2.AsFloat;
  69. AProjCalc.DealDgnQuantity1 := AProjCalc.DealDgnQuantity1 + ANode.Rec.DealDgnQuantity1.AsFloat;
  70. AProjCalc.DealDgnQuantity2 := AProjCalc.DealDgnQuantity2 + ANode.Rec.DealDgnQuantity2.AsFloat;
  71. AProjCalc.CDgnQuantity1 := AProjCalc.CDgnQuantity1 + ANode.Rec.CDgnQuantity1.AsFloat;
  72. AProjCalc.CDgnQuantity2 := AProjCalc.CDgnQuantity2 + ANode.Rec.CDgnQuantity2.AsFloat;
  73. StageRec := ANode.StageRec;
  74. if Assigned(StageRec) then
  75. begin
  76. AProjCalc.CurMeasure.Deal.AddQuantity(StageRec.DealQuantity.AsFloat);
  77. AProjCalc.CurMeasure.Deal.AddTotalPrice(StageRec.DealTotalPrice.AsFloat);
  78. AProjCalc.CurMeasure.Qc.AddQuantity(StageRec.QcQuantity.AsFloat);
  79. AProjCalc.CurMeasure.Qc.AddTotalPrice(StageRec.QcTotalPrice.AsFloat);
  80. AProjCalc.CurMeasure.Gather.AddQuantity(StageRec.GatherQuantity.AsFloat);
  81. AProjCalc.CurMeasure.Gather.AddTotalPrice(StageRec.GatherTotalPrice.AsFloat);
  82. AProjCalc.PreMeasure.Deal.AddQuantity(StageRec.PreDealQuantity.AsFloat);
  83. AProjCalc.PreMeasure.Deal.AddTotalPrice(StageRec.PreDealTotalPrice.AsFloat);
  84. AProjCalc.PreMeasure.Qc.AddQuantity(StageRec.PreQcQuantity.AsFloat);
  85. AProjCalc.PreMeasure.Qc.AddTotalPrice(StageRec.PreQcTotalPrice.AsFloat);
  86. AProjCalc.PreMeasure.Gather.AddQuantity(StageRec.PreGatherQuantity.AsFloat);
  87. AProjCalc.PreMeasure.Gather.AddTotalPrice(StageRec.PreGatherTotalPrice.AsFloat);
  88. AProjCalc.EndMeasure.Deal.AddQuantity(StageRec.EndDealQuantity.AsFloat);
  89. AProjCalc.EndMeasure.Deal.AddTotalPrice(StageRec.EndDealTotalPrice.AsFloat);
  90. AProjCalc.EndMeasure.Qc.AddQuantity(StageRec.EndQcQuantity.AsFloat);
  91. AProjCalc.EndMeasure.Qc.AddTotalPrice(StageRec.EndQcTotalPrice.AsFloat);
  92. AProjCalc.EndMeasure.Gather.AddQuantity(StageRec.EndGatherQuantity.AsFloat);
  93. AProjCalc.EndMeasure.Gather.AddTotalPrice(StageRec.EndGatherTotalPrice.AsFloat);
  94. end;
  95. end;
  96. constructor TProjGather.Create(AWriter: TWriteGatherData;
  97. AXmjCompare, AGclCompare: Integer);
  98. begin
  99. FWriter := AWriter;
  100. FXmjCompare := AXmjCompare;
  101. FGclCompare := AGclCompare;
  102. FCommonProjs := TList.Create;
  103. FSpecialProjs := TList.Create;
  104. end;
  105. function TProjGather.CreateBillsNode(ANode: TBillsIDTreeNode;
  106. AParent: TProjGatherTreeNode): TProjGatherTreeNode;
  107. function GetB_CodeChapter(const AB_Code: string): Integer;
  108. var
  109. iValue, iError: Integer;
  110. begin
  111. Result := -1;
  112. Val(AB_Code, iValue, iError);
  113. if iValue > 0 then
  114. Result := iValue div 100;
  115. end;
  116. var
  117. vNextSibling: TProjGatherTreeNode;
  118. begin
  119. vNextSibling := FTree.FindNextSibling(AParent, ANode.Rec.Code.AsString, ANode.Rec.B_Code.AsString);
  120. if ANode.ID < 100 then
  121. Result := FTree.AddNode(AParent, vNextSibling, ANode.ID)
  122. else
  123. Result := FTree.AddNode(AParent, vNextSibling);
  124. Result.Code := ANode.Rec.Code.AsString;
  125. Result.B_Code := ANode.Rec.B_Code.AsString;
  126. Result.Name := ANode.Rec.Name.AsString;
  127. Result.Units := ANode.Rec.Units.AsString;
  128. Result.Price := ANode.Rec.Price.AsFloat;
  129. Result.XiangCode := ANode.Rec.XiangCode.AsString;
  130. Result.MuCode := ANode.Rec.MuCode.AsString;
  131. Result.JieCode := ANode.Rec.JieCode.AsString;
  132. Result.XiMuCode := ANode.Rec.XimuCode.AsString;
  133. Result.IndexCode := ANode.Rec.IndexCode.AsString;
  134. Result.B_CodeChapter := GetB_CodeChapter(Result.B_Code);
  135. end;
  136. destructor TProjGather.Destroy;
  137. begin
  138. FCommonProjs.Free;
  139. FSpecialProjs.Free;
  140. inherited;
  141. end;
  142. procedure TProjGather.FilterProjs;
  143. var
  144. i: Integer;
  145. vProjInfo: TGatherProjInfo;
  146. begin
  147. FCommonProjs.Clear;
  148. FSpecialProjs.Clear;
  149. for i := 0 to FProjs.Count - 1 do
  150. begin
  151. vProjInfo := TGatherProjInfo(FProjs.Items[i]);
  152. if vProjInfo.ProjType = 0 then
  153. FCommonProjs.Add(vProjInfo)
  154. else
  155. FSpecialProjs.Add(vProjInfo);
  156. end;
  157. end;
  158. function TProjGather.FindBillsNode(ANode: TBillsIDTreeNode;
  159. AParent: TProjGatherTreeNode): TProjGatherTreeNode;
  160. var
  161. iCompareType: Integer;
  162. begin
  163. if ANode.ID > 100 then
  164. begin
  165. if ANode.Rec.B_Code.AsString <> '' then
  166. iCompareType := FGclCompare
  167. else
  168. iCompareType := FXmjCompare;
  169. case iCompareType of
  170. // °´±àºÅ
  171. 0: if (ANode.Rec.Code.AsString <> '') or (ANode.Rec.B_Code.asString <> '') then
  172. Result := FTree.FindNode(AParent, ANode.Rec.Code.AsString, ANode.Rec.B_Code.AsString, ANode.Rec.Price.AsFloat)
  173. else
  174. Result := FTree.FindNode(AParent, ANode.Rec.Name.AsString, ANode.Rec.Price.AsFloat);
  175. // °´Ãû³Æ
  176. 1: Result := FTree.FindNode(AParent, ANode.Rec.Name.AsString, ANode.Rec.Price.AsFloat);
  177. // °´±àºÅ+Ãû³Æ
  178. 2: Result := FTree.FindNode(AParent, ANode.Rec.Code.AsString, ANode.Rec.B_Code.AsString, ANode.Rec.Name.AsString, ANode.Rec.Price.AsFloat);
  179. end;
  180. end
  181. else
  182. Result := FTree.FindNode(ANode.ID);
  183. end;
  184. procedure TProjGather.FreeProjectData;
  185. begin
  186. if not Assigned(OpenProjectManager.FindProjectData(FProjectData.ProjectID)) then
  187. FProjectData.Free;
  188. end;
  189. procedure TProjGather.Gather(AProjs: TList; ASpecialProjTypes: TStrings);
  190. var
  191. i: Integer;
  192. begin
  193. FProjs := AProjs;
  194. FilterProjs;
  195. FSpecialProjTypes := ASpecialProjTypes;
  196. if Assigned(ASpecialProjTypes) then
  197. FTree := TProjGatherTree.Create(FCommonProjs.Count, ASpecialProjTypes.Count)
  198. else
  199. FTree := TProjGatherTree.Create(FCommonProjs.Count, 0);
  200. FTree.NewNodeID := 101;
  201. try
  202. for i := 0 to FCommonProjs.Count - 1 do
  203. GatherProj(TGatherProjInfo(FCommonProjs.Items[i]), i);
  204. for i := 0 to FSpecialProjs.Count - 1 do
  205. GatherSpecialProj(TGatherProjInfo(FSpecialProjs.Items[i]));
  206. FTree.CalculateAll;
  207. if Assigned(FWriter) then
  208. FWriter(Self);
  209. finally
  210. FTree.Free;
  211. end;
  212. end;
  213. procedure TProjGather.GatherBills(ANode: TMeasureBillsIDTreeNode;
  214. AParent: TProjGatherTreeNode; AProjIndex: Integer);
  215. var
  216. vCur: TProjGatherTreeNode;
  217. begin
  218. if not Assigned(ANode) then Exit;
  219. vCur := GatherBillsNode(ANode, AParent, AProjIndex);
  220. GatherBills(TMeasureBillsIDTreeNode(ANode.FirstChild), vCur, AProjIndex);
  221. GatherBills(TMeasureBillsIDTreeNode(ANode.NextSibling), AParent, AProjIndex );
  222. end;
  223. function TProjGather.GatherBillsNode(ANode: TMeasureBillsIDTreeNode;
  224. AParent: TProjGatherTreeNode; AProjIndex: Integer): TProjGatherTreeNode;
  225. begin
  226. Result := FindBillsNode(ANode, AParent);
  227. if not Assigned(Result) then
  228. Result := CreateBillsNode(ANode, AParent);
  229. AddProjCalcData(Result.GatherCalc, ANode);
  230. AddProjCalcData(Result.Proj[AProjIndex], ANode);
  231. end;
  232. procedure TProjGather.GatherProj(AProj: TGatherProjInfo; AProjIndex: Integer);
  233. begin
  234. OpenProjectData(AProj);
  235. try
  236. with FProjectData.BillsMeasureData do
  237. GatherBills(TMeasureBillsIDTreeNode(BillsMeasureTree.FirstNode), nil, AProjIndex);
  238. finally
  239. FreeProjectData;
  240. end;
  241. end;
  242. procedure TProjGather.GatherSpecialProj(AProj: TGatherProjInfo);
  243. begin
  244. if (AProj.ProjType > 0) and (AProj.ProjType <= FSpecialProjTypes.Count) then
  245. begin
  246. OpenProjectData(AProj);
  247. try
  248. with FProjectData.BillsMeasureData do
  249. GatherSpecialBills(TMeasureBillsIDTreeNode(BillsMeasureTree.FirstNode), nil, AProj.ProjType);
  250. finally
  251. FreeProjectData;
  252. end;
  253. end;
  254. end;
  255. procedure TProjGather.GatherSpecialBills(ANode: TMeasureBillsIDTreeNode;
  256. AParent: TProjGatherTreeNode; AProjType: Integer);
  257. var
  258. vCur: TProjGatherTreeNode;
  259. begin
  260. if not Assigned(ANode) then Exit;
  261. vCur := GatherSpecialBillsNode(ANode, AParent, AProjType);
  262. GatherSpecialBills(TMeasureBillsIDTreeNode(ANode.FirstChild), vCur, AProjType);
  263. GatherSpecialBills(TMeasureBillsIDTreeNode(ANode.NextSibling), AParent, AProjType );
  264. end;
  265. procedure TProjGather.OpenProjectData(AProj: TGatherProjInfo);
  266. begin
  267. FProjectData := OpenProjectManager.FindProjectData(AProj.ProjectID);
  268. if not Assigned(FProjectData) then
  269. begin
  270. FProjectData := TProjectData.Create;
  271. FProjectData.OpenForReport3(GetMyProjectsFilePath + AProj.FileName);
  272. end;
  273. end;
  274. function TProjGather.GatherSpecialBillsNode(
  275. ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode;
  276. AProjType: Integer): TProjGatherTreeNode;
  277. begin
  278. Result := FindBillsNode(ANode, AParent);
  279. if not Assigned(Result) then
  280. Result := CreateBillsNode(ANode, AParent);
  281. AddProjCalcData(Result.SpecialProj[AProjType - 1], ANode);
  282. end;
  283. end.