Measure/SubTenderGather/stgGatherCacheData.pas

unit stgGatherCacheData;

interface

uses
  CacheTree, SysUtils, BillsTree, Classes, sdDB, mDataRecord;

const
  // 新增项目节
  iErrorXmjAdd = 1;
  // 存在同号项目节，但名称、单价不同
  iErrorXmjDiff = 2;
  // 项目节层次少于总包
  iErrorXmjLess = 3;

  // 新增工程量清单
  iErrorGclAdd = 11;
  // 存在同名工程量清单，但名称、单价不同
  iErrorGclDiff = 12;
  // 工程量清单层次多于总包
  iErrorGclMore = 13;
  // 工程量清单层次少于总包
  iErrorGclLess = 14;

type
  TstgStageData = class
  private
    FDealQuantity: Double;
    FDealTotalPrice: Double;
    FQcQuantity: Double;
    FQcTotalPrice: Double;
    FQcBGLCode: string;
    FQcBGLNum: string;

    procedure AddBGLCodeAndNum(ACode, ANum: string);
  public
    procedure ClearData;
    procedure AddStageData(AStageData: TstgStageData);
    procedure AssignedData(AStageRecord: TStageRecord);

    property DealQuantity: Double read FDealQuantity;
    property DealTotalPrice: Double read FDealTotalPrice;
    property QcQuantity: Double read FQcQuantity;
    property QcTotalPrice: Double read FQcTotalPrice;
    property QcBGLCode: string read FQcBGLCode;
    property QcBGLNum: string read FQcBGLNum;
  end;

  TstgSubTenderDetailData = class
  private
    FSerialNo: Integer;
    FLeafXmjCode: string;
    FDetailStage: TstgStageData;
  public
    constructor Create(ANode: TMeasureBillsIDTreeNode);
    destructor Destroy; override;

    property SerialNo: Integer read FSerialNo;
    property LeafXmjCode: string read FLeafXmjCode;
    property DetailStage: TstgStageData read FDetailStage;
  end;

  TstgSubTenderStageData = class
  private
    FSubTenderID: Integer;
    FGather: TstgStageData;
    FDetails: TList;
    function GetDetail(AIndex: Integer): TstgSubTenderDetailData;
    function GetDetailCount: Integer;
  public
    constructor Create(ASubTenderID: Integer);
    destructor Destroy; override;

    function AddDetail(ANode: TMeasureBillsIDTreeNode): TstgSubTenderDetailData;

    procedure CalculateGather;

    property SubTenderID: Integer read FSubTenderID;
    property Gather: TstgStageData read FGather;
    property DetailCount: Integer read GetDetailCount;
    property Detail[AIndex: Integer]: TstgSubTenderDetailData read GetDetail;
  end;

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

    FIsSumBase: Boolean;
    FIsLeafXmj: Boolean;
    FIsLeaf: Boolean;
    FIsSubTender: Boolean;

    FGather: TstgStageData;
    FSubTenders: TList;
    function GetIsGclBills: Boolean;
    function GetSubTender(AIndex: Integer): TstgSubTenderStageData;
    function GetSubTenderCount: Integer;
  public
    constructor Create(ATree: TCacheTree; AID: Integer); override;
    destructor Destroy; override;

    function FindSubTender(ASubTenderID: Integer): TstgSubTenderStageData;
    function SafeSubTender(ASubTenderID: Integer): TstgSubTenderStageData;

    procedure CalculateGather;

    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 IsSumBase: Boolean read FIsSumBase write FIsSumBase;
    property IsLeafXmj: Boolean read FIsLeafXmj write FIsLeafXmj;
    property IsLeaf: Boolean read FIsLeaf write FIsLeaf;
    property IsSubTender: Boolean read FIsSubTender write FIsSubTender;

    property IsGclBills: Boolean read GetIsGclBills;

    property SubTenderCount: Integer read GetSubTenderCount;
    property SubTender[AIndex: Integer]: TstgSubTenderStageData read GetSubTender;

    property Gather: TstgStageData read FGather;
  end;

  TstgGatherTree = class(TCacheTree)
  private
    FFixedNodes: TCacheNodeList;
    // -1的情况下默认自动赋值一个新的ID
    function GetNewNode(AID: Integer = -1): TstgGatherTreeNode; overload;

    function CheckLeafXmj(ANode: TstgGatherTreeNode): Boolean;
  public
    constructor Create; override;
    destructor Destroy; override;

    function FindNextSibling(AParent: TCacheNode; ACode, AB_Code: string): TstgGatherTreeNode;
    function FindNode(AParent: TCacheNode; AInfo: TBillsIDTreeNode): TstgGatherTreeNode; overload;
    function FindNode(AID: Integer): TstgGatherTreeNode; overload;

    function AddFixedNode(AParent: TCacheNode; ANextSibling:
      TCacheNode = nil; AFixedID: Integer = -1): TstgGatherTreeNode;
    function AddNode(AParent: TCacheNode; ANextSibling:
      TCacheNode = nil; ASumBaseID: Integer = -1): TstgGatherTreeNode;

    function AddSumBaseNode(AParent: TCacheNode; ASumBaseID: Integer): TstgGatherTreeNode;
    function AddSubTenderNode(AParent: TCacheNode; ANextSibling: TCacheNode; AFixedID: Integer = -1): TstgGatherTreeNode;

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

    procedure MarkLeafXmj;
    procedure CalculateAll;
  end;

  TstgGatherSubTender = class
  private
    FID: Integer;
    FRec: TsdDataRecord;
  public
    constructor Create(ARec: TsdDataRecord);

    property ID: Integer read FID;
    property Rec: TsdDataRecord read FRec;
  end;

  TstgErrorInfo = class
  private
    FRelaNode: TstgGatherTreeNode;
    FErrorType: Integer;

    FDetails: TList;
    function GetDetail(AIndex: Integer): TstgGatherTreeNode;
    function GetDetailCount: Integer;
  public
    constructor Create(ARelaNode: TstgGatherTreeNode);
    destructor Destroy; override;

    procedure AddErrorDetail(ARelaDetailNode: TstgGatherTreeNode);

    property RelaNode: TstgGatherTreeNode read FRelaNode;
    property ErrorType: Integer read FErrorType write FErrorType;

    property DetailCount: Integer read GetDetailCount;
    property Detail[AIndex: Integer]: TstgGatherTreeNode read GetDetail;
  end;

  TstgGatherCacheData = class
  private
    FGatherTree: TstgGatherTree;
    FSubTenders: TList;
    FErrors: TList;

    function FindError(ANode: TstgGatherTreeNode): TstgErrorInfo;
    function NewError(ANode: TstgGatherTreeNode; AErrorType: Integer): TstgErrorInfo;

    function GetSubTenderCount: Integer;
    function GetSubTender(AIndex: Integer): TstgGatherSubTender;
    function GetErrorCount: Integer;
    function GetError(AIndex: Integer): TstgErrorInfo;
  public
    constructor Create;
    destructor Destroy; override;

    function FindSubTender(AID: Integer): TstgGatherSubTender;
    function AddSubTender(ARec: TsdDataRecord): TstgGatherSubTender;

    procedure AddError(ANode, ALeafErrorNode: TstgGatherTreeNode; AErrorType: Integer);

    property SubTenderCount: Integer read GetSubTenderCount;
    property SubTender[AIndex: Integer]: TstgGatherSubTender read GetSubTender;

    property ErrorCount: Integer read GetErrorCount;
    property Error[AIndex: Integer]: TstgErrorInfo read GetError;

    property GatherTree: TstgGatherTree read FGatherTree;
  end;

