Measure/Units/MCacheTree.pas

unit MCacheTree;
// CacheTree For Measure, Inherit From CacheTree

interface

uses
  Classes, CacheTree, Math, ZhAPI, sdIDTree;

type
  // For Import Temp Excel
  TBillsCacheNode = class(TCacheNode)
  private
    FLevelCode: string;
    FCode: string;
    FB_Code: string;
    FName: string;
    FUnits: string;
    FCanDelete: Boolean;
    FQuantity: Double;
    FDgnQuantity1: Double;
    FDgnQuantity2: Double;
    FMemoStr: string;
    FPrice: Double;
    FDrawingCode: string;
  public
    property LevelCode: string read FLevelCode write FLevelCode;
    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 CanDelete: Boolean read FCanDelete write FCanDelete;
    property Price: Double read FPrice write FPrice;
    property Quantity: Double read FQuantity write FQuantity;
    property DgnQuantity1: Double read FDgnQuantity1 write FDgnQuantity1;
    property DgnQuantity2: Double read FDgnQuantity2 write FDgnQuantity2;
    property DrawingCode: string read FDrawingCode write FDrawingCode;
    property MemoStr: string read FMemoStr write FMemoStr;
  end;

  TBillsCacheTree = class(TCacheTree)
  private
    FLastNode: TCacheNode;
    FSeparateChar: Char;
    FAutoSort: Boolean;
    function GetNewNode(AID: Integer = -1): TBillsCacheNode; overload;

    function FindNode(const ACode: string): TBillsCacheNode; overload;
    function FindNode(AParent: TBillsCacheNode; const ACode: string): TBillsCacheNode; overload;
    function FindParent(const ACode: string): TBillsCacheNode;
    function FindNextSibling(const ACode: string): TBillsCacheNode;

    procedure SetSeparateChar(const Value: Char);
  public
    function AddNode(AParent: TCacheNode; ANextSibling: TCacheNode = nil; AFixedID: Integer = -1): TBillsCacheNode;
    function AddNodeByCode(const ACode: string; AFixedID: Integer = -1): TBillsCacheNode;
    function AddLeafBillsNode(const AB_Code: string): TBillsCacheNode;

    function FindXmjChild(AParent: TBillsCacheNode; const ACode, AName: string): TBillsCacheNode;
    function FindGclChild(AParent: TBillsCacheNode; const AB_Code, AName, AUnits: string; APrice: Double): TBillsCacheNode;

    // Only for Debugging lot of Data
    procedure SaveTreeToFile(const AFileName: string);

    property SeparateChar: Char read FSeparateChar write SetSeparateChar;
    property AutoSort: Boolean read FAutoSort write FAutoSort;
  end;

  // 此树仅用于导入工程量清单，禁止作为它用
  // 如须使用应遵守以下两点：1.完全清楚相关的导入方法类及需求 2.派生子类。
  TGclCacheNode = class(TCacheNode)
  private
    FB_Code: string;
    FName: string;
    FUnits: string;
    FPrice: Double;
    FQuantity: Double;
  public
    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 Quantity: Double read FQuantity write FQuantity;
  end;

  TGclCacheTree = class(TCacheTree)
  private
    FLastBlank1: TGclCacheNode;
    FLastNode: TGclCacheNode;

    function AddNodeByName(const AName: string): TGclCacheNode;
    function AddNodeByB_Code(const AB_Code: string): TGclCacheNode;
  protected
    function GetNewNode: TCacheNode; override;
  public
    function AddNodeByData(const AB_Code, AName: string): TGclCacheNode;

    procedure SaveTreeToFile(const AFileName: string);
  end;

  {For Report Memory(Gather or Compare Projects)}
  TDoubleArray = array of Double;

  TReportCacheNode = class(TCacheNode)
  private
    FCode: string;
    FB_Code: string;
    FName: string;
    FUnits: string;
    FMemoStr: string;

    FXiangCode: string;
    FMuCode: string;
    FJieCode: string;
    FXiMuCode: string;

    FPrice: Double;
    FQuantity: Double;
    FTotalPrice: Double;
    FRatioPercent: Double; // 0号台账 - 各项费用所占比例
    FDesignQuantity1: Double;
    FDesignQuantity2: Double;

    FAddQcQuantity: Double;
    FAddPcTotalPrice: Double;
    FAddQcTotalPrice: Double;
    FAddDealQuantity: Double;
    FAddDealTotalPrice: Double;
    FAddPcQuantity: Double;
    FAddRatioPercent: Double; // 决算 - 各项费用所占比例

    FDealDesignQuantity1: Double;
    FDealDesignQuantity2: Double;
    FCDesignQuantity1: Double;
    FCDesignQuantity2: Double;

    FPDQuantity: Double;
    FPDTotalPrice: Double;
    FPDDesignQuantity1: Double;
    FPDDesignQuantity2: Double;
    FPDDesignPrice: Double;

    FCDDQuantity: Double;
    FCDDTotalPrice: Double;
    FCDDDesignQuantity1: Double;
    FCDDDesignQuantity2: Double;
    FCDDDesignPrice: Double;

    FABTotalPrice: Double;
    FABQuantity: Double;
    FABDesignQuantity1: Double;
    FABDesignQuantity2: Double;
    FABDesignPrice: Double;

    FProjectCount: Integer;
    FP_TotalPrice: TDoubleArray;
    FP_Quantity: TDoubleArray;
    FP_Price: TDoubleArray;
    FP_DgnQuantity1: TDoubleArray;
    FP_DgnQuantity2: TDoubleArray;

    procedure ResolveCode;
    function GetDoubleArrayTotal(ADoubleArray: TDoubleArray): Double;

    procedure SetCode(const Value: string);
    function GetGatherP_TotalPrice: Double;
    function GetAddGatherQuantity: Double;
    function GetAddGatherTotalPrice: Double;
  public
    constructor Create(ACacheTree: TCacheTree; AID, AProjectCount: Integer);

    property Code: string read FCode write SetCode;
    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 MemoStr: string read FMemoStr write FMemoStr;

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

    // 用于汇总多个项目的合同、变更（数量、金额）
    property Price: Double read FPrice write FPrice;
    // 0号台账合同
    property Quantity: Double read FQuantity write FQuantity;
    property TotalPrice: Double read FTotalPrice write FTotalPrice;
    property RatioPercent: Double read FRatioPercent write FRatioPercent;
    property DesignQuantity1: Double read FDesignQuantity1 write FDesignQuantity1;
    property DesignQuantity2: Double read FDesignQuantity2 write FDesignQuantity2;
    // 累计各值
    property AddDealQuantity: Double read FAddDealQuantity write FAddDealQuantity;
    property AddDealTotalPrice: Double read FAddDealTotalPrice write FAddDealTotalPrice;
    property AddQcQuantity: Double read FAddQcQuantity write FAddQcQuantity;
    property AddQcTotalPrice: Double read FAddQcTotalPrice write FAddQcTotalPrice;
    property AddPcQuantity: Double read FAddPcQuantity write FAddPcQuantity;
    property AddPcTotalPrice: Double read FAddPcTotalPrice write FAddPcTotalPrice;
    property AddGatherQuantity: Double read GetAddGatherQuantity;
    property AddGatherTotalPrice: Double read GetAddGatherTotalPrice;
    property AddRatioPercent: Double read FAddRatioPercent write FAddRatioPercent;
    // 合同&变更 设计数量
    property DealDesignQuantity1: Double read FDealDesignQuantity1 write FDealDesignQuantity1;
    property DealDesignQuantity2: Double read FDealDesignQuantity2 write FDealDesignQuantity2;
    property CDesignQuantity1: Double read FCDesignQuantity1 write FCDesignQuantity1;
    property CDesignQuantity2: Double read FCDesignQuantity2 write FCDesignQuantity2;

    // ----仅用于汇总生成决算02表----
    // 初步设计 Preliminary Design
    property PDQuantity: Double read FPDQuantity write FPDQuantity;
    property PDTotalPrice: Double read FPDTotalPrice write FPDTotalPrice;
    property PDDesignQuantity1: Double read FPDDesignQuantity1 write FPDDesignQuantity1;
    property PDDesignQuantity2: Double read FPDDesignQuantity2 write FPDDesignQuantity2;
    property PDDesignPrice: Double read FPDDesignPrice write FPDDesignPrice;
    // 施工图设计 Construction Drawing Design
    property CDDQuantity: Double read FCDDQuantity write FCDDQuantity;
    property CDDTotalPrice: Double read FCDDTotalPrice write FCDDTotalPrice;
    property CDDDesignQuantity1: Double read FCDDDesignQuantity1 write FCDDDesignQuantity1;
    property CDDDesignQuantity2: Double read FCDDDesignQuantity2 write FCDDDesignQuantity2;
    property CDDDesignPrice: Double read FCDDDesignPrice write FCDDDesignPrice;
    // ------------------------------
    // ----仅用于汇总生成决算02表(部颁)----
    // 批准概(预算)算 Approved Budget
    property ABQuantity: Double read FABQuantity write FABQuantity;
    property ABTotalPrice: Double read FABTotalPrice write FABTotalPrice;
    property ABDesignQuantity1: Double read FABDesignQuantity1 write FABDesignQuantity1;
    property ABDesignQuantity2: Double read FABDesignQuantity2 write FABDesignQuantity2;
    property ABDesignPrice: Double read FABDesignPrice write FABDesignPrice;
    // ------------------------------------

    // 用于记录多个项目的数量、单价、金额、设计数量
    property P_Price: TDoubleArray read FP_Price write FP_Price;
    property P_Quantity: TDoubleArray read FP_Quantity write FP_Quantity;
    property P_TotalPrice: TDoubleArray read FP_TotalPrice write FP_TotalPrice;
    property P_DgnQuantity1: TDoubleArray read FP_DgnQuantity1 write FP_DgnQuantity1;
    property P_DgnQuantity2: TDoubleArray read FP_DgnQuantity2 write FP_DgnQuantity2;

    property GatherP_TotalPrice: Double read GetGatherP_TotalPrice;

    property ProjectCount: Integer read FProjectCount;
  end;

  TStringArray = array of string;

  TReportCacheTree = class(TCacheTree)
  private
    FProjectCount: Integer;
    FGatherCacheNode: TReportCacheNode;
    FProjectName: TStringArray;

    function GetNewNode(AProjectCount: Integer): TReportCacheNode; overload;
  public
    constructor Create(AProjectCount: Integer);
    destructor Destroy; override;

    function AddNode(AParent: TCacheNode; ANextSibling: TCacheNode = nil): TReportCacheNode;

    function FindNextSibling(AParent: TCacheNode; ACode, AB_Code: string): TReportCacheNode;
    function FindNode(AParent: TCacheNode; ACode, AB_Code: string): TReportCacheNode; overload;
    function FindNode(AParent: TCacheNode; AName: string): TReportCacheNode; overload;
    function FindNode(AParent: TCacheNode; ACode, AB_Code, AName: string): TReportCacheNode; overload;

    procedure ReCalcGatherData;
    // 调用此方法先须先调用ReCalcGatherData
    // RatioPercent = 金额/总金额，这里的总金额取GatherCacheNode的金额，故须先汇总计算GatherCacheNode。
    procedure ReCalcRatioPercent;

    // Only for Debugging lot of Data
    procedure SaveTreeToFile(const AFileName: string);

    property ProjectCount: Integer read FProjectCount;
    property GatherCacheNode: TReportCacheNode read FGatherCacheNode;
    property ProjectName: TStringArray read FProjectName write FProjectName;
  end;

  TapDoubleArray = array [1..50] of Double;

  TAllPhaseCacheNode = class(TCacheNode)
  private
    FCode: string;
    FB_Code: string;
    FName: string;
    FUnits: string;
    FPrice: Double;
    FQuantity: Double;
    FTotalPrice: Double;
    FMemoStr: string;
  public
    FP_Quantity: TapDoubleArray;
    FP_TotalPrice: TapDoubleArray;

    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 Quantity: Double read FQuantity write FQuantity;
    property TotalPrice: Double read FTotalPrice write FTotalPrice;
    property MemoStr: string read FMemoStr write FMemoStr;
  end;

  // 仅用于汇总同一项目的不同期数据
  TAllPhaseCacheTree = class(TCacheTree)
  private
    function GetNewNode(AID: Integer): TAllPhaseCacheNode;
  public
    function AddNode(AID: Integer; AParent: TCacheNode; ANextSibling: TCacheNode = nil): TAllPhaseCacheNode;
    function FindNode(AID: Integer): TAllPhaseCacheNode;

    // Only for Debugging lot of Data
    procedure SaveTreeToFile(const AFileName: string);
  end;

