Measure/DataModules/StageDm.pas

unit StageDm;

// 原报、审核数据通用
// 原报 - Refer
// 审核 - Audit1, Audit2 ...

interface

uses
  mDataRecord, BillsTree,
  SysUtils, Classes, sdDB, sdProvider, ADODB, ZhAPI, sdIDTree;

type
  TStageData = class(TDataModule)
    sdpStage: TsdADOProvider;
    sddStage: TsdDataSet;
    procedure sddStageAfterValueChanged(AValue: TsdValue);
    procedure sddStageBeforeValueChange(AValue: TsdValue;
      const NewValue: Variant; var Allow: Boolean);
    procedure sddStageGetRecordClass(var ARecordClass: TsdRecordClass);
  private
    FPhaseData: TObject;
    FIndex: Integer;

    FBeforeChangeQuantity: Double;
    FBeforeChangeTotalPrice: Double;

    procedure UpdateParentRecord(ABillsID: Integer; ATotalPrice: Double; const AFieldName: string);
    procedure UpdateComplete(ABillsID: Integer; AQuantity, ATotalPrice: Double);

    function HasPriceMarginBills: Boolean;

    // 向父项增量--PM_TotalPrice
    procedure UpdateParentPriceMargin(ABillsID: Integer; ADiffer: Double);
    // 向价差调整节点增量--GatherTotalPrice
    procedure UpdatePriceMarginNode(ADiffer: Double);
    // 重新计算相关的项目工料的价差数据
    procedure UpdateProjectGL(ABillsID: Integer);

    procedure CalculateDeal(ABillsID: Integer);
    procedure CalculateQuantityChange(ABillsID: Integer);
    procedure CalculatePriceChange(ABillsID: Integer);
    procedure CalculateGather(ABillsID: Integer);

    procedure CalculateParent(ANode: TMeasureBillsIDTreeNode);
    procedure CalculateLeaf(ANode: TMeasureBillsIDTreeNode);
    procedure CalculateSpecialLeaf(ANode: TMeasureBillsIDTreeNode);

    function GetTotalPrice(ABillsID, AType, AStageIndex: Integer): Double;

    function GetCalcType(ABillsID: Integer): Integer;
    function GetBillsUnitPriceMargin(ABillsID: Integer): Double;

    function GetBillsPrice(ABillsID: Integer): Double;
    function GetBillsNewPrice(ABillsID: Integer): Double;
    function GetBillsPriceDiffer(ABillsID: Integer): Double;

    function GetMainBillsTree: TBillsIDTree;
    function GetBuildLoadInterest(AType, AIndex: Integer): Double;
    function GetFirstPart(AType, AIndex: Integer): Double;
    function GetOtherFee(AType, AIndex: Integer): Double;
    function GetOtherProjectFee(AType, AIndex: Integer): Double;
    function GetRecyclingFee(AType, AIndex: Integer): Double;
    function GetReservedFee(AType, AIndex: Integer): Double;
    function GetSecondPart(AType, AIndex: Integer): Double;
    function GetStageSettlement(AType, AIndex: Integer): Double;
    function GetThirdPart(AType, AIndex: Integer): Double;
    function GetActive: Boolean;
    procedure SetTableName(const Value: string);
    function GetChapterStageGather(AChapter: Integer): Double;
    function GetPriceMargin(AType, AIndex: Integer): Double;
    function GetTableName: string;
  public
    constructor Create(APhaseData: TObject);
    destructor Destroy; override;

    procedure Open(AConnection: TADOConnection);
    procedure Save;

    procedure BeforeBatchOperation;
    procedure AfterBatchOperation;

    // 计算任一清单节点的价差金额，并增量汇总至父项
    procedure CalculatePriceMargin(ABillsID: Integer);
    // 计算材料调差节点
    procedure CalculatePriceMarginNode;
    procedure CalculateNode(ANode: TsdIDTreeNode);
    procedure CalculateAll;

    function AddPhaseData(ABillsID: Integer;
      const AField, ANewValue: string): Boolean;

    function AddStageRecord(ABillsID: Integer): TStageRecord;
    procedure DeletePhaseRecord(ABillsID: Integer);

    procedure ReCalculate(ABillsID: Integer);
    procedure UpdateBGLInfo(ARec: TsdDataRecord; const AType: string);

    // 查找
    function StageRecord(ABillsID: Integer): TStageRecord;
    // 查找，如未找到则新增
    function StageRecordWithAdd(ABillsID: Integer): TStageRecord;

    // 将Bills表中存的累计计量数据拷贝至截止本期计量、截止上期计量，除新增一期计量外不可调用
    procedure CopyPrePhaseData(const APreFile, APreTable: string);

    property Active: Boolean read GetActive;
    property TableName: string read GetTableName Write SetTableName;
    property MainBillsTree: TBillsIDTree read GetMainBillsTree;
    property PhaseData: TObject read FPhaseData;

    {可选计算数}
    // AType表示不同类型，取值如下:
    // 1: 本期数据  2: 截止本期数据  3: 截止上期数据
    // AIndex表示AType下不同数据类型，取值如下:
    // 1: 合同计量 2: 数量变更计量 3: 单价变更计量 4: 完成计量
    // 第一部分
    property FirstPart[AType, AIndex: Integer]: Double read GetFirstPart;
    // 第二部分
    property SecondPart[AType, AIndex: Integer]: Double read GetSecondPart;
    // 第三部分
    property ThirdPart[AType, AIndex: Integer]: Double read GetThirdPart;
    // 预留费用
    property ReservedFee[AType, AIndex: Integer]: Double read GetReservedFee;
    // 其他费用项目
    property OtherFee[AType, AIndex: Integer]: Double read GetOtherFee;
    // 建设期贷款利息
    property BuildLoadInterest[AType, AIndex: Integer]: Double read GetBuildLoadInterest;
    // 回收金额
    property RecyclingFee[AType, AIndex: Integer]: Double read GetRecyclingFee;
    // 公路工程以外的工程费用
    property OtherProjectFee[AType, AIndex: Integer]: Double read GetOtherProjectFee;
    // 本期结算价
    property StageSettlement[AType, AIndex: Integer]: Double read GetStageSettlement;
    // 价差
    property PriceMargin[AType, AIndex: Integer]: Double read GetPriceMargin;

    // 100/200/.../900章本期完成计量
    property ChapterStageGather[AChapter: Integer]: Double read GetChapterStageGather;
  end;