implementation

uses
  ZhAPI, UtilMethods, Math;

{ TstgGatherTreeNode }

procedure TstgGatherTreeNode.CalculateGather;
var
  i: Integer;
  vSubTender: TstgSubTenderDetailData;
begin
  FGather.ClearData;
  for i := 0 to FSubTenders.Count - 1 do
  begin
    SubTender[i].CalculateGather;
    FGather.AddStageData(SubTender[i].Gather);
  end;
end;

constructor TstgGatherTreeNode.Create(ATree: TCacheTree; AID: Integer);
begin
  inherited Create(ATree, AID);
  FSubTenders := TList.Create;
  FGather := TstgStageData.Create;
end;

destructor TstgGatherTreeNode.Destroy;
begin
  FGather.Free;
  ClearObjects(FSubTenders);
  FSubTenders.Free;
  inherited;
end;

function TstgGatherTreeNode.FindSubTender(
  ASubTenderID: Integer): TstgSubTenderStageData;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to FSubTenders.Count - 1 do
  begin
    if ASubTenderID = SubTender[i].SubTenderID then
    begin
      Result := SubTender[i];
      Break;
    end;
  end;
end;

function TstgGatherTreeNode.GetIsGclBills: Boolean;
begin
  Result := FB_Code <> '';
end;