implementation

uses
  SysUtils, UtilMethods;

{ TBillsCacheTree }
function TBillsCacheTree.AddNodeByCode(const ACode: string;
  AFixedID: Integer): TBillsCacheNode;
var
  Parent, NextSibling: TBillsCacheNode;
begin
  Result := FindNode(ACode);
  FLastNode := Result;
  if Assigned(Result) then Exit;

  Parent := FindParent(ACode);
  if AutoSort then
    NextSibling := FindNextSibling(ACode)
  else
    NextSibling := nil;
  Result := AddNode(Parent, NextSibling, AFixedID);
  Result.FLevelCode := ACode;
  FLastNode := Result;
end;

function TBillsCacheTree.FindNode(const ACode: string): TBillsCacheNode;
begin
  Result := FindNode(TBillsCacheNode(Root), ACode);
end;

function TBillsCacheTree.FindNextSibling(
  const ACode: string): TBillsCacheNode;
var
  Parent, Node: TBillsCacheNode;
  sCodeID, sCodeID2: string;
begin
  Parent := FindParent(ACode);
  if Assigned(Parent) then
    Node := TBillsCacheNode(Parent.FirstChild)
  else
    Node := TBillsCacheNode(Root.FirstChild);
  Result := nil;
  sCodeID := ConvertDigitCode(ACode, 3, '-');
  while Assigned(Node) do
  begin
    sCodeID2 := ConvertDigitCode(Node.LevelCode, 3, SeparateChar);
    if sCodeID < sCodeID2 then
    begin
      Result := Node;
      Break;
    end;
    Node := TBillsCacheNode(Node.NextSibling);
  end;