implementation

uses
  ProjectData, BillsDm, PhaseData, Math, BGLDm, BillsMeasureDm,
  UtilMethods, ConditionalDefines, FormulaCalc, DetailGLDm, ConstUnit,
  ProjectGLDm;

{$R *.dfm}

{ TPhaseData }

function TStageData.AddPhaseData(ABillsID: Integer;
  const AField, ANewValue: string): Boolean;

  procedure SetPhaseRecord(ARec: TsdDataRecord; const AField, AValue: string);
  begin
    if CheckNumeric(ANewValue) then
      ARec.ValueByName(AField).AsString := AValue
    else
    begin
      ARec.ValueByName(AField).AsFloat := EvaluateExprs(AValue);
      ARec.ValueByName(StringReplace(AField, 'Quantity', 'Flag', [])).AsInteger := 1;
      ARec.ValueByName(StringReplace(AField, 'Quantity', 'Formula', [])).AsString := AValue;
    end;
  end;

var
  Rec: TsdDataRecord;
begin
  if Assigned(sddStage.FindKey('idxBID', ABillsID)) then Exit;
  Rec := sddStage.Add;
  Rec.ValueByName('BillsID').AsInteger := ABillsID;
  SetPhaseRecord(Rec, AField, ANewValue);
end;

function TStageData.AddStageRecord(ABillsID: Integer): TStageRecord;
begin
  Result := TStageRecord(sddStage.FindKey('idxBID', ABillsID));
  if Assigned(Result) then Exit;

  Result := TStageRecord(sddStage.Add(True));
  try
    Result.ValueByName('BillsID').AsInteger := ABillsID;
  finally
    Result.EndUpdate;
  end;
end;

procedure TStageData.CalculateDeal(ABillsID: Integer);
var
  Rec: TsdDataRecord;
  fQtyDiffer, fTPDiffer: Double;
begin
  Rec := sddStage.FindKey('idxBID', ABillsID);
  if GetCalcType(ABillsID) = 0 then
    Rec.ValueByName('DealTotalPrice').AsFloat :=
        TotalPriceRoundTo(Rec.ValueByName('DealQuantity').AsFloat * GetBillsPrice(ABillsID));

  fQtyDiffer := Rec.ValueByName('DealQuantity').AsFloat - FBeforeChangeQuantity;
  fTPDiffer := Rec.ValueByName('DealTotalPrice').AsFloat - FBeforeChangeTotalPrice;

  Rec.ValueByName('EndDealQuantity').AsFloat := QuantityRoundTo(
      Rec.ValueByName('EndDealQuantity').AsFloat + fQtyDiffer);
  Rec.ValueByName('EndDealTotalPrice').AsFloat := TotalPriceRoundTo(
      Rec.ValueByName('EndDealTotalPrice').AsFloat + fTPDiffer);

  UpdateParentRecord(ABillsID, fTPDiffer, 'DealTotalPrice');

  UpdateComplete(ABillsID, fQtyDiffer, fTPDiffer);
  if TPhaseData(FPhaseData).IsLastStage then
    with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do
      UpdateRecordDeal(ABillsID, fQtyDiffer, fTPDiffer);

  CalculatePriceMargin(ABillsID);
  if ABillsID = iPriceMarginID then
    CalculateGather(ABillsID);

  TPhaseData(FPhaseData).PhasePayData.CalculateAll;
end;

procedure TStageData.CalculatePriceChange(ABillsID: Integer);
var
  Rec: TsdDataRecord;
  fQtyDiffer, fTPDiffer: Double;
begin
  Rec := sddStage.FindKey('idxBID', ABillsID);
  if GetCalcType(ABillsID) < 2 then
    Rec.ValueByName('PcTotalPrice').AsFloat :=
        TotalPriceRoundTo(Rec.ValueByName('PcQuantity').AsFloat * GetBillsPriceDiffer(ABillsID));

  fQtyDiffer := Rec.ValueByName('PcQuantity').AsFloat - FBeforeChangeQuantity;
  fTPDiffer := Rec.ValueByName('PcTotalPrice').AsFloat - FBeforeChangeTotalPrice;

  Rec.ValueByName('EndPcQuantity').AsFloat := QuantityRoundTo(
    Rec.ValueByName('EndPcQuantity').AsFloat + fQtyDiffer);
  Rec.ValueByName('EndPcTotalPrice').AsFloat := TotalPriceRoundTo(
    Rec.ValueByName('EndPcTotalPrice').AsFloat + fTPDiffer);

  UpdateParentRecord(ABillsID, fTPDiffer, 'PcTotalPrice');
  UpdateComplete(ABillsID, 0, fTPDiffer);
  if TPhaseData(FPhaseData).IsLastStage then
    with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do
      UpdateRecordPc(ABillsID, fQtyDiffer, fTPDiffer);
  TPhaseData(FPhaseData).PhasePayData.CalculateAll;
end;

procedure TStageData.CalculateQuantityChange(ABillsID: Integer);
var
  Rec: TsdDataRecord;
  fQtyDiffer, fTPDiffer: Double;
