| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639 | 
							- 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.
 
 
  |