end;

function TBillsCacheTree.FindNode(AParent: TBillsCacheNode;
  const ACode: string): TBillsCacheNode;
begin
  Result := TBillsCacheNode(AParent.FirstChild);
  while Assigned(Result) do
  begin
    if Result.LevelCode = ACode then
      Break
    else if Pos(Result.LevelCode + SeparateChar, ACode) = 1 then
    begin
      Result := FindNode(Result, ACode);
      Break;
    end
    else
      Result := TBillsCacheNode(Result.NextSibling);
  end;
end;

function TBillsCacheTree.FindParent(const ACode: string): TBillsCacheNode;
var
  sCode: string;
begin
  Result := nil;
  sCode := GetPrefixOfCode(ACode, SeparateChar);
  while (Result = nil) and (sCode <> '') do
  begin
    Result := FindNode(sCode);
    sCode := GetPrefixOfCode(sCode, SeparateChar);
  end;
end;

function TBillsCacheTree.GetNewNode(AID: Integer): TBillsCacheNode;
begin
  if AID = -1 then
    Result := TBillsCacheNode.Create(Self, GetNewNodeID)
  else
    Result := TBillsCacheNode.Create(Self, AID);
  CacheNodes.Add(Result);
end;

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

function TBillsCacheTree.AddLeafBillsNode(const AB_Code: string): TBillsCacheNode;

  function GetLastXmjParent: TBillsCacheNode;
  begin
    Result := TBillsCacheNode(FLastNode);
    while Assigned(Result) and (Result.B_Code <> '') do
      Result := TBillsCacheNode(Result.Parent);
  end;

