123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328 |
- unit ProjGather;
- interface
- uses
- Classes, ProjGatherTree, GatherProjInfo, ProjectData, BillsTree, CalcData;
- type
- TProjGather = class;
- TWriteGatherData = procedure (AGather: TProjGather) of Object;
- TProjGather = class
- private
- FWriter: TWriteGatherData;
- FXmjCompare: Integer;
- FGclCompare: Integer;
- FTree: TProjGatherTree;
- FProjs: TList;
- FCommonProjs: TList;
- FSpecialProjs: TList;
- FSpecialProjTypes: TStrings;
- FProjectData: TProjectData;
- procedure OpenProjectData(AProj: TGatherProjInfo);
- procedure FreeProjectData;
- function FindBillsNode(ANode: TBillsIDTreeNode; AParent: TProjGatherTreeNode): TProjGatherTreeNode;
- function CreateBillsNode(ANode: TBillsIDTreeNode; AParent: TProjGatherTreeNode): TProjGatherTreeNode;
- procedure AddProjCalcData(AProjCalc: TProjCalc; ANode: TMeasureBillsIDTreeNode);
- function GatherBillsNode(ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode;
- AProjIndex: Integer): TProjGatherTreeNode;
- procedure GatherBills(ANode: TMeasureBillsIDTreeNode; AParent: TProjGatherTreeNode; AProjIndex: Integer);
- procedure GatherProj(AProj: TGatherProjInfo; AProjIndex: Integer);
- function GatherSpecialBillsNode(ANode: TMeasureBillsIDTreeNode;
- AParent: TProjGatherTreeNode; AProjType: Integer): TProjGatherTreeNode;
- procedure GatherSpecialBills(ANode: TMeasureBillsIDTreeNode;
- AParent: TProjGatherTreeNode; AProjType: Integer);
- procedure GatherSpecialProj(AProj: TGatherProjInfo);
- procedure FilterProjs;
- public
- constructor Create(AWriter: TWriteGatherData; AXmjCompare, AGclCompare: Integer);
- destructor Destroy; override;
- procedure Gather(AProjs: TList; ASpecialProjTypes: TStrings);
-
- property Tree: TProjGatherTree read FTree;
- property Projs: TList read FProjs;
- property CommonProj: TList read FCommonProjs;
- property SpecialProj: TList read FSpecialProjs;
- property SpecialProjTypes: TStrings read FSpecialProjTypes;
- end;
- implementation
- uses
- Globals, UtilMethods, sdIDTree, sdDB, mDataRecord, BillsMeasureDm;
- { TProjGather }
- procedure TProjGather.AddProjCalcData(AProjCalc: TProjCalc;
- ANode: TMeasureBillsIDTreeNode);
- var
- StageRec: TStageRecord;
- 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;
- 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;
- 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;
- if Assigned(ASpecialProjTypes) then
- FTree := TProjGatherTree.Create(FCommonProjs.Count, ASpecialProjTypes.Count)
- else
- FTree := TProjGatherTree.Create(FCommonProjs.Count, 0);
- FTree.NewNodeID := 101;
- 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
- FTree.Free;
- 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);
- 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);
- 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;
- end.
|