begin
  Rec := sddStage.FindKey('idxBID', ABillsID);
  if GetCalcType(ABillsID) = 0 then
    Rec.ValueByName('QcTotalPrice').AsFloat :=
        TotalPriceRoundTo(Rec.ValueByName('QcQuantity').AsFloat * GetBillsPrice(ABillsID));

  fQtyDiffer := Rec.ValueByName('QcQuantity').AsFloat - FBeforeChangeQuantity;
  fTPDiffer := Rec.ValueByName('QcTotalPrice').AsFloat - FBeforeChangeTotalPrice;

  Rec.ValueByName('EndQcQuantity').AsFloat := QuantityRoundTo(
      Rec.ValueByName('EndQcQuantity').AsFloat + fQtyDiffer);
  Rec.ValueByName('EndQcTotalPrice').AsFloat := TotalPriceRoundTo(
      Rec.ValueByName('EndQcTotalPrice').AsFloat + fTPDiffer);

  UpdateParentRecord(ABillsID, fTPDiffer, 'QcTotalPrice');
  UpdateComplete(ABillsID, fQtyDiffer, fTPDiffer);
  if TPhaseData(FPhaseData).IsLastStage then
    with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do
      UpdateRecordQc(ABillsID, fQtyDiffer, fTPDiffer);

  CalculatePriceMargin(ABillsID);
  if ABillsID = iPriceMarginID then
    CalculateGather(ABillsID);

  TPhaseData(FPhaseData).PhasePayData.CalculateAll;
end;

constructor TStageData.Create(APhaseData: TObject);
begin
  inherited Create(nil);
  FPhaseData := APhaseData;
end;

procedure TStageData.DeletePhaseRecord(ABillsID: Integer);
var
  Rec: TsdDataRecord;
begin
  Rec := sddStage.FindKey('idxBID', ABillsID);
  if Assigned(Rec) then
    sddStage.Remove(Rec);
end;

destructor TStageData.Destroy;
begin
  inherited;
end;

function TStageData.GetBillsNewPrice(ABillsID: Integer): Double;
begin
  Result := MainBillsTree.FindNode(ABillsID).Rec.ValueByName('NewPrice').AsFloat;
end;

function TStageData.GetBillsPrice(ABillsID: Integer): Double;
begin
  Result := MainBillsTree.FindNode(ABillsID).Rec.ValueByName('Price').AsFloat;
end;

procedure TStageData.Open(AConnection: TADOConnection);
begin
  sdpStage.Connection := AConnection;
  sddStage.Open;
  if not Assigned(sddStage.IndexList.FindByName('idxBID')) then
    sddStage.AddIndex('idxBID', 'BillsID');

  sddStage.FieldByName('DealQuantity').ValidChars := sddStage.FieldByName('DealQuantity').ValidChars + ArithmeticCharSet;
  sddStage.FieldByName('DealTotalPrice').ValidChars := sddStage.FieldByName('DealQuantity').ValidChars;
end;

function TStageData.StageRecord(ABillsID: Integer): TStageRecord;
begin
  Result := nil;
  if Assigned(sddStage.IndexList.FindByName('idxBID')) then
    Result := TStageRecord(sddStage.FindKey('idxBID', ABillsID));
end;

procedure TStageData.ReCalculate(ABillsID: Integer);
var
  Rec: TsdDataRecord;
  fDiffer: Double;
begin
  Rec := sddStage.FindKey('idxBID', ABillsID);
  if not Assigned(Rec) then Exit;

  if Rec.ValueByName('DealFlag').AsInteger = 1 then
    Rec.ValueByName('DealQuantity').AsFloat := QuantityRoundTo(
        EvaluateExprs(Rec.ValueByName('DealFormula').AsString));
  if Rec.ValueByName('DealFlag').AsInteger < 2 then
  begin
    fDiffer := Rec.ValueByName('DealQuantity').AsFloat * GetBillsPrice(ABillsID)
        - Rec.ValueByName('DealTotalPrice').AsFloat;
    Rec.ValueByName('DealTotalPrice').AsFloat := TotalPriceRoundTo(
        Rec.ValueByName('DealQuantity').AsFloat * GetBillsPrice(ABillsID));
  end;
  Rec.ValueByName('EndDealQuantity').AsFloat := QuantityRoundTo(
      Rec.ValueByName('PreDealQuantity').AsFloat + Rec.ValueByName('DealQuantity').AsFloat);
  Rec.ValueByName('EndDealTotalPrice').AsFloat := TotalPriceRoundTo(
      Rec.ValueByName('PreDealTotalPrice').AsFloat + Rec.ValueByName('DealTotalPrice').AsFloat);

  if Rec.ValueByName('QcFlag').AsInteger = 1 then
    Rec.ValueByName('QcQuantity').AsFloat := QuantityRoundTo(
        EvaluateExprs(Rec.ValueByName('QcFormula').AsString));
  if Rec.ValueByName('QcFlag').AsInteger < 2 then
  begin
    fDiffer := Rec.ValueByName('QcQuantity').AsFloat * GetBillsPrice(ABillsID)
        - Rec.ValueByName('QcTotalPrice').AsFloat;
    Rec.ValueByName('QcTotalPrice').AsFloat := TotalPriceRoundTo(
        Rec.ValueByName('QcQuantity').AsFloat * GetBillsPrice(ABillsID));
  end;
  Rec.ValueByName('EndQcQuantity').AsFloat := QuantityRoundTo(
      Rec.ValueByName('PreQcQuantity').AsFloat + Rec.ValueByName('QcQuantity').AsFloat);
  Rec.ValueByName('EndQcTotalPrice').AsFloat := TotalPriceRoundTo(
      Rec.ValueByName('PreQcTotalPrice').AsFloat + Rec.ValueByName('QcTotalPrice').AsFloat);

  if Rec.ValueByName('PcFlag').AsInteger = 1 then
    Rec.ValueByName('PcQuantity').AsFloat := QuantityRoundTo(
        EvaluateExprs(Rec.ValueByName('PcFormula').AsString));
  if Rec.ValueByName('DealFlag').AsInteger < 2 then
  begin
    fDiffer := Rec.ValueByName('PcQuantity').AsFloat * GetBillsNewPrice(ABillsID)
        - Rec.ValueByName('PcTotalPrice').AsFloat;
    Rec.ValueByName('PcTotalPrice').AsFloat := TotalPriceRoundTo(
        Rec.ValueByName('PcQuantity').AsFloat * GetBillsNewPrice(ABillsID));
  end;
  Rec.ValueByName('EndPcQuantity').AsFloat := QuantityRoundTo(
      Rec.ValueByName('PrePcQuantity').AsFloat + Rec.ValueByName('PcQuantity').AsFloat);
  Rec.ValueByName('EndPcTotalPrice').AsFloat := TotalPriceRoundTo(
      Rec.ValueByName('PrePcTotalPrice').AsFloat + Rec.ValueByName('PcTotalPrice').AsFloat);