var
  Parent: TBillsCacheNode;
begin
  Parent := GetLastXmjParent;
  Result := AddNodeByCode(Parent.Code + '-' + AB_Code, -1);
end;

procedure TBillsCacheTree.SetSeparateChar(const Value: Char);
var
  I: Integer;
  Node: TBillsCacheNode;
begin
  for I := 0 to CacheNodes.Count - 1 do
  begin
    Node := TBillsCacheNode(CacheNodes.Items[I]);
    Node.FLevelCode := StringReplace(Node.FLevelCode, FSeparateChar, Value, [rfReplaceAll]);
  end;
  FSeparateChar := Value;
end;

procedure TBillsCacheTree.SaveTreeToFile(const AFileName: string);
var
  sgs: TStringList;
  I: Integer;
  Node: TBillsCacheNode;
begin
  sgs := TStringList.Create;
  try
    for I := 0 to CacheNodes.Count - 1 do
    begin
      Node := TBillsCacheNode(CacheNodes.Items[I]);
      sgs.Add(Format('ID: %3d; ParentID: %3d; NextID: %3d; Code: %s; B_Code: %s; Name: %s;',
        [Node.ID, Node.ParentID, Node.NextSiblingID, Node.Code, Node.B_Code, Node.Name]));
    end;
    sgs.SaveToFile(AFileName);
  finally
    sgs.Free;
  end;