function TstgGatherTreeNode.GetSubTender(
  AIndex: Integer): TstgSubTenderStageData;
begin
  Result := TstgSubTenderStageData(FSubTenders.Items[AIndex]);
end;

function TstgGatherTreeNode.GetSubTenderCount: Integer;
begin
  Result := FSubTenders.Count;
end;

function TstgGatherTreeNode.SafeSubTender(
  ASubTenderID: Integer): TstgSubTenderStageData;
begin
  Result := FindSubTender(ASubTenderID);
  if not Assigned(Result) then
  begin
    Result := TstgSubTenderStageData.Create(ASubTenderID);
    FSubTenders.Add(Result);
  end;
end;

{ TstgGatherTree }

function TstgGatherTree.AddFixedNode(AParent, ANextSibling: TCacheNode;
  AFixedID: Integer): TstgGatherTreeNode;
begin
  Result := GetNewNode(AFixedID);
  if Assigned(ANextSibling) then
    ANextSibling.InsertPreSibling(Result)
  else if Assigned(AParent) then
    AParent.InsertChild(Result)
  else
    Root.InsertChild(Result);
  FFixedNodes.Add(Result);
end;

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

function TstgGatherTree.AddSubTenderNode(AParent, ANextSibling: TCacheNode;
  AFixedID: Integer): TstgGatherTreeNode;
begin
  Result := GetNewNode(AFixedID);
  Result.IsSubTender := True;

  if Assigned(ANextSibling) then
    ANextSibling.InsertPreSibling(Result)
  else if Assigned(AParent) then
    AParent.InsertChild(Result)
  else
    Root.InsertChild(Result);
end;

function TstgGatherTree.AddSumBaseNode(AParent: TCacheNode;
  ASumBaseID: Integer): TstgGatherTreeNode;
begin
  Result := GetNewNode(ASumBaseID);
  Result.IsSumBase := True;

  if Assigned(AParent) then
    AParent.InsertChild(Result)
  else
    Root.InsertChild(Result);
end;

procedure TstgGatherTree.CalculateAll;
var
  i: Integer;
begin
  for i := 0 to CacheNodes.Count - 1 do
    TstgGatherTreeNode(CacheNodes[i]).CalculateGather;
end;

function TstgGatherTree.CheckLeafXmj(ANode: TstgGatherTreeNode): Boolean;
var
  iChild: Integer;
  vChild: TstgGatherTreeNode;
begin
  Result := True;
  for iChild := 0 to ANode.Children.Count - 1 do
  begin
    vChild := TstgGatherTreeNode(ANode.Children.Items[iChild]);
    if vChild.FB_Code = '' then
    begin
      Result := False;
      Break;
    end;
  end;
end;

constructor TstgGatherTree.Create;
begin
  inherited;
  FFixedNodes := TCacheNodeList.Create;
  NewNodeID := 100;
end;

destructor TstgGatherTree.Destroy;
begin
  FFixedNodes.Free;
  inherited;
end;

function TstgGatherTree.FindNextSibling(AParent: TCacheNode;
  ACode, AB_Code: string): TstgGatherTreeNode;
var
  vChild: TstgGatherTreeNode;
begin
  Result := nil;
  if Assigned(AParent) then
    vChild := TstgGatherTreeNode(AParent.FirstChild)
  else
    vChild := TstgGatherTreeNode(Root.FirstChild);
  while not Assigned(Result) and Assigned(vChild) do
  begin
    if (CompareCode(ACode, vChild.Code) < 0) or (CompareCode(AB_Code, vChild.B_Code) < 0) then
      Result := vChild;
    vChild := TstgGatherTreeNode(vChild.NextSibling);
  end;
end;

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

function TstgGatherTree.FindNode(AParent: TCacheNode;
  AInfo: TBillsIDTreeNode): TstgGatherTreeNode;
var
  vNode: TstgGatherTreeNode;
