Measure/ProjGather/ProjGatherTree.pas

unit ProjGatherTree;

interface

uses
  CacheTree, Classes, CalcData;

type
  TProjGatherTreeNode = class(TCacheNode)
  private
    FCode: string;
    FB_Code: string;
    FName: string;
    FUnits: string;
    FPrice: Double;

    FSerialNo: Integer;
    FXiangCode: string;
    FMuCode: string;
    FJieCode: string;
    FXiMuCode: string;
    FIndexCode: string;
    FB_CodeChapter: Integer;
    FChapterParentID: Integer;

    FMemoStrs: TStringList;

    FGatherCalc: TProjCalc;
    FProjs: TList;
    FSpecialProjs: TList;
    function GetProjCount: Integer;
    function GetProj(AIndex: Integer): TProjCalc;
    function GetChapterParentID: Integer;
    function GetLevel: Integer;
    function GetSpecialProj(AIndex: Integer): TProjCalc;
    function GetSpecialProjCount: Integer;
    function GetMemoStr: string;
  public
    constructor Create(ACacheTree: TCacheTree; AID: Integer; AProjCount, ASpeicalProjCount: Integer);
    destructor Destroy; override;

    procedure InitTotalPrice_Rc;
    procedure UpdateTotalPrice_Rc(ANode: TProjGatherTreeNode);
    procedure CalcTotalPrice_Rc;

    procedure InitCalcData;
    procedure AddCalcData(ANode: TProjGatherTreeNode);
    procedure MinusCalcData(ANode: TProjGatherTreeNode);

    procedure AddMemoStr(const AMemoStr: string);

    property Code: string read FCode write FCode;
    property B_Code: string read FB_Code write FB_Code;
    property Name: string read FName write FName;
    property Units: string read FUnits write FUnits;
    property Price: Double read FPrice write FPrice;

    property SerialNo: Integer read FSerialNo write FSerialNo;

    property XiangCode: string read FXiangCode write FXiangCode;
    property MuCode: string read FMuCode write FMuCode;
    property JieCode: string read FJieCode write FJieCode;
    property XiMuCode: string read FXiMuCode write FXiMuCode;

    property IndexCode: string read FIndexCode write FIndexCode;
    property B_CodeChapter: Integer read FB_CodeChapter write FB_CodeChapter;

    property MemoStr: string read GetMemoStr;

    property Level: Integer read GetLevel;
    property ChapterParentID: Integer read GetChapterParentID;

    property GatherCalc: TProjCalc read FGatherCalc;

    property ProjCount: Integer read GetProjCount;
    property Proj[AIndex: Integer]: TProjCalc read GetProj;

    property SpecialProjCount: Integer read GetSpecialProjCount;
    property SpecialProj[AIndex: Integer]: TProjCalc read GetSpecialProj;
  end;

  TProjGatherTree = class(TCacheTree)
  private
    FProjCount: Integer;
    FSpecialProjCount: Integer;
    FFixedIDNodes: TList;
    FGatherNode: TProjGatherTreeNode;

    FSerialNo: Integer;
    function GetNewNode(AFixedID: Integer = -1): TProjGatherTreeNode;

    procedure Calculate(ANode: TProjGatherTreeNode);
    procedure CalcGatherNode;
  public
    constructor Create(AProjCount, ASpecialProjCount: Integer);
    destructor Destroy; override;

    function AddNode(AParent, ANextSibling: TProjGatherTreeNode; AFixedID: Integer = -1): TProjGatherTreeNode;

    function FindNode(AParent: TProjGatherTreeNode; const ACode, AB_Code, AName: string; APrice: Double): TProjGatherTreeNode; overload;
    function FindNode(AParent: TProjGatherTreeNode; const ACode, AB_Code: string; APrice: Double): TProjGatherTreeNode; overload;
    function FindNode(AParent: TProjGatherTreeNode; const AName: string; APrice: Double): TProjGatherTreeNode; overload;

    function FindNode(AFixedID: Integer): TProjGatherTreeNode; overload;

    function FindNextSibling(AParent: TProjGatherTreeNode; const ACode, AB_Code: string): TProjGatherTreeNode;

    procedure CalculateAll;

    procedure SaveDebugFile(const AFileName: string);

    property GatherNode: TProjGatherTreeNode read FGatherNode;
    property ProjCount: Integer read FProjCount;
    property SpecialProjCount: Integer read FSpecialProjCount;
  end;