end;

function TBillsCacheTree.FindGclChild(AParent: TBillsCacheNode;
  const AB_Code, AName, AUnits: string; APrice: Double): TBillsCacheNode;
var
  vChild: TBillsCacheNode;
begin
  Result := nil;

  if Assigned(AParent) then
    vChild := TBillsCacheNode(AParent.FirstChild)
  else
    vChild := TBillsCacheNode(Root.FirstChild);

  while Assigned(vChild) and not Assigned(Result) do
  begin
    if SameText(AB_Code, vChild.B_Code) and
        SameText(AName, vChild.Name) and
        SameText(AUnits, vChild.Units) and
        (APrice = vChild.Price) then
      Result := vChild;
    vChild := TBillsCacheNode(vChild.NextSibling);
  end;
end;

function TBillsCacheTree.FindXmjChild(AParent: TBillsCacheNode;
  const ACode, AName: string): TBillsCacheNode;
var
  vChild: TBillsCacheNode;
begin
  Result := nil;

  if Assigned(AParent) then
    vChild := TBillsCacheNode(AParent.FirstChild)
  else
    vChild := TBillsCacheNode(Root.FirstChild);

  while Assigned(vChild) and not Assigned(Result) do
  begin
    if SameText(ACode, vChild.Code) and SameText(AName, vChild.Name) then
      Result := vChild;
    vChild := TBillsCacheNode(vChild.NextSibling);
  end;
end;

{ TReportCacheNode }

constructor TReportCacheNode.Create(ACacheTree: TCacheTree; AID,
  AProjectCount: Integer);
begin
  inherited Create(ACacheTree, AID);
  FProjectCount := AProjectCount;
  SetLength(FP_Quantity, AProjectCount);
  SetLength(FP_Price, AProjectCount);
  SetLength(FP_TotalPrice, AProjectCount);
  SetLength(FP_DgnQuantity1, AProjectCount);
  SetLength(FP_DgnQuantity2, AProjectCount);
end;

function TReportCacheNode.GetAddGatherQuantity: Double;
begin
  Result := AddDealQuantity + AddQcQuantity;
end;

function TReportCacheNode.GetAddGatherTotalPrice: Double;
begin
  Result := AddDealTotalPrice + AddQcTotalPrice + AddPcTotalPrice;
end;

function TReportCacheNode.GetDoubleArrayTotal(
  ADoubleArray: TDoubleArray): Double;
var
  i: Integer;
begin
  Result := 0;
  for i := Low(ADoubleArray) to High(ADoubleArray) do
    Result := Result + ADoubleArray[i];
end;

function TReportCacheNode.GetGatherP_TotalPrice: Double;
begin
  Result := GetDoubleArrayTotal(FP_TotalPrice);