end;

procedure TStageData.Save;
begin
  sddStage.Save;
end;

procedure TStageData.sddStageAfterValueChanged(AValue: TsdValue);

  function LeafCurHasMeasure(ANode: TMeasureBillsIDTreeNode): Boolean;
  begin
    Result := Assigned(ANode.StageRec) and
       ((ANode.StageRec.DealQuantity.AsFloat <> 0) or
        (ANode.StageRec.DealTotalPrice.AsFloat <> 0) or
        (ANode.StageRec.QcQuantity.AsFloat <> 0) or
        (ANode.StageRec.QcTotalPrice.AsFloat <> 0) or
        (ANode.StageRec.PcQuantity.AsFloat <> 0) or
        (ANode.StageRec.PcTotalPrice.AsFloat <> 0));
  end;

  function ParentCurHasMeasure(ANode: TBillsIDTreeNode): Boolean;
  var
    i: Integer;
    vChild: TBillsIDTreeNode;
  begin
    Result := False;
    for i := 0 to ANode.ChildCount - 1 do
    begin
      vChild := TMeasureBillsIDTreeNode(ANode.ChildNodes[i]);
      if vChild.Rec.CurHasMeasure.AsBoolean then
      begin
        Result := True;
        Break;
      end;
    end;
  end;

  procedure RecalcNodeCurHasMeasure(ANode: TBillsIDTreeNode);
  begin
    if not Assigned(ANode) then Exit;
    if ANode.HasChildren then
      ANode.Rec.CurHasMeasure.AsBoolean := ParentCurHasMeasure(ANode)
    else
      ANode.Rec.CurHasMeasure.AsBoolean := LeafCurHasMeasure(TMeasureBillsIDTreeNode(ANode));
    RecalcNodeCurHasMeasure(TBillsIDTreeNode(ANode.Parent));
  end;

var
  iBillsID: Integer;
  stnNode: TsdIDTreeNode;
begin
  iBillsID := AValue.Owner.ValueByName('BillsID').AsInteger;
  stnNode := MainBillsTree.FindNode(iBillsID);
  if not Assigned(stnNode) or stnNode.HasChildren then Exit;

  if (AValue.FieldName = 'DealQuantity') or
     (AValue.FieldName = 'DealFormula') or
     (AValue.FieldName = 'DealTotalPrice') then
    CalculateDeal(iBillsID);
  if (AValue.FieldName = 'QcQuantity') or
     (AValue.FieldName = 'QcFormula') or
     (AValue.FieldName = 'QcTotalPrice') then
    CalculateQuantityChange(iBillsID);
  if (AValue.FieldName = 'PcQuantity') or
     (AValue.FieldName = 'PcFormula') or
     (AValue.FieldName = 'PcTotalPrice') then
    CalculatePriceChange(iBillsID);

  if (AValue.FieldName = 'DealQuantity') or
     (AValue.FieldName = 'QcQuantity') then
    UpdateProjectGL(iBillsID);

  RecalcNodeCurHasMeasure(TBillsIDTreeNode(stnNode));
end;

function TStageData.GetMainBillsTree: TBillsIDTree;
begin
  with TProjectData(TPhaseData(FPhaseData).ProjectData) do
    Result := BillsMeasureData.BillsMeasureTree;
end;

procedure TStageData.sddStageBeforeValueChange(AValue: TsdValue;
  const NewValue: Variant; var Allow: Boolean);

  procedure SetBeforeChangeValue(const AType: string);
  begin
    if SameText(AValue.FieldName, AType + 'Quantity') or
       SameText(AValue.FieldName, AType + 'Formula') or
       SameText(AValue.FieldName, AType + 'TotalPrice') then
    begin
      FBeforeChangeQuantity := AValue.Owner.ValueByName(AType + 'Quantity').AsFloat;
      FBeforeChangeTotalPrice := AValue.Owner.ValueByName(AType + 'TotalPrice').AsFloat;
    end;
  end;

  procedure CheckOverRange;
  var
    vNode: TsdIDTreeNode;
    fAvailableQty: Double;
  begin
    if SameText(AValue.FieldName, 'DealQuantity') then
    begin
      vNode := MainBillsTree.FindNode(AValue.Owner.ValueByName('BillsID').AsInteger);
      fAvailableQty := vNode.Rec.ValueByName('Quantity').AsFloat
          - vNode.Rec.ValueByName('AddDealQuantity').AsFloat + AValue.AsFloat;
      if VarToFloatDef(NewValue, 0) > fAvailableQty then
        DataSetErrorMessage(Allow, '不可超过0号台账合同数量！');
    end;
  end;
  
