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