end;

procedure TReportCacheNode.ResolveCode;
var
  sgs: TStrings;
  i: Integer;
begin
  sgs := TStringList.Create;
  try
    sgs.Delimiter := '-';
    sgs.DelimitedText := FCode;
    FXiangCode := '';
    FMuCode := '';
    FJieCode := '';
    FXiMuCode := '';
    case sgs.Count of
      1: FXiangCode := '';
      2: FXiangCode := ChinessNum(StrToIntDef(sgs[1], 0));
      3: FMuCode := sgs[2];
      4: FJieCode := sgs[3];
      else
      begin
        for i := 4 to sgs.Count - 1 do
          if FXiMuCode = '' then
            FXiMuCode := sgs[i]
          else
            FXiMuCode := FXiMuCode + '-' + sgs[i];
      end;
    end;
  finally
    sgs.Free;
  end;
end;

procedure TReportCacheNode.SetCode(const Value: string);
begin
  FCode := Value;
  ResolveCode;
end;

{ TReportCacheTree }

function TReportCacheTree.AddNode(AParent,
  ANextSibling: TCacheNode): TReportCacheNode;
begin
  Result := GetNewNode(FProjectCount);
  if Assigned(ANextSibling) then
    ANextSibling.InsertPreSibling(Result)
  else if Assigned(AParent) then
    AParent.InsertChild(Result)
  else
    Root.InsertChild(Result);
end;

constructor TReportCacheTree.Create(AProjectCount: Integer);
begin
  inherited Create;
  FProjectCount := AProjectCount;
  FGatherCacheNode := TReportCacheNode.Create(nil, -2, AProjectCount);
  SetLength(FProjectName, AProjectCount);
end;

destructor TReportCacheTree.Destroy;
begin
  FGatherCacheNode.Free;
  inherited;
end;

function TReportCacheTree.FindNextSibling(AParent: TCacheNode; ACode,
  AB_Code: string): TReportCacheNode;
var
  Node: TReportCacheNode;
  sCodeID, sCodeID2, sB_CodeID, sB_CodeID2: string;
begin
  if Assigned(AParent) then
    Node := TReportCacheNode(AParent.FirstChild)
  else
    Node := TReportCacheNode(Root.FirstChild);
  Result := nil;
  if (ACode = '') and (AB_Code = '') then Exit;
  sCodeID := ConvertDigitCode(ACode, 3, '-');
  sB_CodeID := ConvertDigitCode(AB_Code, 4, '-');
  while Assigned(Node) do
  begin
    sCodeID2 := ConvertDigitCode(Node.Code, 3, '-');
    sB_CodeID2 := ConvertDigitCode(AB_Code, 4, '-');
    if sCodeID < sCodeID2 then
    begin
      Result := Node;
      Break;
    end
    else if sB_CodeID < sB_CodeID2 then
    begin
      Result := Node;
      Break;
    end;
    Node := TReportCacheNode(Node.NextSibling);
  end;
end;

function TReportCacheTree.FindNode(AParent: TCacheNode; ACode,
  AB_Code: string): TReportCacheNode;
var
  Node: TReportCacheNode;
begin
  if Assigned(AParent) then
    Node := TReportCacheNode(AParent.FirstChild)
  else
    Node := TReportCacheNode(Root.FirstChild);
  Result := nil;
  while Assigned(Node) do
  begin
    if (Node.Code = ACode) and (Node.B_Code = AB_Code) then
    begin
      Result := Node;
      Break;
    end;
    Node := TReportCacheNode(Node.NextSibling);
  end;
end;

function TReportCacheTree.FindNode(AParent: TCacheNode;
  AName: string): TReportCacheNode;
var
  Node: TReportCacheNode;
begin
  if Assigned(AParent) then
    Node := TReportCacheNode(AParent.FirstChild)
  else
    Node := TReportCacheNode(Root.FirstChild);
  Result := nil;
  while Assigned(Node) do
  begin
    if SameText(Node.Name, AName) then
    begin
      Result := Node;
      Break;
    end;
    Node := TReportCacheNode(Node.NextSibling);
  end;
