Measure/ProjGather/ProjGather.pas

unit ProjGather;

interface

uses
  Classes, ProjGatherTree, GatherProjInfo, ProjectData, BillsTree, CalcData,
  PhaseData;

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;

    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);

    function GatherSpecialBillsNode(ANode: TMeasureBillsIDTreeNode;
      AParent: TProjGatherTreeNode; AProjType: Integer): TProjGatherTreeNode;
    procedure GatherSpecialBills(ANode: TMeasureBillsIDTreeNode;
      AParent: TProjGatherTreeNode; AProjType: Integer);
    procedure GatherSpecialProj(AProj: TGatherProjInfo);

    procedure FilterProjs;
  protected
    procedure OpenProjectData(AProj: TGatherProjInfo); virtual;
    procedure FreeProjectData; virtual;

    procedure GatherProj(AProj: TGatherProjInfo; AProjIndex: Integer);

    procedure AddProjMeasureCalcData(AProjCalc: TProjCalc; ANode: TMeasureBillsIDTreeNode); 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 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;
  public
    procedure Gather(AProjs: TList; ABeginPhaseIndex, AEndPhaseIndex: Integer); overload;
  end;

implementation

uses
  Globals, UtilMethods, sdIDTree, sdDB, mDataRecord, BillsMeasureDm, SysUtils,
  Math;

{ 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;
  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;

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;

{ TZoneProjGather }

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;

  FTree := TProjGatherTree.Create(FProjs.Count, 0);
  FTree.NewNodeID := 101;
  try
    for i := 0 to FProjs.Count - 1 do
      GatherProj(TGatherProjInfo(FProjs.Items[i]), i);
    FTree.CalculateAll;
    if Assigned(FWriter) then
      FWriter(Self);
  finally
    FTree.Free;
  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.