begin
  // 不检查超计
  //CheckOverRange;
  SetBeforeChangeValue('Deal');
  SetBeforeChangeValue('Qc');
  SetBeforeChangeValue('Pc');
end;

procedure TStageData.AfterBatchOperation;
begin
  sddStage.EndUpdate;
  sddStage.BeforeValueChange := sddStageBeforeValueChange;
  sddStage.AfterValueChanged := sddStageAfterValueChanged;
end;

procedure TStageData.BeforeBatchOperation;
begin
  sddStage.BeginUpdate;
  sddStage.BeforeValueChange := nil;
  sddStage.AfterValueChanged := nil;
end;

function TStageData.GetBillsPriceDiffer(ABillsID: Integer): Double;
begin
  with MainBillsTree.FindNode(ABillsID).Rec do
    Result := ValueByName('NewPrice').AsFloat - ValueByName('Price').AsFloat;
end;

procedure TStageData.UpdateComplete(ABillsID: Integer; AQuantity,
  ATotalPrice: Double);
var
  Rec: TStageRecord;
begin
  if ABillsID = -1 then Exit;
  Rec := StageRecord(ABillsID);
  Rec.GatherQuantity.AsFloat := QuantityRoundTo(Rec.GatherQuantity.AsFloat + AQuantity);
  Rec.GatherTotalPrice.AsFloat := TotalPriceRoundTo(Rec.GatherTotalPrice.AsFloat + ATotalPrice);
  Rec.EndGatherQuantity.AsFloat := QuantityRoundTo(Rec.EndGatherQuantity.AsFloat + AQuantity);
  Rec.EndGatherTotalPrice.AsFloat := TotalPriceRoundTo(Rec.EndGatherTotalPrice.AsFloat + ATotalPrice);
  // 数量不向上汇总
  UpdateParentRecord(ABillsID, ATotalPrice, 'GatherTotalPrice');
end;

procedure TStageData.UpdateParentRecord(ABillsID: Integer;
  ATotalPrice: Double; const AFieldName: string);
var
  vNode: TMeasureBillsIDTreeNode;
  iParentID: Integer;
  Rec: TsdDataRecord;
begin
  iParentID := MainBillsTree.FindNode(ABillsID).ParentID;
  if iParentID = -1 then Exit;
  vNode := TMeasureBillsIDTreeNode(MainBillsTree.FindNode(iParentID));
  Rec := StageRecordWithAdd(iParentID);
  vNode.StageRec := TStageRecord(Rec);
  Rec.ValueByName(AFieldName).AsFloat := TotalPriceRoundTo(
      Rec.ValueByName(AFieldName).AsFloat + ATotalPrice);
  Rec.ValueByName('End' + AFieldName).AsFloat := TotalPriceRoundTo(
      Rec.ValueByName('End' + AFieldName).AsFloat + ATotalPrice);
  UpdateParentRecord(iParentID, ATotalPrice, AFieldName);
end;

function TStageData.GetBuildLoadInterest(AType, AIndex: Integer): Double;
begin
  Result := GetTotalPrice(34, AType, AIndex);
end;

function TStageData.GetFirstPart(AType, AIndex: Integer): Double;
begin
  Result := GetTotalPrice(1, AType, AIndex);
end;

function TStageData.GetOtherFee(AType, AIndex: Integer): Double;
begin
  Result := GetTotalPrice(15, AType, AIndex);
end;

function TStageData.GetOtherProjectFee(AType, AIndex: Integer): Double;
begin
  Result := GetTotalPrice(9, AType, AIndex);
end;

function TStageData.GetRecyclingFee(AType, AIndex: Integer): Double;
begin
  Result := GetTotalPrice(16, AType, AIndex);
end;

function TStageData.GetReservedFee(AType, AIndex: Integer): Double;
begin
  Result := GetTotalPrice(7, AType, AIndex);
end;

function TStageData.GetSecondPart(AType, AIndex: Integer): Double;
begin
  Result := GetTotalPrice(2, AType, AIndex);
end;

function TStageData.GetStageSettlement(AType, AIndex: Integer): Double;
begin
  // 全国
  // 第一部分+第二部分+第三部分+预备费+新增加费用项目(其他费用_广东)-回收金额
  Result := FirstPart[AType, AIndex] + SecondPart[AType, AIndex] + ThirdPart[AType, AIndex]
         + ReservedFee[AType, AIndex] + OtherFee[AType, AIndex] - RecyclingFee[AType, AIndex];
  // 广东
  // 全国的基础上+建设期贷款利息+公路功能以外的项目
  if _IsGuangDong then
    Result := Result + BuildLoadInterest[AType, AIndex] + OtherProjectFee[AType, AIndex]
end;

function TStageData.GetThirdPart(AType, AIndex: Integer): Double;
begin
  Result := GetTotalPrice(3, AType, AIndex);
end;

function TStageData.GetTotalPrice(ABillsID, AType, AStageIndex: Integer): Double;
var
  Rec: TsdDataRecord;
  sFieldName: string;
begin
  Result := 0;
  Rec := StageRecord(ABillsID);
  if not Assigned(Rec) then Exit;
  case AType of
    1: sFieldName := '';
    2: sFieldName := 'End';
    3: sFieldName := 'Pre';
  end;
  case AStageIndex of
    1: sFieldName := sFieldName + 'DealTotalPrice';
    2: sFieldName := sFieldName + 'QcTotalPrice';
    3: sFieldName := sFieldName + 'PcTotalPrice';
    4: sFieldName := sFieldName + 'GatherTotalPrice';
  end;
  Result := Rec.ValueByName(sFieldName).AsFloat;
end;