end;

function TReportCacheTree.FindNode(AParent: TCacheNode; ACode, AB_Code,
  AName: string): TReportCacheNode;
var
  Node: TReportCacheNode;
begin
  if Assigned(AParent) then
    Node := TReportCacheNode(AParent.FirstChild)
  else
    Node := TReportCacheNode(Root.FirstChild);
  Result := nil;
  while Assigned(Node) do
  begin
    if SameText(Node.Code, ACode) and SameText(Node.B_Code, AB_Code)
        and SameText(Node.Name, AName) then
    begin
      Result := Node;
      Break;
    end;
    Node := TReportCacheNode(Node.NextSibling);
  end;
end;

function TReportCacheTree.GetNewNode(
  AProjectCount: Integer): TReportCacheNode;
begin
  Result := TReportCacheNode.Create(Self, GetNewNodeID, AProjectCount);
  CacheNodes.Add(Result);
end;

procedure TReportCacheTree.ReCalcGatherData;
var
  i: Integer;
  CacheNode: TReportCacheNode;
begin
  FGatherCacheNode.Free;
  FGatherCacheNode := TReportCacheNode.Create(nil, -2, FProjectCount);

  CacheNode := TReportCacheNode(FirstNode);
  while Assigned(CacheNode) do
  begin
    FGatherCacheNode.TotalPrice := FGatherCacheNode.TotalPrice + CacheNode.TotalPrice;

    FGatherCacheNode.AddDealTotalPrice := FGatherCacheNode.AddDealTotalPrice + CacheNode.AddDealTotalPrice;
    FGatherCacheNode.AddQcTotalPrice := FGatherCacheNode.AddQcTotalPrice + CacheNode.AddQcTotalPrice;
    FGatherCacheNode.AddPcTotalPrice := FGatherCacheNode.AddPcTotalPrice + CacheNode.AddPcTotalPrice;

    FGatherCacheNode.PDTotalPrice := FGatherCacheNode.PDTotalPrice + CacheNode.PDTotalPrice;
    FGatherCacheNode.CDDTotalPrice := FGatherCacheNode.CDDTotalPrice + CacheNode.CDDTotalPrice;
    FGatherCacheNode.ABTotalPrice := FGatherCacheNode.ABTotalPrice + CacheNode.ABTotalPrice;

    for i := 0 to FProjectCount - 1 do
      FGatherCacheNode.P_TotalPrice[i] := FGatherCacheNode.P_TotalPrice[i] + CacheNode.P_TotalPrice[i];
    CacheNode := TReportCacheNode(CacheNode.NextSibling);
  end;
end;

procedure TReportCacheTree.ReCalcRatioPercent;
var
  i: Integer;
  CacheNode: TReportCacheNode;
begin
  for i := 0 to CacheNodes.Count - 1 do
  begin
    CacheNode := TReportCacheNode(CacheNodes.Items[i]);
    if GatherCacheNode.TotalPrice <> 0 then
      CacheNode.RatioPercent := AdvRoundTo(CacheNode.TotalPrice/GatherCacheNode.TotalPrice*100);
    if GatherCacheNode.AddGatherTotalPrice <> 0 then
      CacheNode.AddRatioPercent := AdvRoundTo(CacheNode.AddGatherTotalPrice/GatherCacheNode.AddGatherTotalPrice*100);
  end;
end;

procedure TReportCacheTree.SaveTreeToFile(const AFileName: string);
var
  sgs: TStringList;
  I: Integer;
  Node: TReportCacheNode;
begin
  sgs := TStringList.Create;
  try
    for I := 0 to CacheNodes.Count - 1 do
    begin
      Node := TReportCacheNode(CacheNodes.Items[I]);
      sgs.Add(Format('ID: %3d; ParentID: %3d; NextID: %3d; Code: %s; B_Code: %s; Name: %s;',
        [Node.ID, Node.ParentID, Node.NextSiblingID, Node.Code, Node.B_Code, Node.Name]));
    end;
    sgs.SaveToFile(AFileName);
  finally
    sgs.Free;
  end;