begin
  Result := nil;
  if Assigned(AParent) then
    vNode := TstgGatherTreeNode(AParent.FirstChild)
  else
    vNode := TstgGatherTreeNode(Root.FirstChild);

  while Assigned(vNode) and not Assigned(Result) do
  begin
    if SameText(vNode.Code, Trim(AInfo.Rec.Code.AsString)) and SameText(vNode.B_Code, Trim(AInfo.Rec.B_Code.AsString))
        and SameText(vNode.Name, Trim(AInfo.Rec.Name.AsString)) and SameText(vNode.Units, Trim(AInfo.Rec.Units.AsString)) then
      Result := vNode;
    vNode := TstgGatherTreeNode(vNode.NextSibling);
  end;
end;

function TstgGatherTree.GetNewNode(AID: Integer): TstgGatherTreeNode;
begin
  if AID = -1 then
    Result := TstgGatherTreeNode.Create(Self, GetNewNodeID)
  else
    Result := TstgGatherTreeNode.Create(Self, AID);
  NewNodeID := Max(NewNodeID, AID + 1);
  CacheNodes.Add(Result);
  if AID < 100 then
    FFixedNodes.Add(Result);
end;

procedure TstgGatherTree.MarkLeafXmj;
var
  i: Integer;
  vNode: TstgGatherTreeNode;
begin
  for i := 0 to CacheNodes.Count - 1 do
  begin
    vNode := TstgGatherTreeNode(CacheNodes.Items[i]);
    vNode.IsLeafXmj := CheckLeafXmj(vNode);
  end;
end;

procedure TstgGatherTree.SaveTreeToFile(const AFileName: string);
var
  sgs: TStringList;
  I: Integer;
  Node: TstgGatherTreeNode;