procedure TStageData.CopyPrePhaseData(const APreFile, APreTable: string);
const
  sCopySql = 'Insert Into %s (' +
             '    BillsID, ' +
             '    PreDealQuantity, PreDealTotalPrice, ' +
             '    PreQcQuantity, PreQcTotalPrice, PreQcBGLCode, PreQcBGLNum, ' +
             '    PrePcQuantity, PrePcTotalPrice, PrePcBGLCode, PrePcBGLNum, ' +
             '    PreGatherQuantity, PreGatherTotalPrice, ' +
             '    EndDealQuantity, EndDealTotalPrice, ' +
             '    EndQcQuantity, EndQcTotalPrice, EndQcBGLCode, EndQcBGLNum, ' +
             '    EndPcQuantity, EndPcTotalPrice, EndPcBGLCode, EndPcBGLNum, ' +
             '    EndGatherQuantity, EndGatherTotalPrice ' +
             '  ) Select BillsID,' +
             '    EndDealQuantity, EndDealTotalPrice, ' +
             '    EndQcQuantity, EndQcTotalPrice, EndQcBGLCode, EndQcBGLNum, ' +
             '    EndPcQuantity, EndPcTotalPrice, EndPcBGLCode, EndPcBGLNum, ' +
             '    EndGatherQuantity, EndGatherTotalPrice, ' +
             '    EndDealQuantity, EndDealTotalPrice, ' +
             '    EndQcQuantity, EndQcTotalPrice, EndQcBGLCode, EndQcBGLNum, ' +
             '    EndPcQuantity, EndPcTotalPrice, EndPcBGLCode, EndPcBGLNum, ' +
             '    EndGatherQuantity, EndGatherTotalPrice ' +
             ' From %s' +
             ' In ''%s''';
var
  sPre, sSql: string;
begin
  try
    sSql := Format(sCopySql, [TableName, APreTable, APreFile]);
    ExecuteSql(TPhaseData(FPhaseData).ADOConnection, sSql);
  finally
    sddStage.Reload;
  end;
end;

procedure TStageData.UpdateBGLInfo(ARec: TsdDataRecord; const AType: string);
var
  sPreBGLCode, sPreBGLNum, sCurBGLCode, sCurBGLNum: string;
begin
  sPreBGLCode := ARec.ValueByName('Pre' + AType + 'BGLCode').AsString;
  sPreBGLNum := ARec.ValueByName('Pre' + AType + 'BGLNum').AsString;
  sCurBGLCode := ARec.ValueByName(AType + 'BGLCode').AsString;
  sCurBGLNum := ARec.ValueByName(AType + 'BGLNum').AsString;
  MergeRelaBGLAndNum(sPreBGLCode, sPreBGLNum, sCurBGLCode, sCurBGLNum);
  ARec.ValueByName('End' + AType + 'BGLCode').AsString := sPreBGLCode;
  ARec.ValueByName('End' + AType + 'BGLNum').AsString := sPreBGLNum;
end;

procedure TStageData.CalculateAll;
begin
  BeforeBatchOperation;
  CalculateNode(MainBillsTree.FirstNode);
  AfterBatchOperation;
end;

procedure TStageData.CalculateNode(ANode: TsdIDTreeNode);

  function IsSpecialNode: Boolean;
  begin
    //Result := ANode.ID = iPriceMarginID;
    Result := False;
  end;

begin
  if not Assigned(ANode) then Exit;
  if ANode.HasChildren then
  begin
    CalculateNode(ANode.FirstChild);
    CalculateParent(TMeasureBillsIDTreeNode(ANode));
  end
  else
  begin
    if IsSpecialNode then
      CalculateSpecialLeaf(TMeasureBillsIDTreeNode(ANode))
    else
      CalculateLeaf(TMeasureBillsIDTreeNode(ANode));
  end;
  CalculateNode(ANode.NextSibling);
end;

procedure TStageData.CalculateParent(ANode: TMeasureBillsIDTreeNode);
var
  iChild: Integer;
  ChildNode: TMeasureBillsIDTreeNode;
  fDeal, fQc, fPc, fTotal, fPM: Double;
begin
  if not Assigned(ANode.StageRec) then
    ANode.StageRec := AddStageRecord(ANode.ID);

  fDeal := 0;
  fQc := 0;
  fPc := 0;
  fPM := 0;
  for iChild := 0 to ANode.ChildCount - 1 do
  begin
    ChildNode := TMeasureBillsIDTreeNode(ANode.ChildNodes[iChild]);
    if not Assigned(ChildNode.StageRec) then Continue;
    fDeal := TotalPriceRoundTo(fDeal + ChildNode.StageRec.DealTotalPrice.AsFloat);
    fQc := TotalPriceRoundTo(fQc + ChildNode.StageRec.QcTotalPrice.AsFloat);
    fPc := TotalPriceRoundTo(fPc + ChildNode.StageRec.PcTotalPrice.AsFloat);
    fPM := TotalPriceRoundTo(fPM + ChildNode.StageRec.PM_TotalPrice.AsFloat);
  end;                                                                      
  fTotal := TotalPriceRoundTo(fDeal + fQc + fPc);

  with ANode.StageRec do
  begin
    if DealTotalPrice.AsFloat <> fDeal then
    begin
      DealTotalPrice.AsFloat := fDeal;
      EndDealTotalPrice.AsFloat := TotalPriceRoundTo(PreDealTotalPrice.AsFloat + fDeal);
    end;

    if QcTotalPrice.AsFloat <> fQc then
    begin
      QcTotalPrice.AsFloat := fQc;
      EndQcTotalPrice.AsFloat := TotalPriceRoundTo(PreQcTotalPrice.AsFloat + fQc);
    end;

    if PcTotalPrice.AsFloat <> fPc then
    begin
      PcTotalPrice.AsFloat := fPc;
      EndPcTotalPrice.AsFloat := TotalPriceRoundTo(PrePcTotalPrice.AsFloat + fPc);
    end;

    if GatherTotalPrice.AsFloat <> fTotal then
    begin
      GatherTotalPrice.AsFloat := fTotal;
      EndGatherTotalPrice.AsFloat := TotalPriceRoundTo(PreGatherTotalPrice.AsFloat + fTotal);
    end;
    
    if PM_TotalPrice.AsFloat <> fPM then
      PM_TotalPrice.AsFloat := fPM;
  end;
