ProjGather.pas 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639
  1. unit ProjGather;
  2. interface
  3. uses
  4. Classes, ProjGatherTree, GatherProjInfo, ProjectData, BillsTree, CalcData,
  5. PhaseData, ProjGatherDealPay, sdDB, ProjGatherProperties;
  6. type
  7. TProjGather = class;
  8. TWriteGatherData = procedure (AGather: TProjGather) of Object;
  9. TProjGather = class
  10. private
  11. FWriter: TWriteGatherData;
  12. FXmjCompare: Integer;
  13. FGclCompare: Integer;
  14. FTree: TProjGatherTree;
  15. FDealPay: TProjGatherDealPayList;
  16. FProperties: TProjGatherProperties;
  17. FDealCurField: string;
  18. FDealPreField: string;
  19. FDealEndField: string;
  20. FProjs: TList;
  21. FCommonProjs: TList;
  22. FSpecialProjs: TList;
  23. FSpecialProjTypes: TStrings;
  24. FProjectData: TProjectData;
  25. function FindBillsNode(ANode: TBillsIDTreeNode; AParent: TProjGatherTreeNode): TProjGatherTreeNode;
  26. function CreateBillsNode(ANode: TBillsIDTreeNode; AParent: TProjGatherTreeNode): TProjGatherTreeNode;
  27. procedure AddProjCalcData(AProjCalc: TProjCalc; ANode: TMeasureBillsIDTreeNode);
  28. procedure AddProjDealPayCalcData(ADealPayCalc: TDealPayCalcData; ARec: TsdDataRecord);
  29. function GatherBillsNode(ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode;
  30. AProjIndex: Integer): TProjGatherTreeNode;
  31. procedure GatherBills(ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode; AProjIndex: Integer);
  32. procedure GatherDealPays(AProjIndex: Integer);
  33. procedure GatherProjProperties;
  34. function GatherSpecialBillsNode(ANode: TMeasureBillsIDTreeNode;
  35. AParent: TProjGatherTreeNode; AProjType: Integer): TProjGatherTreeNode;
  36. procedure GatherSpecialBills(ANode: TMeasureBillsIDTreeNode;
  37. AParent: TProjGatherTreeNode; AProjType: Integer);
  38. procedure GatherSpecialDealPays(AProjType: Integer);
  39. procedure GatherSpecialProj(AProj: TGatherProjInfo);
  40. procedure FilterProjs;
  41. protected
  42. procedure OpenProjectData(AProj: TGatherProjInfo); virtual;
  43. procedure FreeProjectData; virtual;
  44. procedure BeforeGather;
  45. procedure AfterGather;
  46. procedure GatherProj(AProj: TGatherProjInfo; AProjIndex: Integer);
  47. procedure AddProjMeasureCalcData(AProjCalc: TProjCalc; ANode: TMeasureBillsIDTreeNode); virtual;
  48. procedure AddProjDealPayPhaseCalcData(ADealPayCalc: TDealPayCalcData; ARec: TsdDataRecord); virtual;
  49. public
  50. constructor Create(AWriter: TWriteGatherData; AXmjCompare, AGclCompare: Integer);
  51. destructor Destroy; override;
  52. procedure Gather(AProjs: TList; ASpecialProjTypes: TStrings);
  53. property ProjectData: TProjectData read FProjectData;
  54. property Tree: TProjGatherTree read FTree;
  55. property DealPay: TProjGatherDealPayList read FDealPay;
  56. property Properties: TProjGatherProperties read FProperties;
  57. property Projs: TList read FProjs;
  58. property CommonProj: TList read FCommonProjs;
  59. property SpecialProj: TList read FSpecialProjs;
  60. property SpecialProjTypes: TStrings read FSpecialProjTypes;
  61. end;
  62. TZoneProjGather = class(TProjGather)
  63. private
  64. FBeginPhaseIndex: Integer;
  65. FEndPhaseIndex: Integer;
  66. FBeginPhaseData: TPhaseData;
  67. FEndPhaseData: TPhaseData;
  68. protected
  69. procedure OpenProjectData(AProj: TGatherProjInfo); override;
  70. procedure FreeProjectData; override;
  71. procedure AddProjMeasureCalcData(AProjCalc: TProjCalc; ANode: TMeasureBillsIDTreeNode); override;
  72. procedure AddProjDealPayPhaseCalcData(ADealPayCalc: TDealPayCalcData; ARec: TsdDataRecord); override;
  73. public
  74. procedure Gather(AProjs: TList; ABeginPhaseIndex, AEndPhaseIndex: Integer); overload;
  75. end;
  76. implementation
  77. uses
  78. Globals, UtilMethods, sdIDTree, mDataRecord, BillsMeasureDm, SysUtils,
  79. Math, DealPaymentDm;
  80. { TProjGather }
  81. procedure TProjGather.AddProjCalcData(AProjCalc: TProjCalc;
  82. ANode: TMeasureBillsIDTreeNode);
  83. begin
  84. AProjCalc.Compile.Org.AddQuantity(ANode.Rec.OrgQuantity.AsFloat);
  85. AProjCalc.Compile.Org.AddTotalPrice(ANode.Rec.OrgTotalPrice.AsFloat);
  86. AProjCalc.Compile.Mis.AddQuantity(ANode.Rec.MisQuantity.AsFloat);
  87. AProjCalc.Compile.Mis.AddTotalPrice(ANode.Rec.MisTotalPrice.AsFloat);
  88. AProjCalc.Compile.Oth.AddQuantity(ANode.Rec.OthQuantity.AsFloat);
  89. AProjCalc.Compile.Oth.AddTotalPrice(ANode.Rec.OthTotalPrice.AsFloat);
  90. AProjCalc.Compile.SubTotal.AddQuantity(ANode.Rec.Quantity.AsFloat);
  91. AProjCalc.Compile.SubTotal.AddTotalPrice(ANode.Rec.TotalPrice.AsFloat);
  92. AProjCalc.AddMeasure.Deal.AddQuantity(ANode.Rec.AddDealQuantity.AsFloat);
  93. AProjCalc.AddMeasure.Deal.AddTotalPrice(ANode.Rec.AddDealTotalPrice.AsFloat);
  94. AProjCalc.AddMeasure.Qc.AddQuantity(ANode.Rec.AddQcQuantity.AsFloat);
  95. AProjCalc.AddMeasure.Qc.AddTotalPrice(ANode.Rec.AddQcTotalPrice.AsFloat);
  96. AProjCalc.AddMeasure.Gather.AddQuantity(ANode.Rec.AddGatherQuantity.AsFloat);
  97. AProjCalc.AddMeasure.Gather.AddTotalPrice(ANode.Rec.AddGatherTotalPrice.AsFloat);
  98. AProjCalc.DgnQuantity1 := AProjCalc.DgnQuantity1 + ANode.Rec.DgnQuantity1.AsFloat;
  99. AProjCalc.DgnQuantity2 := AProjCalc.DgnQuantity2 + ANode.Rec.DgnQuantity2.AsFloat;
  100. AProjCalc.DealDgnQuantity1 := AProjCalc.DealDgnQuantity1 + ANode.Rec.DealDgnQuantity1.AsFloat;
  101. AProjCalc.DealDgnQuantity2 := AProjCalc.DealDgnQuantity2 + ANode.Rec.DealDgnQuantity2.AsFloat;
  102. AProjCalc.CDgnQuantity1 := AProjCalc.CDgnQuantity1 + ANode.Rec.CDgnQuantity1.AsFloat;
  103. AProjCalc.CDgnQuantity2 := AProjCalc.CDgnQuantity2 + ANode.Rec.CDgnQuantity2.AsFloat;
  104. AddProjMeasureCalcData(AProjCalc, ANode);
  105. end;
  106. constructor TProjGather.Create(AWriter: TWriteGatherData;
  107. AXmjCompare, AGclCompare: Integer);
  108. begin
  109. FWriter := AWriter;
  110. FXmjCompare := AXmjCompare;
  111. FGclCompare := AGclCompare;
  112. FCommonProjs := TList.Create;
  113. FSpecialProjs := TList.Create;
  114. end;
  115. function TProjGather.CreateBillsNode(ANode: TBillsIDTreeNode;
  116. AParent: TProjGatherTreeNode): TProjGatherTreeNode;
  117. function GetB_CodeChapter(const AB_Code: string): Integer;
  118. var
  119. iValue, iError: Integer;
  120. begin
  121. Result := -1;
  122. Val(AB_Code, iValue, iError);
  123. if iValue > 0 then
  124. Result := iValue div 100;
  125. end;
  126. var
  127. vNextSibling: TProjGatherTreeNode;
  128. begin
  129. vNextSibling := FTree.FindNextSibling(AParent, ANode.Rec.Code.AsString, ANode.Rec.B_Code.AsString);
  130. if ANode.ID < 100 then
  131. Result := FTree.AddNode(AParent, vNextSibling, ANode.ID)
  132. else
  133. Result := FTree.AddNode(AParent, vNextSibling);
  134. Result.Code := ANode.Rec.Code.AsString;
  135. Result.B_Code := ANode.Rec.B_Code.AsString;
  136. Result.Name := ANode.Rec.Name.AsString;
  137. Result.Units := ANode.Rec.Units.AsString;
  138. Result.Price := ANode.Rec.Price.AsFloat;
  139. Result.XiangCode := ANode.Rec.XiangCode.AsString;
  140. Result.MuCode := ANode.Rec.MuCode.AsString;
  141. Result.JieCode := ANode.Rec.JieCode.AsString;
  142. Result.XiMuCode := ANode.Rec.XimuCode.AsString;
  143. Result.IndexCode := ANode.Rec.IndexCode.AsString;
  144. Result.B_CodeChapter := GetB_CodeChapter(Result.B_Code);
  145. end;
  146. destructor TProjGather.Destroy;
  147. begin
  148. FCommonProjs.Free;
  149. FSpecialProjs.Free;
  150. inherited;
  151. end;
  152. procedure TProjGather.FilterProjs;
  153. var
  154. i: Integer;
  155. vProjInfo: TGatherProjInfo;
  156. begin
  157. FCommonProjs.Clear;
  158. FSpecialProjs.Clear;
  159. for i := 0 to FProjs.Count - 1 do
  160. begin
  161. vProjInfo := TGatherProjInfo(FProjs.Items[i]);
  162. if vProjInfo.ProjType = 0 then
  163. FCommonProjs.Add(vProjInfo)
  164. else
  165. FSpecialProjs.Add(vProjInfo);
  166. end;
  167. end;
  168. function TProjGather.FindBillsNode(ANode: TBillsIDTreeNode;
  169. AParent: TProjGatherTreeNode): TProjGatherTreeNode;
  170. var
  171. iCompareType: Integer;
  172. begin
  173. if ANode.ID > 100 then
  174. begin
  175. if ANode.Rec.B_Code.AsString <> '' then
  176. iCompareType := FGclCompare
  177. else
  178. iCompareType := FXmjCompare;
  179. case iCompareType of
  180. // °´±àºÅ
  181. 0: if (ANode.Rec.Code.AsString <> '') or (ANode.Rec.B_Code.asString <> '') then
  182. Result := FTree.FindNode(AParent, ANode.Rec.Code.AsString, ANode.Rec.B_Code.AsString, ANode.Rec.Price.AsFloat)
  183. else
  184. Result := FTree.FindNode(AParent, ANode.Rec.Name.AsString, ANode.Rec.Price.AsFloat);
  185. // °´Ãû³Æ
  186. 1: Result := FTree.FindNode(AParent, ANode.Rec.Name.AsString, ANode.Rec.Price.AsFloat);
  187. // °´±àºÅ+Ãû³Æ
  188. 2: Result := FTree.FindNode(AParent, ANode.Rec.Code.AsString, ANode.Rec.B_Code.AsString, ANode.Rec.Name.AsString, ANode.Rec.Price.AsFloat);
  189. end;
  190. end
  191. else
  192. Result := FTree.FindNode(ANode.ID);
  193. end;
  194. procedure TProjGather.FreeProjectData;
  195. begin
  196. if not Assigned(OpenProjectManager.FindProjectData(FProjectData.ProjectID)) then
  197. FProjectData.Free;
  198. end;
  199. procedure TProjGather.Gather(AProjs: TList; ASpecialProjTypes: TStrings);
  200. var
  201. i: Integer;
  202. begin
  203. FProjs := AProjs;
  204. FilterProjs;
  205. FSpecialProjTypes := ASpecialProjTypes;
  206. BeforeGather;
  207. try
  208. for i := 0 to FCommonProjs.Count - 1 do
  209. GatherProj(TGatherProjInfo(FCommonProjs.Items[i]), i);
  210. for i := 0 to FSpecialProjs.Count - 1 do
  211. GatherSpecialProj(TGatherProjInfo(FSpecialProjs.Items[i]));
  212. FTree.CalculateAll;
  213. if Assigned(FWriter) then
  214. FWriter(Self);
  215. finally
  216. AfterGather;
  217. end;
  218. end;
  219. procedure TProjGather.GatherBills(ANode: TMeasureBillsIDTreeNode;
  220. AParent: TProjGatherTreeNode; AProjIndex: Integer);
  221. var
  222. vCur: TProjGatherTreeNode;
  223. begin
  224. if not Assigned(ANode) then Exit;
  225. vCur := GatherBillsNode(ANode, AParent, AProjIndex);
  226. GatherBills(TMeasureBillsIDTreeNode(ANode.FirstChild), vCur, AProjIndex);
  227. GatherBills(TMeasureBillsIDTreeNode(ANode.NextSibling), AParent, AProjIndex );
  228. end;
  229. function TProjGather.GatherBillsNode(ANode: TMeasureBillsIDTreeNode;
  230. AParent: TProjGatherTreeNode; AProjIndex: Integer): TProjGatherTreeNode;
  231. begin
  232. Result := FindBillsNode(ANode, AParent);
  233. if not Assigned(Result) then
  234. Result := CreateBillsNode(ANode, AParent);
  235. AddProjCalcData(Result.GatherCalc, ANode);
  236. AddProjCalcData(Result.Proj[AProjIndex], ANode);
  237. end;
  238. procedure TProjGather.GatherProj(AProj: TGatherProjInfo; AProjIndex: Integer);
  239. begin
  240. OpenProjectData(AProj);
  241. try
  242. with FProjectData.BillsMeasureData do
  243. GatherBills(TMeasureBillsIDTreeNode(BillsMeasureTree.FirstNode), nil, AProjIndex);
  244. GatherDealPays(AProjIndex);
  245. GatherProjProperties;
  246. finally
  247. FreeProjectData;
  248. end;
  249. end;
  250. procedure TProjGather.GatherSpecialProj(AProj: TGatherProjInfo);
  251. begin
  252. if (AProj.ProjType > 0) and (AProj.ProjType <= FSpecialProjTypes.Count) then
  253. begin
  254. OpenProjectData(AProj);
  255. try
  256. with FProjectData.BillsMeasureData do
  257. GatherSpecialBills(TMeasureBillsIDTreeNode(BillsMeasureTree.FirstNode), nil, AProj.ProjType);
  258. GatherSpecialDealPays(AProj.ProjType);
  259. finally
  260. FreeProjectData;
  261. end;
  262. end;
  263. end;
  264. procedure TProjGather.GatherSpecialBills(ANode: TMeasureBillsIDTreeNode;
  265. AParent: TProjGatherTreeNode; AProjType: Integer);
  266. var
  267. vCur: TProjGatherTreeNode;
  268. begin
  269. if not Assigned(ANode) then Exit;
  270. vCur := GatherSpecialBillsNode(ANode, AParent, AProjType);
  271. GatherSpecialBills(TMeasureBillsIDTreeNode(ANode.FirstChild), vCur, AProjType);
  272. GatherSpecialBills(TMeasureBillsIDTreeNode(ANode.NextSibling), AParent, AProjType );
  273. end;
  274. procedure TProjGather.OpenProjectData(AProj: TGatherProjInfo);
  275. begin
  276. FProjectData := OpenProjectManager.FindProjectData(AProj.ProjectID);
  277. if not Assigned(FProjectData) then
  278. begin
  279. FProjectData := TProjectData.Create;
  280. FProjectData.OpenForReport3(GetMyProjectsFilePath + AProj.FileName);
  281. end;
  282. end;
  283. function TProjGather.GatherSpecialBillsNode(
  284. ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode;
  285. AProjType: Integer): TProjGatherTreeNode;
  286. begin
  287. Result := FindBillsNode(ANode, AParent);
  288. if not Assigned(Result) then
  289. Result := CreateBillsNode(ANode, AParent);
  290. AddProjCalcData(Result.SpecialProj[AProjType - 1], ANode);
  291. end;
  292. procedure TProjGather.AddProjMeasureCalcData(AProjCalc: TProjCalc;
  293. ANode: TMeasureBillsIDTreeNode);
  294. var
  295. StageRec: TStageRecord;
  296. begin
  297. StageRec := ANode.StageRec;
  298. if Assigned(StageRec) then
  299. begin
  300. AProjCalc.CurMeasure.Deal.AddQuantity(StageRec.DealQuantity.AsFloat);
  301. AProjCalc.CurMeasure.Deal.AddTotalPrice(StageRec.DealTotalPrice.AsFloat);
  302. AProjCalc.CurMeasure.Qc.AddQuantity(StageRec.QcQuantity.AsFloat);
  303. AProjCalc.CurMeasure.Qc.AddTotalPrice(StageRec.QcTotalPrice.AsFloat);
  304. AProjCalc.CurMeasure.Gather.AddQuantity(StageRec.GatherQuantity.AsFloat);
  305. AProjCalc.CurMeasure.Gather.AddTotalPrice(StageRec.GatherTotalPrice.AsFloat);
  306. AProjCalc.PreMeasure.Deal.AddQuantity(StageRec.PreDealQuantity.AsFloat);
  307. AProjCalc.PreMeasure.Deal.AddTotalPrice(StageRec.PreDealTotalPrice.AsFloat);
  308. AProjCalc.PreMeasure.Qc.AddQuantity(StageRec.PreQcQuantity.AsFloat);
  309. AProjCalc.PreMeasure.Qc.AddTotalPrice(StageRec.PreQcTotalPrice.AsFloat);
  310. AProjCalc.PreMeasure.Gather.AddQuantity(StageRec.PreGatherQuantity.AsFloat);
  311. AProjCalc.PreMeasure.Gather.AddTotalPrice(StageRec.PreGatherTotalPrice.AsFloat);
  312. AProjCalc.EndMeasure.Deal.AddQuantity(StageRec.EndDealQuantity.AsFloat);
  313. AProjCalc.EndMeasure.Deal.AddTotalPrice(StageRec.EndDealTotalPrice.AsFloat);
  314. AProjCalc.EndMeasure.Qc.AddQuantity(StageRec.EndQcQuantity.AsFloat);
  315. AProjCalc.EndMeasure.Qc.AddTotalPrice(StageRec.EndQcTotalPrice.AsFloat);
  316. AProjCalc.EndMeasure.Gather.AddQuantity(StageRec.EndGatherQuantity.AsFloat);
  317. AProjCalc.EndMeasure.Gather.AddTotalPrice(StageRec.EndGatherTotalPrice.AsFloat);
  318. end;
  319. end;
  320. procedure TProjGather.GatherDealPays(AProjIndex: Integer);
  321. var
  322. idxView: TsdIndex;
  323. iRec: Integer;
  324. vRec: TsdDataRecord;
  325. vDealPay: TProjGatherDealPayNode;
  326. begin
  327. with FProjectData.DealPaymentData do
  328. begin
  329. idxView := sddDealPayment.FindIndex('idxView');
  330. if FProjectData.PhaseData.Active then
  331. begin
  332. FDealCurField := 'TotalPrice' + IntToStr(FProjectData.PhaseData.StageIndex);
  333. FDealPreField := 'PreTotalPrice' + IntToStr(FProjectData.PhaseData.StageIndex);
  334. FDealEndField := 'EndTotalPrice' + IntToStr(FProjectData.PhaseData.StageIndex);
  335. end;
  336. for iRec := 0 to idxView.RecordCount - 1 do
  337. begin
  338. vRec := idxView.Records[iRec];
  339. vDealPay := FDealPay.GetDealPayNode(vRec);
  340. AddProjDealPayCalcData(vDealPay.GatherCalc, vRec);
  341. AddProjDealPayCalcData(vDealPay.Proj[AProjIndex], vRec);
  342. end;
  343. end;
  344. end;
  345. procedure TProjGather.GatherSpecialDealPays(AProjType: Integer);
  346. var
  347. idxView: TsdIndex;
  348. iRec: Integer;
  349. vRec: TsdDataRecord;
  350. vDealPay: TProjGatherDealPayNode;
  351. begin
  352. with FProjectData.DealPaymentData do
  353. begin
  354. idxView := sddDealPayment.FindIndex('idxView');
  355. for iRec := 0 to idxView.RecordCount - 1 do
  356. begin
  357. vRec := idxView.Records[iRec];
  358. vDealPay := FDealPay.GetDealPayNode(vRec);
  359. AddProjDealPayCalcData(vDealPay.SpecialProj[AProjType - 1], vRec);
  360. end;
  361. end;
  362. end;
  363. procedure TProjGather.AddProjDealPayCalcData(ADealPayCalc: TDealPayCalcData;
  364. ARec: TsdDataRecord);
  365. begin
  366. ADealPayCalc.AddTotalPrice := ADealPayCalc.AddTotalPrice + ARec.ValueByName('TotalPrice').AsFloat;
  367. AddProjDealPayPhaseCalcData(ADealPayCalc, ARec);
  368. end;
  369. procedure TProjGather.BeforeGather;
  370. var
  371. iSpecial: Integer;
  372. begin
  373. if Assigned(FSpecialProjTypes) then
  374. iSpecial := FSpecialProjTypes.Count
  375. else
  376. iSpecial := 0;
  377. FTree := TProjGatherTree.Create(FCommonProjs.Count, iSpecial);
  378. FTree.NewNodeID := 101;
  379. FDealPay := TProjGatherDealPayList.Create(FCommonProjs.Count, iSpecial);
  380. FProperties := TProjGatherProperties.Create;
  381. end;
  382. procedure TProjGather.AfterGather;
  383. begin
  384. FProperties.Free;
  385. FDealPay.Free;
  386. FTree.Free;
  387. end;
  388. procedure TProjGather.GatherProjProperties;
  389. procedure GatherFloatProjProperty(const AName: string);
  390. var
  391. fValue: Double;
  392. vProperty: TProjGatherProperty;
  393. begin
  394. vProperty := FProperties.GetProjGatherProperty(AName);
  395. fValue := FProjectData.ProjProperties.GetFloatPropertyDef(AName, 0);
  396. fValue := fValue + StrToFloatDef(vProperty.Value, 0);
  397. vProperty.Value := FloatToStr(fValue);
  398. end;
  399. begin
  400. GatherFloatProjProperty('ContractPrice');
  401. GatherFloatProjProperty('MaterialSubsist');
  402. GatherFloatProjProperty('StartedSubsist');
  403. end;
  404. procedure TProjGather.AddProjDealPayPhaseCalcData(
  405. ADealPayCalc: TDealPayCalcData; ARec: TsdDataRecord);
  406. var
  407. vPhaseRec: TsdDataRecord;
  408. begin
  409. if FProjectData.PhaseData.Active then
  410. vPhaseRec := FProjectData.PhaseData.PhasePayData.PayRecord(ARec.ValueByName('ID').AsInteger)
  411. else
  412. vPhaseRec := nil;
  413. if Assigned(vPhaseRec) then
  414. begin
  415. ADealPayCalc.CurTotalPrice := ADealPayCalc.CurTotalPrice + vPhaseRec.ValueByName(FDealCurField).AsFloat;
  416. ADealPayCalc.PreTotalPrice := ADealPayCalc.PreTotalPrice + vPhaseRec.ValueByName(FDealPreField).AsFloat;
  417. ADealPayCalc.EndTotalPrice := ADealPayCalc.EndTotalPrice + vPhaseRec.ValueByName(FDealEndField).AsFloat;
  418. end;
  419. end;
  420. { TZoneProjGather }
  421. procedure TZoneProjGather.AddProjDealPayPhaseCalcData(
  422. ADealPayCalc: TDealPayCalcData; ARec: TsdDataRecord);
  423. var
  424. vPhaseRec: TsdDataRecord;
  425. begin
  426. if Assigned(FEndPhaseData) then
  427. vPhaseRec := FEndPhaseData.PhasePayData.PayRecord(ARec.ValueByName('ID').AsInteger)
  428. else
  429. vPhaseRec := nil;
  430. if Assigned(vPhaseRec) then
  431. begin
  432. ADealPayCalc.CurTotalPrice := ADealPayCalc.CurTotalPrice + vPhaseRec.ValueByName(FDealCurField).AsFloat;
  433. ADealPayCalc.PreTotalPrice := ADealPayCalc.PreTotalPrice + vPhaseRec.ValueByName(FDealPreField).AsFloat;
  434. ADealPayCalc.EndTotalPrice := ADealPayCalc.EndTotalPrice + vPhaseRec.ValueByName(FDealEndField).AsFloat;
  435. ADealPayCalc.ZoneTotalPrice := ADealPayCalc.ZoneTotalPrice + vPhaseRec.ValueByName(FDealEndField).AsFloat;
  436. end;
  437. if Assigned(FBeginPhaseData) then
  438. vPhaseRec := FBeginPhaseData.PhasePayData.PayRecord(ARec.ValueByName('ID').AsInteger)
  439. else
  440. vPhaseRec := nil;
  441. if Assigned(vPhaseRec) then
  442. begin
  443. ADealPayCalc.ZoneTotalPrice := ADealPayCalc.ZoneTotalPrice - vPhaseRec.ValueByName(FDealPreField).AsFloat;
  444. end;
  445. end;
  446. procedure TZoneProjGather.AddProjMeasureCalcData(AProjCalc: TProjCalc;
  447. ANode: TMeasureBillsIDTreeNode);
  448. var
  449. StageRec: TStageRecord;
  450. begin
  451. if Assigned(FEndPhaseData) then
  452. StageRec := FEndPhaseData.StageData.StageRecord(ANode.ID)
  453. else
  454. StageRec := nil;
  455. if Assigned(StageRec) then
  456. begin
  457. AProjCalc.CurMeasure.Deal.AddQuantity(StageRec.DealQuantity.AsFloat);
  458. AProjCalc.CurMeasure.Deal.AddTotalPrice(StageRec.DealTotalPrice.AsFloat);
  459. AProjCalc.CurMeasure.Qc.AddQuantity(StageRec.QcQuantity.AsFloat);
  460. AProjCalc.CurMeasure.Qc.AddTotalPrice(StageRec.QcTotalPrice.AsFloat);
  461. AProjCalc.CurMeasure.Gather.AddQuantity(StageRec.GatherQuantity.AsFloat);
  462. AProjCalc.CurMeasure.Gather.AddTotalPrice(StageRec.GatherTotalPrice.AsFloat);
  463. AProjCalc.PreMeasure.Deal.AddQuantity(StageRec.PreDealQuantity.AsFloat);
  464. AProjCalc.PreMeasure.Deal.AddTotalPrice(StageRec.PreDealTotalPrice.AsFloat);
  465. AProjCalc.PreMeasure.Qc.AddQuantity(StageRec.PreQcQuantity.AsFloat);
  466. AProjCalc.PreMeasure.Qc.AddTotalPrice(StageRec.PreQcTotalPrice.AsFloat);
  467. AProjCalc.PreMeasure.Gather.AddQuantity(StageRec.PreGatherQuantity.AsFloat);
  468. AProjCalc.PreMeasure.Gather.AddTotalPrice(StageRec.PreGatherTotalPrice.AsFloat);
  469. AProjCalc.EndMeasure.Deal.AddQuantity(StageRec.EndDealQuantity.AsFloat);
  470. AProjCalc.EndMeasure.Deal.AddTotalPrice(StageRec.EndDealTotalPrice.AsFloat);
  471. AProjCalc.EndMeasure.Qc.AddQuantity(StageRec.EndQcQuantity.AsFloat);
  472. AProjCalc.EndMeasure.Qc.AddTotalPrice(StageRec.EndQcTotalPrice.AsFloat);
  473. AProjCalc.EndMeasure.Gather.AddQuantity(StageRec.EndGatherQuantity.AsFloat);
  474. AProjCalc.EndMeasure.Gather.AddTotalPrice(StageRec.EndGatherTotalPrice.AsFloat);
  475. AProjCalc.ZoneMeasure.Deal.AddQuantity(StageRec.EndDealQuantity.AsFloat);
  476. AProjCalc.ZoneMeasure.Deal.AddTotalPrice(StageRec.EndDealTotalPrice.AsFloat);
  477. AProjCalc.ZoneMeasure.Qc.AddQuantity(StageRec.EndQcQuantity.AsFloat);
  478. AProjCalc.ZoneMeasure.Qc.AddTotalPrice(StageRec.EndQcTotalPrice.AsFloat);
  479. AProjCalc.ZoneMeasure.Gather.AddQuantity(StageRec.EndGatherQuantity.AsFloat);
  480. AProjCalc.ZoneMeasure.Gather.AddTotalPrice(StageRec.EndGatherTotalPrice.AsFloat);
  481. end;
  482. if Assigned(FBeginPhaseData) then
  483. StageRec := FBeginPhaseData.StageData.StageRecord(ANode.ID)
  484. else
  485. StageRec := nil;
  486. if Assigned(StageRec) then
  487. begin
  488. AProjCalc.ZoneMeasure.Deal.AddQuantity(-StageRec.PreDealQuantity.AsFloat);
  489. AProjCalc.ZoneMeasure.Deal.AddTotalPrice(-StageRec.PreDealTotalPrice.AsFloat);
  490. AProjCalc.ZoneMeasure.Qc.AddQuantity(-StageRec.PreQcQuantity.AsFloat);
  491. AProjCalc.ZoneMeasure.Qc.AddTotalPrice(-StageRec.PreQcTotalPrice.AsFloat);
  492. AProjCalc.ZoneMeasure.Gather.AddQuantity(-StageRec.PreGatherQuantity.AsFloat);
  493. AProjCalc.ZoneMeasure.Gather.AddTotalPrice(-StageRec.PreGatherTotalPrice.AsFloat);
  494. end;
  495. end;
  496. procedure TZoneProjGather.FreeProjectData;
  497. begin
  498. inherited;
  499. if Assigned(ProjectData) and (ProjectData.PhaseData <> FBeginPhaseData) and Assigned(FBeginPhaseData) then
  500. FBeginPhaseData.Free;
  501. if Assigned(ProjectData) and (ProjectData.PhaseData <> FEndPhaseData) and Assigned(FEndPhaseData) then
  502. FEndPhaseData.Free;
  503. end;
  504. procedure TZoneProjGather.Gather(AProjs: TList; ABeginPhaseIndex,
  505. AEndPhaseIndex: Integer);
  506. var
  507. i: Integer;
  508. begin
  509. FProjs := AProjs;
  510. FCommonProjs.Assign(FProjs);
  511. FBeginPhaseIndex := ABeginPhaseIndex;
  512. FEndPhaseIndex := AEndPhaseIndex;
  513. BeforeGather;
  514. try
  515. for i := 0 to FProjs.Count - 1 do
  516. GatherProj(TGatherProjInfo(FProjs.Items[i]), i);
  517. FTree.CalculateAll;
  518. if Assigned(FWriter) then
  519. FWriter(Self);
  520. finally
  521. AfterGather;
  522. end;
  523. end;
  524. procedure TZoneProjGather.OpenProjectData(AProj: TGatherProjInfo);
  525. function CreatePhaseData(APhaseIndex: Integer): TPhaseData;
  526. begin
  527. Result := TPhaseData.Create(ProjectData);
  528. Result.SimpleOpen2(Format('%sPhase%d.dat', [FProjectData.TempPath, APhaseIndex]));
  529. end;
  530. var
  531. iCurBegin, iCurEnd: Integer;
  532. begin
  533. inherited;
  534. iCurBegin := Min(FBeginPhaseIndex, FProjectData.ProjProperties.PhaseCount);
  535. iCurEnd := Min(FEndPhaseIndex, FProjectData.ProjProperties.PhaseCount);
  536. if iCurBegin = 0 then
  537. FBeginPhaseData := nil
  538. else if iCurBegin = FProjectData.PhaseIndex then
  539. FBeginPhaseData := FProjectData.PhaseData
  540. else
  541. FBeginPhaseData := CreatePhaseData(iCurBegin);
  542. if iCurEnd = 0 then
  543. FEndPhaseData := nil
  544. else if iCurEnd = FProjectData.PhaseIndex then
  545. FEndPhaseData := FProjectData.PhaseData
  546. else if iCurEnd = FBeginPhaseIndex then
  547. FEndPhaseData := FBeginPhaseData
  548. else
  549. FEndPhaseData := CreatePhaseData(iCurEnd);
  550. end;
  551. end.