begin
  sgs := TStringList.Create;
  try
    for I := 0 to CacheNodes.Count - 1 do
    begin
      Node := TstgGatherTreeNode(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;

{ TstgGatherCacheData }

procedure TstgGatherCacheData.AddError(ANode,
  ALeafErrorNode: TstgGatherTreeNode; AErrorType: Integer);
var
  vError: TstgErrorInfo;
begin
  vError := FindError(ANode);
  if not Assigned(vError) then
    vError := NewError(ANode, AErrorType);
  vError.AddErrorDetail(ALeafErrorNode);
end;

function TstgGatherCacheData.AddSubTender(
  ARec: TsdDataRecord): TstgGatherSubTender;
begin
  Result := FindSubTender(ARec.ValueByName('ID').AsInteger);
  if not Assigned(Result) then
  begin
    Result := TstgGatherSubTender.Create(ARec);
    FSubTenders.Add(Result);
  end;
end;

constructor TstgGatherCacheData.Create;
begin
  FGatherTree := TstgGatherTree.Create;
  FSubTenders := TList.Create;
  FErrors := TList.Create;
end;

destructor TstgGatherCacheData.Destroy;
begin
  ClearObjects(FErrors);
  FErrors.Free;
  ClearObjects(FSubTenders);
  FSubTenders.Free;
  FGatherTree.Free;
  inherited;
end;

function TstgGatherCacheData.FindError(
  ANode: TstgGatherTreeNode): TstgErrorInfo;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to ErrorCount - 1 do
  begin
    if Error[i].RelaNode = ANode then
    begin
      Result := Error[i];
      Break;
    end;
  end;
end;

function TstgGatherCacheData.FindSubTender(
  AID: Integer): TstgGatherSubTender;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to SubTenderCount - 1 do
  begin
    if SubTender[i].ID = AID then
    begin
      Result := SubTender[i];
      Break;
    end;
  end;
end;

function TstgGatherCacheData.GetError(AIndex: Integer): TstgErrorInfo;
begin
  Result := TstgErrorInfo(FErrors.Items[AIndex]);
end;

function TstgGatherCacheData.GetErrorCount: Integer;
begin
  Result := FErrors.Count;
end;

function TstgGatherCacheData.GetSubTender(AIndex: Integer): TstgGatherSubTender;
begin
  Result := TstgGatherSubTender(FSubTenders.Items[AIndex]);
end;

function TstgGatherCacheData.GetSubTenderCount: Integer;
begin
  Result := FSubTenders.Count;
end;

function TstgGatherCacheData.NewError(
  ANode: TstgGatherTreeNode; AErrorType: Integer): TstgErrorInfo;
begin
  Result := TstgErrorInfo.Create(ANode);
  Result.ErrorType := AErrorType;
  FErrors.Add(Result);
end;

{ TstgGatherSubTender }

constructor TstgGatherSubTender.Create(ARec: TsdDataRecord);
begin
  FID := ARec.ValueByName('ID').AsInteger;
  FRec := ARec;
end;

{ TstgStageData }

procedure TstgStageData.AddBGLCodeAndNum(ACode, ANum: string);
var
  sCode, sNum: string;
begin
  sCode := FQcBGLCode;
  sNum := FQcBGLNum;
  MergeRelaBGLAndNum(sCode, sNum, ACode, ANum);
  FQcBGLCode := sCode;
  FQcBGLNum := sNum;
end;

procedure TstgStageData.AddStageData(AStageData: TstgStageData);
begin
  FDealQuantity := FDealQuantity + AStageData.DealQuantity;
  FDealTotalPrice := FDealTotalPrice + AStageData.DealTotalPrice;
  FQcQuantity := FQcQuantity + AStageData.QcQuantity;
  FQcTotalPrice := FQcTotalPrice + AStageData.QcTotalPrice;
  AddBGLCodeAndNum(AStageData.QcBGLCode, AStageData.QcBGLNum);
end;

procedure TstgStageData.AssignedData(AStageRecord: TStageRecord);
begin
  FDealQuantity := AStageRecord.DealQuantity.AsFloat;
  FDealTotalPrice := AStageRecord.DealTotalPrice.AsFloat;
  FQcQuantity := AStageRecord.QcQuantity.AsFloat;
  FQcTotalPrice := AStageRecord.QcTotalPrice.AsFloat;
  FQcBGLCode := AStageRecord.QcBGLCode.AsString;
  FQcBGLNum := AStageRecord.QcBGLNum.AsString;
end;

procedure TstgStageData.ClearData;
begin
  FDealQuantity := 0;
  FDealTotalPrice := 0;
  FQcQuantity := 0;
  FQcTotalPrice := 0;
  FQcBGLCode := '';
  FQcBGLNum := '';
end;

{ TstgSubTenderStageData }

function TstgSubTenderStageData.AddDetail(
  ANode: TMeasureBillsIDTreeNode): TstgSubTenderDetailData;
begin
  Result := TstgSubTenderDetailData.Create(ANode);
  FDetails.Add(Result);
end;

procedure TstgSubTenderStageData.CalculateGather;
var
  i: Integer;
begin
  FGather.ClearData;
  for i := 0 to DetailCount - 1 do
    FGather.AddStageData(Detail[i].DetailStage);
end;

constructor TstgSubTenderStageData.Create(ASubTenderID: Integer);
begin
  FSubTenderID := ASubTenderID;
  FGather := TstgStageData.Create;
  FDetails := TList.Create;
end;

destructor TstgSubTenderStageData.Destroy;
begin
  ClearObjects(FDetails);
  FDetails.Free;
  FGather.Free;
  inherited;
end;

function TstgSubTenderStageData.GetDetail(
  AIndex: Integer): TstgSubTenderDetailData;
begin
  Result := TstgSubTenderDetailData(FDetails.Items[AIndex]);
end;

function TstgSubTenderStageData.GetDetailCount: Integer;
begin
  Result := FDetails.Count;
end;

{ TstgSubTenderDetailData }

constructor TstgSubTenderDetailData.Create(ANode: TMeasureBillsIDTreeNode);
begin
  FSerialNo := ANode.MajorIndex;
  FDetailStage := TstgStageData.Create;
  if Assigned(ANode.StageRec) then
    FDetailStage.AssignedData(ANode.StageRec);
end;

destructor TstgSubTenderDetailData.Destroy;
begin
  FDetailStage.Free;
  inherited;
end;

{ TstgErrorInfo }

procedure TstgErrorInfo.AddErrorDetail(
  ARelaDetailNode: TstgGatherTreeNode);
begin
  FDetails.Add(ARelaDetailNode);
end;

constructor TstgErrorInfo.Create(ARelaNode: TstgGatherTreeNode);
begin
  FRelaNode := ARelaNode;
  FDetails := TList.Create;
end;

destructor TstgErrorInfo.Destroy;
begin
  FDetails.Free;
  inherited;
end;

function TstgErrorInfo.GetDetail(AIndex: Integer): TstgGatherTreeNode;
begin
  Result :=  TstgGatherTreeNode(FDetails.Items[AIndex]);
end;

function TstgErrorInfo.GetDetailCount: Integer;
begin
  Result := FDetails.Count;
end;

end.