end;

procedure TStageData.CalculateLeaf(ANode: TMeasureBillsIDTreeNode);

  procedure CalculateMeasure(ARec: TsdDataRecord; const AType: string);
  begin
    if GetCalcType(ANode.ID) = 0 then
    begin
      if ARec.ValueByName(AType + 'Formula').AsString <> '' then
        ARec.ValueByName(AType + 'Quantity').AsFloat := QuantityRoundTo(
            EvaluateExprs(ARec.ValueByName(AType + 'Formula').AsString));
      ARec.ValueByName(AType + 'TotalPrice').AsFloat := TotalPriceRoundTo(
          ARec.ValueByName(AType + 'Quantity').AsFloat * GetBillsPrice(ANode.ID));
    end;
    ARec.ValueByName('End' + AType + 'Quantity').AsFloat := QuantityRoundTo(
        ARec.ValueByName('Pre' + AType + 'Quantity').AsFloat + ARec.ValueByName(AType + 'Quantity').AsFloat);
    ARec.ValueByName('End' + AType + 'TotalPrice').AsFloat := TotalPriceRoundTo(
        ARec.ValueByName('Pre' + AType + 'TotalPrice').AsFloat + ARec.ValueByName(AType + 'TotalPrice').AsFloat);
  end;

  procedure CalculatePriceMargin(ARec: TStageRecord);
  var
    fPrice: Double;
  begin
    fPrice := GetBillsUnitPriceMargin(ARec.BillsID.AsInteger);
    ARec.SetFloatValue(ARec.PM_TotalPrice, TotalPriceRoundTo(ARec.GatherQuantity.AsFloat * fPrice));
  end;

var
  Rec: TStageRecord;
begin
  Rec := ANode.StageRec;
  if not Assigned(Rec) then Exit;
  CalculateMeasure(Rec, 'Deal');
  CalculateMeasure(Rec, 'Pc');
  CalculateMeasure(Rec, 'Qc');
  Rec.GatherQuantity.AsFloat := QuantityRoundTo(
      Rec.DealQuantity.AsFloat + Rec.QcQuantity.AsFloat);
  Rec.GatherTotalPrice.AsFloat := TotalPriceRoundTo(
      Rec.DealTotalPrice.AsFloat + Rec.QcTotalPrice.AsFloat + Rec.PcTotalPrice.AsFloat);
  Rec.EndGatherQuantity.AsFloat := QuantityRoundTo(
      Rec.PreGatherQuantity.AsFloat + Rec.GatherQuantity.AsFloat);
  Rec.EndGatherTotalPrice.AsFloat := TotalPriceRoundTo(
      Rec.PreGatherTotalPrice.AsFloat + Rec.GatherTotalPrice.AsFloat);
      
  CalculatePriceMargin(Rec);
end;

function TStageData.GetActive: Boolean;
begin
  Result := sddStage.Active;
end;

procedure TStageData.SetTableName(const Value: string);
begin
  sdpStage.TableName := Value;
end;

procedure TStageData.sddStageGetRecordClass(
  var ARecordClass: TsdRecordClass);
begin
  ARecordClass := TStageRecord;
end;

function TStageData.GetChapterStageGather(AChapter: Integer): Double;

  function CheckCodeChapter(const ACode: string): Boolean;
  var
    iFirst: Integer;
    sgs: TStrings;
  begin
    sgs := TStringList.Create;
    try
      sgs.Delimiter := '-';
      sgs.DelimitedText := ACode;
      if sgs.Count > 1 then
      begin
        iFirst := StrToIntDef(sgs[0], 0) div 100;
        Result := iFirst = AChapter;
      end
      else
        Result := False;
    finally
      sgs.Free;
    end;
  end;

var
  iIndex: Integer;
  Rec: TsdDataRecord;
  stnNode: TsdIDTreeNode;
begin
  Result := 0;
  for iIndex := 0 to sddStage.RecordCount - 1 do
  begin
    Rec := sddStage.Records[iIndex];
    stnNode := MainBillsTree.FindNode(Rec.ValueByName('BillsID').AsInteger);
    if not stnNode.HasChildren and CheckCodeChapter(stnNode.Rec.ValueByName('B_Code').AsString) then
      Result := Result + Rec.ValueByName('GatherTotalPrice').AsFloat;
  end;
end;

function TStageData.GetCalcType(ABillsID: Integer): Integer;
begin
  Result := MainBillsTree.FindNode(ABillsID).Rec.ValueByName('CalcType').AsInteger;
end;

procedure TStageData.CalculatePriceMarginNode;
var
  Rec: TStageRecord;
  fDiffer: Double;
begin
  if not HasPriceMarginBills then Exit;
   
  with TProjectData(TPhaseData(FPhaseData).ProjectData) do
  begin
    Rec := StageRecord(iPriceMarginID);
    if not Assigned(Rec) then
      Rec := AddStageRecord(iPriceMarginID);

    fDiffer := TotalPriceRoundTo(ProjectGLData.PM_TotalPrice - Rec.GatherTotalPrice.AsFloat);
    if fDiffer <> 0 then
    begin
      Rec.AddDifferValue(Rec.GatherTotalPrice, fDiffer);
      Rec.AddDifferValue(Rec.EndGatherTotalPrice, fDiffer);
      UpdateParentRecord(Rec.BillsID.AsInteger, fDiffer, 'GatherTotalPrice');
    end;
  end;