end;

{ TAllPhaseCacheTree }

function TAllPhaseCacheTree.AddNode(AID: Integer; AParent,
  ANextSibling: TCacheNode): TAllPhaseCacheNode;
begin
  Result := GetNewNode(AID);
  if Assigned(ANextSibling) then
    ANextSibling.InsertPreSibling(Result)
  else if Assigned(AParent) then
    AParent.InsertChild(Result)
  else
    Root.InsertChild(Result);
end;

function TAllPhaseCacheTree.FindNode(AID: Integer): TAllPhaseCacheNode;
var
  i: Integer;
  Node: TAllPhaseCacheNode;
begin
  Result := nil;
  for i := 0 to CacheNodes.Count - 1 do
  begin
    Node := TAllPhaseCacheNode(CacheNodes.Items[i]);
    if Node.ID = AID then
    begin
      Result := Node;
      Break;
    end;
  end;
end;

function TAllPhaseCacheTree.GetNewNode(
  AID: Integer): TAllPhaseCacheNode;
begin
  Result := TAllPhaseCacheNode.Create(Self, AID);
  CacheNodes.Add(Result);
end;

procedure TAllPhaseCacheTree.SaveTreeToFile(const AFileName: string);
var
  sgs: TStringList;
  I: Integer;
  Node: TAllPhaseCacheNode;
begin
  sgs := TStringList.Create;
  try
    for I := 0 to CacheNodes.Count - 1 do
    begin
      Node := TAllPhaseCacheNode(CacheNodes.Items[I]);
      sgs.Add(Format('ID: %3d; ParentID: %3d; NextID: %3d; Code: %s; B_Code: %s; Name: %s;',
        [Node.ID, Node.ParentID, Node.NextSiblingID, Node.Code, Node.B_Code, Node.Name]));
    end;
    sgs.SaveToFile(AFileName);
  finally
    sgs.Free;
  end;
end;

{ TGclCacheTree }

function TGclCacheTree.AddNodeByB_Code(
  const AB_Code: string): TGclCacheNode;

  function FindParent: TGclCacheNode;
  begin
    Result := FLastNode;
    while Assigned(Result) and (Result.B_Code <> '') and (Pos(Result.B_Code + '-', AB_Code) <> 1) do
      Result := TGclCacheNode(Result.Parent);
  end;

var
  vParent: TGclCacheNode;
begin
  vParent := FindParent;
  Result := TGclCacheNode(AddNode(vParent));
  FLastNode := Result;
end;

function TGclCacheTree.AddNodeByData(const AB_Code,
  AName: string): TGclCacheNode;
begin
  if AB_Code = '' then
    Result := AddNodeByName(AName)
  else
    Result := AddNodeByB_Code(AB_Code);
end;

function TGclCacheTree.AddNodeByName(const AName: string): TGclCacheNode;
begin
  if Pos('第100章至', AName) <> 0 then
  begin
    Result := TGclCacheNode(AddNode(nil));
    FLastBlank1 := Result;
  end
  else
    Result := TGclCacheNode(AddNode(FLastBlank1));
  FLastNode := Result;
end;

function TGclCacheTree.GetNewNode: TCacheNode;
begin
  Result := TGclCacheNode.Create(Self, GetNewNodeID);
  CacheNodes.Add(Result);
end;

procedure TGclCacheTree.SaveTreeToFile(const AFileName: string);
var
  sgs: TStringList;
  I: Integer;
  Node: TGclCacheNode;
begin
  sgs := TStringList.Create;
  try
    for I := 0 to CacheNodes.Count - 1 do
    begin
      Node := TGclCacheNode(CacheNodes.Items[I]);
      sgs.Add(Format('ID: %3d; ParentID: %3d; NextID: %3d; B_Code: %s; Name: %s;',
        [Node.ID, Node.ParentID, Node.NextSiblingID, Node.B_Code, Node.Name]));
    end;
    sgs.SaveToFile(AFileName);
  finally
    sgs.Free;
  end;
end;

end.