implementation

uses
  ZhAPI, SysUtils, ConditionalDefines;

{ TProjGatherTreeNode }

procedure TProjGatherTreeNode.AddCalcData(ANode: TProjGatherTreeNode);
var
  iProj: Integer;
begin
  GatherCalc.AddCalcData(ANode.GatherCalc);
  for iProj := 0 to ProjCount - 1 do
    Proj[iProj].AddCalcData(ANode.Proj[iProj]);
end;

procedure TProjGatherTreeNode.AddMemoStr(const AMemoStr: string);
begin
  if AMemoStr <> '' then
  begin
    if FMemoStrs.IndexOf(AMemoStr) = -1 then
      FMemoStrs.Add(AMemoStr);
  end;
end;

procedure TProjGatherTreeNode.CalcTotalPrice_Rc;
var
  iProj: Integer;
begin
  GatherCalc.CalcTotalPrice_Rc(Price);
  for iProj := 0 to ProjCount - 1 do
    Proj[iProj].CalcTotalPrice_Rc(Price);
end;

constructor TProjGatherTreeNode.Create(ACacheTree: TCacheTree; AID: Integer; AProjCount, ASpeicalProjCount: Integer);
var
  i: Integer;
  ProjCalc: TProjCalc;
begin
  inherited Create(ACacheTree, AID);
  FGatherCalc := TProjCalc.Create;
  FMemoStrs := TStringList.Create;
  FMemoStrs.Delimiter := ';';
  FProjs := TList.Create;
  for i := 0 to AProjCount - 1 do
  begin
    ProjCalc := TProjCalc.Create;
    FProjs.Add(ProjCalc);
  end;
  FSpecialProjs := TList.Create;
  for i := 0 to ASpeicalProjCount - 1 do
  begin
    ProjCalc := TProjCalc.Create;
    FSpecialProjs.Add(ProjCalc);
  end;
end;

destructor TProjGatherTreeNode.Destroy;
begin
  FGatherCalc.free;
  FMemoStrs.Clear;
  ClearObjects(FProjs);
  FProjs.Free;
  ClearObjects(FSpecialProjs);
  FSpecialProjs.Free;
  inherited;
end;

function TProjGatherTreeNode.GetChapterParentID: Integer;
var
  vNode: TProjGatherTreeNode;
begin
  Result := -1;
  if Self.Level > 2 then
  begin
    vNode := TProjGatherTreeNode(Self.Parent);
    while vNode.Level > 2 do
      vNode := TProjGatherTreeNode(vNode.Parent);
    Result := vNode.ID
  end;
end;

function TProjGatherTreeNode.GetLevel: Integer;
begin
  if Assigned(Parent) and (Parent.ID <> -1) then
    Result := TProjGatherTreeNode(Parent).Level + 1
  else
    Result := 1;
end;

function TProjGatherTreeNode.GetMemoStr: string;
begin
  Result := FMemoStrs.DelimitedText;
end;

function TProjGatherTreeNode.GetProj(AIndex: Integer): TProjCalc;
begin
  Result := TProjCalc(FProjs.Items[AIndex]);
end;

function TProjGatherTreeNode.GetProjCount: Integer;
begin
  Result := FProjs.Count;
end;

function TProjGatherTreeNode.GetSpecialProj(AIndex: Integer): TProjCalc;
begin
  Result := TProjCalc(FSpecialProjs.Items[AIndex]);
end;

function TProjGatherTreeNode.GetSpecialProjCount: Integer;
begin
  Result := FSpecialProjs.Count;
end;

procedure TProjGatherTreeNode.InitCalcData;
var
  iProj: Integer;
begin
  GatherCalc.InitCalcData;
  for iProj := 0 to ProjCount - 1 do
    Proj[iProj].InitCalcData;
end;

procedure TProjGatherTreeNode.InitTotalPrice_Rc;
var
  iProj: Integer;
begin
  GatherCalc.InitTotalPrice_Rc;
  for iProj := 0 to ProjCount - 1 do
    Proj[iProj].InitTotalPrice_Rc;
end;

procedure TProjGatherTreeNode.MinusCalcData(ANode: TProjGatherTreeNode);
var
  iProj: Integer;
