unit ProjGather; interface uses Classes, ProjGatherTree, GatherProjInfo, ProjectData, BillsTree, CalcData, PhaseData, ProjGatherDealPay, sdDB, ProjGatherProperties; type TProjGather = class; TWriteGatherData = procedure (AGather: TProjGather) of Object; TProjGather = class private FWriter: TWriteGatherData; FXmjCompare: Integer; FGclCompare: Integer; FTree: TProjGatherTree; FDealPay: TProjGatherDealPayList; FProperties: TProjGatherProperties; FDealCurField: string; FDealPreField: string; FDealEndField: string; FProjs: TList; FCommonProjs: TList; FSpecialProjs: TList; FSpecialProjTypes: TStrings; FProjectData: TProjectData; function FindBillsNode(ANode: TBillsIDTreeNode; AParent: TProjGatherTreeNode): TProjGatherTreeNode; function CreateBillsNode(ANode: TBillsIDTreeNode; AParent: TProjGatherTreeNode): TProjGatherTreeNode; procedure AddProjCalcData(AProjCalc: TProjCalc; ANode: TMeasureBillsIDTreeNode); procedure AddProjDealPayCalcData(ADealPayCalc: TDealPayCalcData; ARec: TsdDataRecord); function GatherBillsNode(ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode; AProjIndex: Integer): TProjGatherTreeNode; procedure GatherBills(ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode; AProjIndex: Integer); procedure GatherDealPays(AProjIndex: Integer); procedure GatherProjProperties; function GatherSpecialBillsNode(ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode; AProjType: Integer): TProjGatherTreeNode; procedure GatherSpecialBills(ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode; AProjType: Integer); procedure GatherSpecialDealPays(AProjType: Integer); procedure GatherSpecialProj(AProj: TGatherProjInfo); procedure FilterProjs; protected procedure OpenProjectData(AProj: TGatherProjInfo); virtual; procedure FreeProjectData; virtual; procedure BeforeGather; procedure AfterGather; procedure GatherProj(AProj: TGatherProjInfo; AProjIndex: Integer); procedure AddProjMeasureCalcData(AProjCalc: TProjCalc; ANode: TMeasureBillsIDTreeNode); virtual; procedure AddProjDealPayPhaseCalcData(ADealPayCalc: TDealPayCalcData; ARec: TsdDataRecord); virtual; public constructor Create(AWriter: TWriteGatherData; AXmjCompare, AGclCompare: Integer); destructor Destroy; override; procedure Gather(AProjs: TList; ASpecialProjTypes: TStrings); property ProjectData: TProjectData read FProjectData; property Tree: TProjGatherTree read FTree; property DealPay: TProjGatherDealPayList read FDealPay; property Properties: TProjGatherProperties read FProperties; property Projs: TList read FProjs; property CommonProj: TList read FCommonProjs; property SpecialProj: TList read FSpecialProjs; property SpecialProjTypes: TStrings read FSpecialProjTypes; end; TZoneProjGather = class(TProjGather) private FBeginPhaseIndex: Integer; FEndPhaseIndex: Integer; FBeginPhaseData: TPhaseData; FEndPhaseData: TPhaseData; protected procedure OpenProjectData(AProj: TGatherProjInfo); override; procedure FreeProjectData; override; procedure AddProjMeasureCalcData(AProjCalc: TProjCalc; ANode: TMeasureBillsIDTreeNode); override; procedure AddProjDealPayPhaseCalcData(ADealPayCalc: TDealPayCalcData; ARec: TsdDataRecord); override; public procedure Gather(AProjs: TList; ABeginPhaseIndex, AEndPhaseIndex: Integer); overload; end; implementation uses Globals, UtilMethods, sdIDTree, mDataRecord, BillsMeasureDm, SysUtils, Math, DealPaymentDm; { TProjGather } procedure TProjGather.AddProjCalcData(AProjCalc: TProjCalc; ANode: TMeasureBillsIDTreeNode); begin AProjCalc.Compile.Org.AddQuantity(ANode.Rec.OrgQuantity.AsFloat); AProjCalc.Compile.Org.AddTotalPrice(ANode.Rec.OrgTotalPrice.AsFloat); AProjCalc.Compile.Mis.AddQuantity(ANode.Rec.MisQuantity.AsFloat); AProjCalc.Compile.Mis.AddTotalPrice(ANode.Rec.MisTotalPrice.AsFloat); AProjCalc.Compile.Oth.AddQuantity(ANode.Rec.OthQuantity.AsFloat); AProjCalc.Compile.Oth.AddTotalPrice(ANode.Rec.OthTotalPrice.AsFloat); AProjCalc.Compile.SubTotal.AddQuantity(ANode.Rec.Quantity.AsFloat); AProjCalc.Compile.SubTotal.AddTotalPrice(ANode.Rec.TotalPrice.AsFloat); AProjCalc.AddMeasure.Deal.AddQuantity(ANode.Rec.AddDealQuantity.AsFloat); AProjCalc.AddMeasure.Deal.AddTotalPrice(ANode.Rec.AddDealTotalPrice.AsFloat); AProjCalc.AddMeasure.Qc.AddQuantity(ANode.Rec.AddQcQuantity.AsFloat); AProjCalc.AddMeasure.Qc.AddTotalPrice(ANode.Rec.AddQcTotalPrice.AsFloat); AProjCalc.AddMeasure.Gather.AddQuantity(ANode.Rec.AddGatherQuantity.AsFloat); AProjCalc.AddMeasure.Gather.AddTotalPrice(ANode.Rec.AddGatherTotalPrice.AsFloat); AProjCalc.DgnQuantity1 := AProjCalc.DgnQuantity1 + ANode.Rec.DgnQuantity1.AsFloat; AProjCalc.DgnQuantity2 := AProjCalc.DgnQuantity2 + ANode.Rec.DgnQuantity2.AsFloat; AProjCalc.DealDgnQuantity1 := AProjCalc.DealDgnQuantity1 + ANode.Rec.DealDgnQuantity1.AsFloat; AProjCalc.DealDgnQuantity2 := AProjCalc.DealDgnQuantity2 + ANode.Rec.DealDgnQuantity2.AsFloat; AProjCalc.CDgnQuantity1 := AProjCalc.CDgnQuantity1 + ANode.Rec.CDgnQuantity1.AsFloat; AProjCalc.CDgnQuantity2 := AProjCalc.CDgnQuantity2 + ANode.Rec.CDgnQuantity2.AsFloat; AddProjMeasureCalcData(AProjCalc, ANode); end; constructor TProjGather.Create(AWriter: TWriteGatherData; AXmjCompare, AGclCompare: Integer); begin FWriter := AWriter; FXmjCompare := AXmjCompare; FGclCompare := AGclCompare; FCommonProjs := TList.Create; FSpecialProjs := TList.Create; end; function TProjGather.CreateBillsNode(ANode: TBillsIDTreeNode; AParent: TProjGatherTreeNode): TProjGatherTreeNode; function GetB_CodeChapter(const AB_Code: string): Integer; var iValue, iError: Integer; begin Result := -1; Val(AB_Code, iValue, iError); if iValue > 0 then Result := iValue div 100; end; var vNextSibling: TProjGatherTreeNode; begin vNextSibling := FTree.FindNextSibling(AParent, ANode.Rec.Code.AsString, ANode.Rec.B_Code.AsString); if ANode.ID < 100 then Result := FTree.AddNode(AParent, vNextSibling, ANode.ID) else Result := FTree.AddNode(AParent, vNextSibling); Result.Code := ANode.Rec.Code.AsString; Result.B_Code := ANode.Rec.B_Code.AsString; Result.Name := ANode.Rec.Name.AsString; Result.Units := ANode.Rec.Units.AsString; Result.Price := ANode.Rec.Price.AsFloat; Result.XiangCode := ANode.Rec.XiangCode.AsString; Result.MuCode := ANode.Rec.MuCode.AsString; Result.JieCode := ANode.Rec.JieCode.AsString; Result.XiMuCode := ANode.Rec.XimuCode.AsString; Result.IndexCode := ANode.Rec.IndexCode.AsString; Result.B_CodeChapter := GetB_CodeChapter(Result.B_Code); end; destructor TProjGather.Destroy; begin FCommonProjs.Free; FSpecialProjs.Free; inherited; end; procedure TProjGather.FilterProjs; var i: Integer; vProjInfo: TGatherProjInfo; begin FCommonProjs.Clear; FSpecialProjs.Clear; for i := 0 to FProjs.Count - 1 do begin vProjInfo := TGatherProjInfo(FProjs.Items[i]); if vProjInfo.ProjType = 0 then FCommonProjs.Add(vProjInfo) else FSpecialProjs.Add(vProjInfo); end; end; function TProjGather.FindBillsNode(ANode: TBillsIDTreeNode; AParent: TProjGatherTreeNode): TProjGatherTreeNode; var iCompareType: Integer; begin if ANode.ID > 100 then begin if ANode.Rec.B_Code.AsString <> '' then iCompareType := FGclCompare else iCompareType := FXmjCompare; case iCompareType of // 按编号 0: if (ANode.Rec.Code.AsString <> '') or (ANode.Rec.B_Code.asString <> '') then Result := FTree.FindNode(AParent, ANode.Rec.Code.AsString, ANode.Rec.B_Code.AsString, ANode.Rec.Price.AsFloat) else Result := FTree.FindNode(AParent, ANode.Rec.Name.AsString, ANode.Rec.Price.AsFloat); // 按名称 1: Result := FTree.FindNode(AParent, ANode.Rec.Name.AsString, ANode.Rec.Price.AsFloat); // 按编号+名称 2: Result := FTree.FindNode(AParent, ANode.Rec.Code.AsString, ANode.Rec.B_Code.AsString, ANode.Rec.Name.AsString, ANode.Rec.Price.AsFloat); end; end else Result := FTree.FindNode(ANode.ID); end; procedure TProjGather.FreeProjectData; begin if not Assigned(OpenProjectManager.FindProjectData(FProjectData.ProjectID)) then FProjectData.Free; end; procedure TProjGather.Gather(AProjs: TList; ASpecialProjTypes: TStrings); var i: Integer; begin FProjs := AProjs; FilterProjs; FSpecialProjTypes := ASpecialProjTypes; BeforeGather; try for i := 0 to FCommonProjs.Count - 1 do GatherProj(TGatherProjInfo(FCommonProjs.Items[i]), i); for i := 0 to FSpecialProjs.Count - 1 do GatherSpecialProj(TGatherProjInfo(FSpecialProjs.Items[i])); FTree.CalculateAll; if Assigned(FWriter) then FWriter(Self); finally AfterGather; end; end; procedure TProjGather.GatherBills(ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode; AProjIndex: Integer); var vCur: TProjGatherTreeNode; begin if not Assigned(ANode) then Exit; vCur := GatherBillsNode(ANode, AParent, AProjIndex); GatherBills(TMeasureBillsIDTreeNode(ANode.FirstChild), vCur, AProjIndex); GatherBills(TMeasureBillsIDTreeNode(ANode.NextSibling), AParent, AProjIndex ); end; function TProjGather.GatherBillsNode(ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode; AProjIndex: Integer): TProjGatherTreeNode; begin Result := FindBillsNode(ANode, AParent); if not Assigned(Result) then Result := CreateBillsNode(ANode, AParent); AddProjCalcData(Result.GatherCalc, ANode); AddProjCalcData(Result.Proj[AProjIndex], ANode); end; procedure TProjGather.GatherProj(AProj: TGatherProjInfo; AProjIndex: Integer); begin OpenProjectData(AProj); try with FProjectData.BillsMeasureData do GatherBills(TMeasureBillsIDTreeNode(BillsMeasureTree.FirstNode), nil, AProjIndex); GatherDealPays(AProjIndex); GatherProjProperties; finally FreeProjectData; end; end; procedure TProjGather.GatherSpecialProj(AProj: TGatherProjInfo); begin if (AProj.ProjType > 0) and (AProj.ProjType <= FSpecialProjTypes.Count) then begin OpenProjectData(AProj); try with FProjectData.BillsMeasureData do GatherSpecialBills(TMeasureBillsIDTreeNode(BillsMeasureTree.FirstNode), nil, AProj.ProjType); GatherSpecialDealPays(AProj.ProjType); finally FreeProjectData; end; end; end; procedure TProjGather.GatherSpecialBills(ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode; AProjType: Integer); var vCur: TProjGatherTreeNode; begin if not Assigned(ANode) then Exit; vCur := GatherSpecialBillsNode(ANode, AParent, AProjType); GatherSpecialBills(TMeasureBillsIDTreeNode(ANode.FirstChild), vCur, AProjType); GatherSpecialBills(TMeasureBillsIDTreeNode(ANode.NextSibling), AParent, AProjType ); end; procedure TProjGather.OpenProjectData(AProj: TGatherProjInfo); begin FProjectData := OpenProjectManager.FindProjectData(AProj.ProjectID); if not Assigned(FProjectData) then begin FProjectData := TProjectData.Create; FProjectData.OpenForReport3(GetMyProjectsFilePath + AProj.FileName); end; end; function TProjGather.GatherSpecialBillsNode( ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode; AProjType: Integer): TProjGatherTreeNode; begin Result := FindBillsNode(ANode, AParent); if not Assigned(Result) then Result := CreateBillsNode(ANode, AParent); AddProjCalcData(Result.SpecialProj[AProjType - 1], ANode); end; procedure TProjGather.AddProjMeasureCalcData(AProjCalc: TProjCalc; ANode: TMeasureBillsIDTreeNode); var StageRec: TStageRecord; begin StageRec := ANode.StageRec; if Assigned(StageRec) then begin AProjCalc.CurMeasure.Deal.AddQuantity(StageRec.DealQuantity.AsFloat); AProjCalc.CurMeasure.Deal.AddTotalPrice(StageRec.DealTotalPrice.AsFloat); AProjCalc.CurMeasure.Qc.AddQuantity(StageRec.QcQuantity.AsFloat); AProjCalc.CurMeasure.Qc.AddTotalPrice(StageRec.QcTotalPrice.AsFloat); AProjCalc.CurMeasure.Gather.AddQuantity(StageRec.GatherQuantity.AsFloat); AProjCalc.CurMeasure.Gather.AddTotalPrice(StageRec.GatherTotalPrice.AsFloat); AProjCalc.PreMeasure.Deal.AddQuantity(StageRec.PreDealQuantity.AsFloat); AProjCalc.PreMeasure.Deal.AddTotalPrice(StageRec.PreDealTotalPrice.AsFloat); AProjCalc.PreMeasure.Qc.AddQuantity(StageRec.PreQcQuantity.AsFloat); AProjCalc.PreMeasure.Qc.AddTotalPrice(StageRec.PreQcTotalPrice.AsFloat); AProjCalc.PreMeasure.Gather.AddQuantity(StageRec.PreGatherQuantity.AsFloat); AProjCalc.PreMeasure.Gather.AddTotalPrice(StageRec.PreGatherTotalPrice.AsFloat); AProjCalc.EndMeasure.Deal.AddQuantity(StageRec.EndDealQuantity.AsFloat); AProjCalc.EndMeasure.Deal.AddTotalPrice(StageRec.EndDealTotalPrice.AsFloat); AProjCalc.EndMeasure.Qc.AddQuantity(StageRec.EndQcQuantity.AsFloat); AProjCalc.EndMeasure.Qc.AddTotalPrice(StageRec.EndQcTotalPrice.AsFloat); AProjCalc.EndMeasure.Gather.AddQuantity(StageRec.EndGatherQuantity.AsFloat); AProjCalc.EndMeasure.Gather.AddTotalPrice(StageRec.EndGatherTotalPrice.AsFloat); end; end; procedure TProjGather.GatherDealPays(AProjIndex: Integer); var idxView: TsdIndex; iRec: Integer; vRec: TsdDataRecord; vDealPay: TProjGatherDealPayNode; begin with FProjectData.DealPaymentData do begin idxView := sddDealPayment.FindIndex('idxView'); if FProjectData.PhaseData.Active then begin FDealCurField := 'TotalPrice' + IntToStr(FProjectData.PhaseData.StageIndex); FDealPreField := 'PreTotalPrice' + IntToStr(FProjectData.PhaseData.StageIndex); FDealEndField := 'EndTotalPrice' + IntToStr(FProjectData.PhaseData.StageIndex); end; for iRec := 0 to idxView.RecordCount - 1 do begin vRec := idxView.Records[iRec]; vDealPay := FDealPay.GetDealPayNode(vRec); AddProjDealPayCalcData(vDealPay.GatherCalc, vRec); AddProjDealPayCalcData(vDealPay.Proj[AProjIndex], vRec); end; end; end; procedure TProjGather.GatherSpecialDealPays(AProjType: Integer); var idxView: TsdIndex; iRec: Integer; vRec: TsdDataRecord; vDealPay: TProjGatherDealPayNode; begin with FProjectData.DealPaymentData do begin idxView := sddDealPayment.FindIndex('idxView'); for iRec := 0 to idxView.RecordCount - 1 do begin vRec := idxView.Records[iRec]; vDealPay := FDealPay.GetDealPayNode(vRec); AddProjDealPayCalcData(vDealPay.SpecialProj[AProjType - 1], vRec); end; end; end; procedure TProjGather.AddProjDealPayCalcData(ADealPayCalc: TDealPayCalcData; ARec: TsdDataRecord); begin ADealPayCalc.AddTotalPrice := ADealPayCalc.AddTotalPrice + ARec.ValueByName('TotalPrice').AsFloat; AddProjDealPayPhaseCalcData(ADealPayCalc, ARec); end; procedure TProjGather.BeforeGather; var iSpecial: Integer; begin if Assigned(FSpecialProjTypes) then iSpecial := FSpecialProjTypes.Count else iSpecial := 0; FTree := TProjGatherTree.Create(FCommonProjs.Count, iSpecial); FTree.NewNodeID := 101; FDealPay := TProjGatherDealPayList.Create(FCommonProjs.Count, iSpecial); FProperties := TProjGatherProperties.Create; end; procedure TProjGather.AfterGather; begin FProperties.Free; FDealPay.Free; FTree.Free; end; procedure TProjGather.GatherProjProperties; procedure GatherFloatProjProperty(const AName: string); var fValue: Double; vProperty: TProjGatherProperty; begin vProperty := FProperties.GetProjGatherProperty(AName); fValue := FProjectData.ProjProperties.GetFloatPropertyDef(AName, 0); fValue := fValue + StrToFloatDef(vProperty.Value, 0); vProperty.Value := FloatToStr(fValue); end; begin GatherFloatProjProperty('ContractPrice'); GatherFloatProjProperty('MaterialSubsist'); GatherFloatProjProperty('StartedSubsist'); end; procedure TProjGather.AddProjDealPayPhaseCalcData( ADealPayCalc: TDealPayCalcData; ARec: TsdDataRecord); var vPhaseRec: TsdDataRecord; begin if FProjectData.PhaseData.Active then vPhaseRec := FProjectData.PhaseData.PhasePayData.PayRecord(ARec.ValueByName('ID').AsInteger) else vPhaseRec := nil; if Assigned(vPhaseRec) then begin ADealPayCalc.CurTotalPrice := ADealPayCalc.CurTotalPrice + vPhaseRec.ValueByName(FDealCurField).AsFloat; ADealPayCalc.PreTotalPrice := ADealPayCalc.PreTotalPrice + vPhaseRec.ValueByName(FDealPreField).AsFloat; ADealPayCalc.EndTotalPrice := ADealPayCalc.EndTotalPrice + vPhaseRec.ValueByName(FDealEndField).AsFloat; end; end; { TZoneProjGather } procedure TZoneProjGather.AddProjDealPayPhaseCalcData( ADealPayCalc: TDealPayCalcData; ARec: TsdDataRecord); var vPhaseRec: TsdDataRecord; begin if Assigned(FEndPhaseData) then vPhaseRec := FEndPhaseData.PhasePayData.PayRecord(ARec.ValueByName('ID').AsInteger) else vPhaseRec := nil; if Assigned(vPhaseRec) then begin ADealPayCalc.CurTotalPrice := ADealPayCalc.CurTotalPrice + vPhaseRec.ValueByName(FDealCurField).AsFloat; ADealPayCalc.PreTotalPrice := ADealPayCalc.PreTotalPrice + vPhaseRec.ValueByName(FDealPreField).AsFloat; ADealPayCalc.EndTotalPrice := ADealPayCalc.EndTotalPrice + vPhaseRec.ValueByName(FDealEndField).AsFloat; ADealPayCalc.ZoneTotalPrice := ADealPayCalc.ZoneTotalPrice + vPhaseRec.ValueByName(FDealEndField).AsFloat; end; if Assigned(FBeginPhaseData) then vPhaseRec := FBeginPhaseData.PhasePayData.PayRecord(ARec.ValueByName('ID').AsInteger) else vPhaseRec := nil; if Assigned(vPhaseRec) then begin ADealPayCalc.ZoneTotalPrice := ADealPayCalc.ZoneTotalPrice - vPhaseRec.ValueByName(FDealPreField).AsFloat; end; end; procedure TZoneProjGather.AddProjMeasureCalcData(AProjCalc: TProjCalc; ANode: TMeasureBillsIDTreeNode); var StageRec: TStageRecord; begin if Assigned(FEndPhaseData) then StageRec := FEndPhaseData.StageData.StageRecord(ANode.ID) else StageRec := nil; if Assigned(StageRec) then begin AProjCalc.CurMeasure.Deal.AddQuantity(StageRec.DealQuantity.AsFloat); AProjCalc.CurMeasure.Deal.AddTotalPrice(StageRec.DealTotalPrice.AsFloat); AProjCalc.CurMeasure.Qc.AddQuantity(StageRec.QcQuantity.AsFloat); AProjCalc.CurMeasure.Qc.AddTotalPrice(StageRec.QcTotalPrice.AsFloat); AProjCalc.CurMeasure.Gather.AddQuantity(StageRec.GatherQuantity.AsFloat); AProjCalc.CurMeasure.Gather.AddTotalPrice(StageRec.GatherTotalPrice.AsFloat); AProjCalc.PreMeasure.Deal.AddQuantity(StageRec.PreDealQuantity.AsFloat); AProjCalc.PreMeasure.Deal.AddTotalPrice(StageRec.PreDealTotalPrice.AsFloat); AProjCalc.PreMeasure.Qc.AddQuantity(StageRec.PreQcQuantity.AsFloat); AProjCalc.PreMeasure.Qc.AddTotalPrice(StageRec.PreQcTotalPrice.AsFloat); AProjCalc.PreMeasure.Gather.AddQuantity(StageRec.PreGatherQuantity.AsFloat); AProjCalc.PreMeasure.Gather.AddTotalPrice(StageRec.PreGatherTotalPrice.AsFloat); AProjCalc.EndMeasure.Deal.AddQuantity(StageRec.EndDealQuantity.AsFloat); AProjCalc.EndMeasure.Deal.AddTotalPrice(StageRec.EndDealTotalPrice.AsFloat); AProjCalc.EndMeasure.Qc.AddQuantity(StageRec.EndQcQuantity.AsFloat); AProjCalc.EndMeasure.Qc.AddTotalPrice(StageRec.EndQcTotalPrice.AsFloat); AProjCalc.EndMeasure.Gather.AddQuantity(StageRec.EndGatherQuantity.AsFloat); AProjCalc.EndMeasure.Gather.AddTotalPrice(StageRec.EndGatherTotalPrice.AsFloat); AProjCalc.ZoneMeasure.Deal.AddQuantity(StageRec.EndDealQuantity.AsFloat); AProjCalc.ZoneMeasure.Deal.AddTotalPrice(StageRec.EndDealTotalPrice.AsFloat); AProjCalc.ZoneMeasure.Qc.AddQuantity(StageRec.EndQcQuantity.AsFloat); AProjCalc.ZoneMeasure.Qc.AddTotalPrice(StageRec.EndQcTotalPrice.AsFloat); AProjCalc.ZoneMeasure.Gather.AddQuantity(StageRec.EndGatherQuantity.AsFloat); AProjCalc.ZoneMeasure.Gather.AddTotalPrice(StageRec.EndGatherTotalPrice.AsFloat); end; if Assigned(FBeginPhaseData) then StageRec := FBeginPhaseData.StageData.StageRecord(ANode.ID) else StageRec := nil; if Assigned(StageRec) then begin AProjCalc.ZoneMeasure.Deal.AddQuantity(-StageRec.PreDealQuantity.AsFloat); AProjCalc.ZoneMeasure.Deal.AddTotalPrice(-StageRec.PreDealTotalPrice.AsFloat); AProjCalc.ZoneMeasure.Qc.AddQuantity(-StageRec.PreQcQuantity.AsFloat); AProjCalc.ZoneMeasure.Qc.AddTotalPrice(-StageRec.PreQcTotalPrice.AsFloat); AProjCalc.ZoneMeasure.Gather.AddQuantity(-StageRec.PreGatherQuantity.AsFloat); AProjCalc.ZoneMeasure.Gather.AddTotalPrice(-StageRec.PreGatherTotalPrice.AsFloat); end; end; procedure TZoneProjGather.FreeProjectData; begin inherited; if Assigned(ProjectData) and (ProjectData.PhaseData <> FBeginPhaseData) and Assigned(FBeginPhaseData) then FBeginPhaseData.Free; if Assigned(ProjectData) and (ProjectData.PhaseData <> FEndPhaseData) and Assigned(FEndPhaseData) then FEndPhaseData.Free; end; procedure TZoneProjGather.Gather(AProjs: TList; ABeginPhaseIndex, AEndPhaseIndex: Integer); var i: Integer; begin FProjs := AProjs; FCommonProjs.Assign(FProjs); FBeginPhaseIndex := ABeginPhaseIndex; FEndPhaseIndex := AEndPhaseIndex; BeforeGather; try for i := 0 to FProjs.Count - 1 do GatherProj(TGatherProjInfo(FProjs.Items[i]), i); FTree.CalculateAll; if Assigned(FWriter) then FWriter(Self); finally AfterGather; end; end; procedure TZoneProjGather.OpenProjectData(AProj: TGatherProjInfo); function CreatePhaseData(APhaseIndex: Integer): TPhaseData; begin Result := TPhaseData.Create(ProjectData); Result.SimpleOpen2(Format('%sPhase%d.dat', [FProjectData.TempPath, APhaseIndex])); end; var iCurBegin, iCurEnd: Integer; begin inherited; iCurBegin := Min(FBeginPhaseIndex, FProjectData.ProjProperties.PhaseCount); iCurEnd := Min(FEndPhaseIndex, FProjectData.ProjProperties.PhaseCount); if iCurBegin = 0 then FBeginPhaseData := nil else if iCurBegin = FProjectData.PhaseIndex then FBeginPhaseData := FProjectData.PhaseData else FBeginPhaseData := CreatePhaseData(iCurBegin); if iCurEnd = 0 then FEndPhaseData := nil else if iCurEnd = FProjectData.PhaseIndex then FEndPhaseData := FProjectData.PhaseData else if iCurEnd = FBeginPhaseIndex then FEndPhaseData := FBeginPhaseData else FEndPhaseData := CreatePhaseData(iCurEnd); end; end.