end;

function TStageData.GetBillsUnitPriceMargin(ABillsID: Integer): Double;
var
  vGLs: TList;
  iGL: Integer;
  GLRec: TDetailGLRecord;
begin
  Result := 0;
  vGLs := TList.Create;
  try
    with TProjectData(TPhaseData(FPhaseData).ProjectData).DetailGLData do
      LoadDetailGLs(ABillsID, vGLs);
    for iGL := 0 to vGLs.Count - 1 do
    begin
      GLRec := TDetailGLRecord(vGLs.Items[iGL]);
      Result := Result + GLRec.Quantity.AsFloat * GLRec.RelaProjectGL.ValidDeltaPrice.AsFloat;
    end;
  finally
    vGLs.Free;
  end;
end;

procedure TStageData.CalculatePriceMargin(ABillsID: Integer);
var
  Rec: TStageRecord;
  fPM, fPMDiffer: Double;
begin
  //if not HasPriceMarginBills then Exit;

  Rec := StageRecord(ABillsID);
  if not Assigned(Rec) then Exit;

  fPM := TotalPriceRoundTo(Rec.GatherQuantity.AsFloat * GetBillsUnitPriceMargin(ABillsID));
  if fPM <> Rec.PM_TotalPrice.AsFloat then
  begin
    fPMDiffer := fPM - Rec.PM_TotalPrice.AsFloat;
    Rec.PM_TotalPrice.AsFloat := fPM;
    UpdateParentPriceMargin(ABillsID, fPMDiffer);
    //UpdatePriceMarginNode(fPMDiffer);
    with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do
      UpdateRecordPM(ABillsID, fPMDiffer);
  end;
end;

procedure TStageData.UpdatePriceMarginNode(ADiffer: Double);
var
  Rec: TStageRecord;
begin
  Rec := StageRecordWithAdd(iPriceMarginID);
  Rec.AddDifferValue(Rec.GatherTotalPrice, ADiffer);
  Rec.AddDifferValue(Rec.EndGatherTotalPrice, ADiffer);
  UpdateParentRecord(iPriceMarginID, ADiffer, 'GatherTotalPrice');
  with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do
    UpdateGather(Rec.BillsID.AsInteger, ADiffer);
end;

procedure TStageData.UpdateParentPriceMargin(ABillsID: Integer; ADiffer: Double);
var
  iParentID: Integer;
  Rec: TStageRecord;
begin
  iParentID := MainBillsTree.FindNode(ABillsID).ParentID;
  if iParentID = -1 then Exit;

  Rec := StageRecordWithAdd(iParentID);
  Rec.PM_TotalPrice.AsFloat := TotalPriceRoundTo(Rec.PM_TotalPrice.AsFloat + ADiffer);
  UpdateParentPriceMargin(iParentID, ADiffer);
end;

function TStageData.StageRecordWithAdd(ABillsID: Integer): TStageRecord;
begin
  Result := StageRecord(ABillsID);
  if not Assigned(Result) then
    Result := AddStageRecord(ABillsID);
end;

procedure TStageData.UpdateProjectGL(ABillsID: Integer);
var
  vGLs: TList;
  iGL: Integer;
  GLRec: TDetailGLRecord;
begin
  vGLs := TList.Create;
  try
    with TProjectData(TPhaseData(FPhaseData).ProjectData) do
    begin
      DetailGLData.LoadDetailGLs(ABillsID, vGLs);
      ProjectGLData.CalculateGLs_PM(vGLs);
      ProjectGLData.RefreshGatherData;
    end;
  finally
    vGLs.Free;
  end;
end;

procedure TStageData.CalculateSpecialLeaf(ANode: TMeasureBillsIDTreeNode);

  procedure GatherPriceMargin(ARec: TStageRecord);
  begin
    with TProjectData(TPhaseData(FPhaseData).ProjectData).ProjectGLData do
        ARec.SetFloatValue(ARec.GatherTotalPrice, PM_TotalPrice);
    ARec.SetFloatValue(ARec.EndGatherTotalPrice,
        ARec.PreGatherTotalPrice.AsFloat + ARec.GatherTotalPrice.AsFloat);
  end;

var
  StageRec: TStageRecord;
begin
  StageRec := ANode.StageRec;
  if not Assigned(StageRec) then Exit;

  case ANode.ID of
    iPriceMarginID: GatherPriceMargin(StageRec);
  end;
end;

function TStageData.HasPriceMarginBills: Boolean;
var
  vPM_Node: TsdIDTreeNode;
begin
  vPM_Node := MainBillsTree.FindNode(iPriceMarginID);
  Result := Assigned(vPM_Node);
end;

procedure TStageData.CalculateGather(ABillsID: Integer);
var
  Rec: TStageRecord;
  fQuantity, fTotalPrice: Double;
begin
  Rec := TStageRecord(sddStage.FindKey('idxBID', ABillsID));
  if not Assigned(Rec) then Exit;
  fQuantity := QuantityRoundTo(Rec.DealQuantity.AsFloat + Rec.QcQuantity.AsFloat) - Rec.GatherQuantity.AsFloat;
  fTotalPrice := TotalPriceRoundTo(
      Rec.DealTotalPrice.AsFloat + Rec.QcTotalPrice.AsFloat + Rec.PcTotalPrice.AsFloat) - Rec.GatherTotalPrice.AsFloat;
  UpdateComplete(ABillsID, fQuantity, fTotalPrice);
end;

function TStageData.GetPriceMargin(AType, AIndex: Integer): Double;
begin
  Result := GetTotalPrice(iPriceMarginID, AType, AIndex);
end;

function TStageData.GetTableName: string;
begin
  Result := sdpStage.TableName;
end;

end.