begin
  GatherCalc.MinusCalcData(ANode.GatherCalc);
  for iProj := 0 to ProjCount - 1 do
    Proj[iProj].MinusCalcData(ANode.Proj[iProj]);
end;

procedure TProjGatherTreeNode.UpdateTotalPrice_Rc(ANode: TProjGatherTreeNode);
var
  iProj: Integer;
begin
  GatherCalc.UpdateTotalPrice_Rc(ANode.GatherCalc);
  for iProj := 0 to ANode.ProjCount - 1 do
    Proj[iProj].UpdateTotalPrice_Rc(ANode.Proj[iProj]);
end;

{ TProjGatherTree }

procedure TProjGatherTree.Calculate(ANode: TProjGatherTreeNode);
var
  iChild: Integer;
  vChild: TProjGatherTreeNode;
begin
  ANode.SerialNo := FSerialNo;
  Inc(FSerialNo);

  ANode.InitTotalPrice_Rc;
  if ANode.Children.Count > 0 then
  begin
    for iChild := 0 to ANode.Children.Count - 1 do
    begin
      vChild := TProjGatherTreeNode(ANode.Children.Items[iChild]);
      Calculate(vChild);
      ANode.UpdateTotalPrice_Rc(vChild);
    end;
  end
  else
    ANode.CalcTotalPrice_Rc;
end;

procedure TProjGatherTree.CalculateAll;
var
  vNode: TProjGatherTreeNode;
begin
  FSerialNo := 1;
  vNode :=  TProjGatherTreeNode(FirstNode);
  while Assigned(vNode) do
  begin
    Calculate(vNode);
    vNode := TProjGatherTreeNode(vNode.NextSibling);
  end;
  CalcGatherNode;
end;

constructor TProjGatherTree.Create(AProjCount, ASpecialProjCount: Integer);
begin
  inherited Create;
  FProjCount := AProjCount;
  FSpecialProjCount := ASpecialProjCount;
  FFixedIDNodes := TList.Create;
  FGatherNode := TProjGatherTreeNode.Create(nil, -2, AProjCount, ASpecialProjCount);
end;

destructor TProjGatherTree.Destroy;
begin
  FGatherNode.Free;
  FFixedIDNodes.Free;
  inherited;
end;

function TProjGatherTree.FindNode(AParent: TProjGatherTreeNode;
  const ACode, AB_Code, AName: string;
  APrice: Double): TProjGatherTreeNode;
var
  iChild: Integer;
  vChild: TProjGatherTreeNode;
begin
  Result := nil;
  for iChild := 0 to AParent.Children.Count - 1 do
  begin
    vChild := TProjGatherTreeNode(AParent.Children.Items[iChild]);
    if (vChild.Code = ACode) and (vChild.B_Code = AB_Code) and
       (vChild.Name = AName) and (abs(vChild.Price - APrice) < 0.00001) then
    begin
      Result := vChild;
      Break;
    end;
  end;
end;

function TProjGatherTree.FindNode(AParent: TProjGatherTreeNode;
  const ACode, AB_Code: string; APrice: Double): TProjGatherTreeNode;
var
  iChild: Integer;
  vChild: TProjGatherTreeNode;
begin
  Result := nil;
  for iChild := 0 to AParent.Children.Count - 1 do
  begin
    vChild := TProjGatherTreeNode(AParent.Children.Items[iChild]);
    if (vChild.Code = ACode) and (vChild.B_Code = AB_Code) and
       (abs(vChild.Price - APrice) < 0.00001) then
    begin
      Result := vChild;
      Break;
    end;
  end;
end;

function TProjGatherTree.FindNode(AParent: TProjGatherTreeNode;
  const AName: string; APrice: Double): TProjGatherTreeNode;
var
  iChild: Integer;
  vChild: TProjGatherTreeNode;
begin
  Result := nil;
  for iChild := 0 to AParent.Children.Count - 1 do
  begin
    vChild := TProjGatherTreeNode(AParent.Children.Items[iChild]);
    if (vChild.Name = AName) and (abs(vChild.Price - APrice) < 0.00001) then
    begin
      Result := vChild;
      Break;
    end;
  end;
end;

function TProjGatherTree.FindNextSibling(AParent: TProjGatherTreeNode;
  const ACode, AB_Code: string): TProjGatherTreeNode;
var
  vNext: TProjGatherTreeNode;
  sCodeID, sCodeID2, sB_CodeID, sB_CodeID2: string;
begin
  Result := nil;
  if Assigned(AParent) then
    vNext := TProjGatherTreeNode(AParent.FirstChild)
  else
    vNext := TProjGatherTreeNode(Root.FirstChild);
  if (ACode = '') and (AB_Code = '') then Exit;

  sCodeID := ConvertDigitCode(ACode, 3, '-');
  sB_CodeID := ConvertDigitCode(AB_Code, 4, '-');
  while Assigned(vNext) do
  begin
    sCodeID2 := ConvertDigitCode(vNext.Code, 3, '-');
    sB_CodeID2 := ConvertDigitCode(vNext.B_Code, 4, '-');
    if sCodeID < sCodeID2 then
    begin
      Result := vNext;
      Break;
    end
    else if sB_CodeID < sB_CodeID2 then
    begin
      Result := vNext;
      Break;
    end;
    vNext := TProjGatherTreeNode(vNext.NextSibling);
  end;
end;

function TProjGatherTree.FindNode(AFixedID: Integer): TProjGatherTreeNode;
var
  i: Integer;
  vNode: TProjGatherTreeNode;
begin
  Result := nil;
  for i := 0 to FFixedIDNodes.Count - 1 do
  begin
    vNode := TProjGatherTreeNode(FFixedIDNodes.Items[i]);
    if vNode.ID = AFixedID then
    begin
      Result := vNode;
      Break;
    end;
  end;
end;

function TProjGatherTree.GetNewNode(AFixedID: Integer): TProjGatherTreeNode;
begin
  if AFixedID <> -1 then
  begin
    Result := TProjGatherTreeNode.Create(Self, AFixedID, FProjCount, FSpecialProjCount);
    FFixedIDNodes.Add(Result);
  end
  else
    Result := TProjGatherTreeNode.Create(Self, GetNewNodeID, FProjCount, FSpecialProjCount);
  CacheNodes.Add(Result);
end;

function TProjGatherTree.AddNode(AParent, ANextSibling: TProjGatherTreeNode;
  AFixedID: Integer): TProjGatherTreeNode;
begin
  Result := GetNewNode(AFixedID);
  if Assigned(ANextSibling) then
    ANextSibling.InsertPreSibling(Result)
  else if Assigned(AParent) then
    AParent.InsertChild(Result)
  else
    Root.InsertChild(Result);
end;

procedure TProjGatherTree.SaveDebugFile(const AFileName: string);
var
  sgs: TStringList;
  i: Integer;
  vNode: TProjGatherTreeNode;
begin
  sgs := TStringList.Create;
  try
    for i := 0 to CacheNodes.Count - 1 do
    begin
      vNode := TProjGatherTreeNode(CacheNodes.Items[i]);
      sgs.Add(Format('ID: %d; Code: %s; B_Code: %s; Name: %s', [vNode.ID, vNode.Code, vNode.B_Code, vNode.Name]));
    end;
    sgs.SaveToFile(AFileName);
  finally
    sgs.Free;
  end;
end;

procedure TProjGatherTree.CalcGatherNode;

 procedure AddGatherCalc(AID: Integer);
 var
   vNode: TProjGatherTreeNode;
 begin
    vNode := FindNode(AID);
    if Assigned(vNode) then
      GatherNode.AddCalcData(vNode);
 end;

 procedure MinusGatherCalc(AID: Integer);
 var
   vNode: TProjGatherTreeNode;
 begin
    vNode := FindNode(AID);         
    if Assigned(vNode) then
      GatherNode.MinusCalcData(vNode);
 end;

begin
  GatherNode.InitCalcData;
  // 全国
  // 第一部分（1）+第二部分（2）+第三部分（3）+预备费（7）+新增加费用项目(其他费用_广东)（15）-回收金额（16）
  AddGatherCalc(1);
  AddGatherCalc(2);
  AddGatherCalc(3);
  AddGatherCalc(7);
  AddGatherCalc(15);
  MinusGatherCalc(16);
  // 广东
  // 全国的基础上+建设期贷款利息（34）+公路功能以外的项目（9）
  if _IsGuangDong then
  begin
    AddGatherCalc(34);
    AddGatherCalc(9);
  end;
end;

end.