Measure/DataModules/BillsMeasureDm.pas

unit BillsMeasureDm;

interface

uses
  BillsDm, BillsTree, FormulaCalc, sdIDTree, StageDm,
  SysUtils, Classes, sdDB, DB;

type
  TBillsMeasureData = class(TDataModule)
    sdvBillsMeasure: TsdDataView;
    procedure sdvBillsMeasureAfterOpen(Sender: TObject);
    procedure sdvBillsMeasureAfterAddRecord(ARecord: TsdDataRecord);
    procedure sdvBillsMeasureGetText(var Text: String;
      ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
      DisplayText: Boolean);
    procedure sdvBillsMeasureSetText(var Text: String;
      ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
      var Allow: Boolean);
    procedure sdvBillsMeasureNeedLookupRecord(ARecord: TsdDataRecord;
      AColumn: TsdViewColumn; ANewText: String);
    procedure sdvBillsMeasureAfterClose(Sender: TObject);
    procedure sdvBillsMeasureAfterValueChanged(AValue: TsdValue);
    procedure sdvBillsMeasureCurrentChanged(ARecord: TsdDataRecord);
  private
    FProjectData: TObject;
    FBillsData: TBillsData;
    FBillsMeasureTree: TMeasureBillsIDTree;

    FFormulaCalc: TFormulaCalc;
    FShowParentData: Boolean;
    FOnRecChange: TRecChangeEvent;

    function OnGetCardinalNum(const ACardinalNum: string): Double;

    procedure CalcAddCompleteRate(ANode: TsdIDTreeNode);
    procedure CalcAddDgnPrice(ANode: TsdIDTreeNode);

    function SelectAndUpdateBGL(ABillsID: Integer; ARec: TsdDataRecord;
      ANewValue: Double; const AType: string): Boolean;

    procedure CalculateNode(ANode: TMeasureBillsIDTreeNode);
    procedure UpdateRecordGather(ANode: TsdIDTreeNode; AQuantity, ATotalPrice: Double);

    function GetStageData: TStageData;
    procedure SetOnRecChange(const Value: TRecChangeEvent);
  public
    constructor Create(AProjectData: TObject);
    destructor Destroy; override;

    procedure Open;
    procedure Close;
    procedure ReConnectTree;

    procedure CalculateAll;

    procedure ResetPhaseStageLink;
    procedure ResetTreeNodeStageRec;

    procedure ExpandNodeTo(ALevel: Integer);
    procedure ExpandXmjNode;
    procedure ExpandCurPhase;

    function GatherRelaBGL(ANode: TsdIDTreeNode): string;

    // 计算 修改各期原报审核数据时，需对累计数据做增量
    procedure UpdateRecordDeal(ABillsID: Integer; AQuantity, ATotalPrice: Double);
    procedure UpdateRecordQc(ABillsID: Integer; AQuantity, ATotalPrice: Double);
    procedure UpdateRecordPc(ABillsID: Integer; AQuantity, ATotalPrice: Double);
    procedure UpdateRecordPM(ABillsID: Integer; ADiffer: Double);
    procedure UpdateGather(ABillsID: Integer; ADiffer: Double);
    procedure UpdateBGLInfo(ABillsID: Integer; ARec: TsdDataRecord; const AType: string);

    property ProjectData: TObject read FProjectData;
    property BillsData: TBillsData read FBillsData;
    property BillsMeasureTree: TMeasureBillsIDTree read FBillsMeasureTree;

    property StageData: TStageData read GetStageData;
    property ShowParentData: Boolean read FShowParentData write FShowParentData;
    property OnRecChange: TRecChangeEvent read FOnRecChange write SetOnRecChange;
  end;

implementation

uses
  ProjectData, PhaseData, Math, ZhAPI, BillsCommand, BGLSelectFrm,
  BGLDm, UtilMethods, mDataRecord, ConstUnit;

{$R *.dfm}

{ TBillsMeasureData }

constructor TBillsMeasureData.Create(AProjectData: TObject);
begin
  inherited Create(nil);
  FProjectData := AProjectData;
  FBillsData := TProjectData(FProjectData).BillsData;
  FBillsMeasureTree := TMeasureBillsIDTree.Create;
  FBillsMeasureTree.KeyFieldName := 'ID';
  FBillsMeasureTree.ParentFieldName := 'ParentID';
  FBillsMeasureTree.NextSiblingFieldName := 'NextSiblingID';
  FBillsMeasureTree.AutoCreateKeyID := True;
  FBillsMeasureTree.AutoExpand := True;
  FBillsMeasureTree.DataView := sdvBillsMeasure;
  FBillsMeasureTree.SeedID := Max(FBillsMeasureTree.SeedID, 100);
  FBillsMeasureTree.Link(TProjectData(FProjectData).BillsCompileData.BillsCompileTree, True);
  FBillsMeasureTree.CompileTree := TProjectData(FProjectData).BillsCompileData.BillsCompileTree;

  FFormulaCalc := TFormulaCalc.Create(FBillsMeasureTree);
  FFormulaCalc.OnGetValue := OnGetCardinalNum;
end;

destructor TBillsMeasureData.Destroy;
begin   
  FFormulaCalc.Free;
  FBillsMeasureTree.Free;
  inherited;
end;

procedure TBillsMeasureData.Open;
begin
  sdvBillsMeasure.DataSet := TProjectData(FProjectData).BillsData.sddBills;
  sdvBillsMeasure.Open;
end;

procedure TBillsMeasureData.ReConnectTree;
begin
  FBillsMeasureTree.DataView := nil;
  FBillsMeasureTree.DataView := sdvBillsMeasure;
  FBillsMeasureTree.Link(TProjectData(FProjectData).BillsCompileData.BillsCompileTree, True);  
end;

procedure TBillsMeasureData.ResetPhaseStageLink;
begin
  with TProjectData(FProjectData).PhaseData do
  begin
    sdvBillsMeasure.Columns.FindColumn('CurDealQuantity').LookupDataSet := StageData.sddStage;
    sdvBillsMeasure.Columns.FindColumn('CurDealTotalPrice').LookupDataSet := StageData.sddStage;
    sdvBillsMeasure.Columns.FindColumn('CurQcQuantity').LookupDataSet := StageData.sddStage;
    sdvBillsMeasure.Columns.FindColumn('CurQcTotalPrice').LookupDataSet := StageData.sddStage;
    sdvBillsMeasure.Columns.FindColumn('CurQcBGLCode').LookupDataSet := StageData.sddStage;
    sdvBillsMeasure.Columns.FindColumn('CurPcQuantity').LookupDataSet := StageData.sddStage;
    sdvBillsMeasure.Columns.FindColumn('CurPcTotalPrice').LookupDataSet := StageData.sddStage;
    sdvBillsMeasure.Columns.FindColumn('CurPcBGLCode').LookupDataSet := StageData.sddStage;
    sdvBillsMeasure.Columns.FindColumn('CurGatherQuantity').LookupDataSet := StageData.sddStage;
    sdvBillsMeasure.Columns.FindColumn('CurGatherTotalPrice').LookupDataSet := StageData.sddStage;
    sdvBillsMeasure.Columns.FindColumn('EndDealQuantity').LookupDataSet := StageData.sddStage;
    sdvBillsMeasure.Columns.FindColumn('EndDealTotalPrice').LookupDataSet := StageData.sddStage;
    sdvBillsMeasure.Columns.FindColumn('EndQcQuantity').LookupDataSet := StageData.sddStage;
    sdvBillsMeasure.Columns.FindColumn('EndQcTotalPrice').LookupDataSet := StageData.sddStage;
    sdvBillsMeasure.Columns.FindColumn('EndPcQuantity').LookupDataSet := StageData.sddStage;
    sdvBillsMeasure.Columns.FindColumn('EndPcTotalPrice').LookupDataSet := StageData.sddStage;
    sdvBillsMeasure.Columns.FindColumn('EndGatherQuantity').LookupDataSet := StageData.sddStage;
    sdvBillsMeasure.Columns.FindColumn('EndGatherTotalPrice').LookupDataSet := StageData.sddStage;

    sdvBillsMeasure.Columns.FindColumn('PM_PreTotalPrice').LookupDataSet := StageData.sddStage;
    sdvBillsMeasure.Columns.FindColumn('PM_TotalPrice').LookupDataSet := StageData.sddStage;
  end;
end;

procedure TBillsMeasureData.sdvBillsMeasureAfterOpen(Sender: TObject);
begin
  FBillsMeasureTree.Active := True;
end;

procedure TBillsMeasureData.sdvBillsMeasureAfterAddRecord(
  ARecord: TsdDataRecord);
begin
  ARecord.ValueByName('IsMeasureAdd').AsBoolean := True;
end;

procedure TBillsMeasureData.sdvBillsMeasureGetText(var Text: String;
  ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  DisplayText: Boolean);

  function GetQuantityValueOrFormula(const AQtyType: string): string;
  begin
    with AValue.Owner do
    begin
      if ValueByName(AQtyType + 'Flag').AsInteger = 1 then
        Result := ValueByName(AQtyType + 'Formula').AsString
      else
        Result := Text;
    end;
  end;

  function GetTotalPriceValueOrFormula(const AQtyType: string): string;
  begin
    with AValue.Owner do
    begin
      if ValueByName(AQtyType + 'Formula').AsString <> '' then
        Result := ValueByName(AQtyType + 'Formula').AsString
      else
        Result := Text;
    end;
  end;

  procedure GetDisplayText(var AText: string; AValue: TsdValue;
    AColumn: TsdViewColumn);
  var
    stnNode: TsdIDTreeNode;
  begin
    if Assigned(AValue) and (AValue.DataType = ftFloat) and (AValue.AsFloat = 0) then
    begin
      Text := '';
      Exit;
    end;

    // 所有本期数据，当节点为父节点时，不显示值（实际上需要计算其中的金额值，但又不能显示）
    // 有病。每天都在变。
    if not ShowParentData and (Pos('Cur', AColumn.FieldName) > 0) and (Pos('Gather', AColumn.FieldName) = 0) then
    begin
      stnNode := BillsMeasureTree.FindNode(AValue.Owner.ValueByName('BillsID').AsInteger);
      if stnNode.HasChildren then
        Text := '';
    end;
  end;

  procedure GetEditText(var AText: string; AValue: TsdValue;
    AColumn: TsdViewColumn);
  begin
    if SameText(AColumn.FieldName, 'Quantity') then
      Text := GetQuantityValueOrFormula('Qty')
    else if SameText(AColumn.FieldName, 'CurDealQuantity') then
      Text := GetQuantityValueOrFormula('Deal')
    else if SameText(AColumn.FieldName, 'CurQcQuantity') then
      Text := GetQuantityValueOrFormula('Qc')
    else if SameText(AColumn.FieldName, 'CurPcQuantity') then
      Text := GetQuantityValueOrFormula('Pc')
    else if SameText(AColumn.FieldName, 'CurDealTotalPrice') then
      Text := GetTotalPriceValueOrFormula('Deal')
    else if SameText(AColumn.FieldName, 'CurQcTotalPrice') then
      Text := GetTotalPriceValueOrFormula('Qc')
    else if SameText(AColumn.FieldName, 'CurPcTotalPrice') then
      Text := GetTotalPriceValueOrFormula('Pc');
  end;

var
  fPercent: Double;
begin
  if not Assigned(AValue) then Exit;

  if DisplayText then
    GetDisplayText(Text, AValue, AColumn)
  else
    GetEditText(Text, AValue, AColumn);
end;

procedure TBillsMeasureData.sdvBillsMeasureSetText(var Text: String;
  ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  var Allow: Boolean);

  function GetBillsID: Integer;
  begin
    if Pos('Cur', AColumn.FieldName) = 1 then
      Result := AValue.Owner.ValueByName('BillsID').AsInteger
    else
      Result := ARecord.ValueByName('ID').AsInteger;
  end;

  procedure CheckLockedData;
  begin
    if SameText(AColumn.FieldName, 'Code') or
       SameText(AColumn.FieldName, 'B_Code') or
       SameText(AColumn.FieldName, 'Name') or
       SameText(AColumn.FieldName, 'Units') or
       SameText(AColumn.FieldName, 'Price') then
       if ARecord.ValueByName('LockedInfo').AsBoolean then
         DataSetErrorMessage(Allow, '清单信息已被锁定，不允许修改编号、名称、单位、清单单价！');
    if not Allow then Exit;

    if SameText(AColumn.FieldName, 'NewPrice') then
      if ARecord.ValueByName('LockedNewPrice').AsBoolean then
        DataSetErrorMessage(Allow, '变更单价已被锁定，不允许修改！');
  end;

  procedure CheckNodeWritable;
  var
    vNode: TBillsIDTreeNode;
    iCreatePhase: Integer;
  begin
    vNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(GetBillsID));
    iCreatePhase := vNode.Rec.ValueByName('CreatePhaseID').AsInteger;

    if vNode.ID = iPriceMarginID then
      DataSetErrorMessage(Allow, sBills_PMHint);

    if SameText('B_Code', AColumn.FieldName) or
        SameText('Name', AColumn.FieldName) or
        SameText('Units', AColumn.FieldName) then
      if vNode.Rec.ValueByName('AddQcQuantity').AsFloat <> 0 then
        DataSetErrorMessage(Allow, '该清单已进行过变更，不可修改清单编号、名称、单位！');
    if not Allow then Exit;

    if SameText('Price', AColumn.FieldName) then
      if vNode.Rec.ValueByName('AddGatherTotalPrice').AsFloat <> 0 then
        DataSetErrorMessage(Allow, '该清单已经计量，不可修改清单单价！');
    if not Allow then Exit;

    if SameText('NewPrice', AColumn.FieldName) then
      if vNode.Rec.ValueByName('AddPcTotalPrice').AsFloat <> 0 then
        DataSetErrorMessage(Allow, '该清单已经计量，不可修改清单变更单价！');
    if not Allow then Exit;

    if vNode.HasChildren then
    begin
      if Text = '' then
        Exit
      else if ((Pos('Quantity', AColumn.FieldName) > 0) and (Pos('Dgn', AColumn.FieldName) <=0)) or
          (Pos('TotalPrice', AColumn.FieldName) > 0) then
        DataSetErrorMessage(Allow, '该清单有子计算项，不能直接修改！')
      else if (Pos('Price', AColumn.FieldName) > 0) then
        DataSetErrorMessage(Allow, '仅最底层清单可输入单价！');
    end
    else
    begin
      // 目前仅允许本期合同计量，可直接输入金额
      if SameText('CurDealTotalPrice', AColumn.FieldName) then
      begin
        if not vNode.TotalPriceEnable then
          DataSetErrorMessage(Allow, '该清单不可直接输入金额，如需直接输入金额，请先清空所有数量、单价！');
      end
      else if SameText('CurDealQuantity', AColumn.FieldName) or
          SameText('CurQcQuantity', AColumn.FieldName) or
          SameText('CurPcQuantity', AColumn.FieldName) or
          SameText('Price', AColumn.FieldName) then
      begin
        if not vNode.CountPriceEnable then
          DataSetErrorMessage(Allow, '该清单不可输入数量单价，如需使用数量×单价计算，请先清空所有直接输入的金额！');
      end;
    end;
    if not Allow then Exit;
    // 变更清单允许填写本期合同计量，按超计论
    {if vNode.Rec.ValueByName('IsMeasureAdd').AsBoolean and (iCreatePhase > 0) and
        (SameText('CurDealQuantity', AColumn.FieldName) or
        SameText('CurDealTotalPrice', AColumn.FieldName)) then
      DataSetErrorMessage(Allow, Format('该清单为第%d期新增清单，不可填写本期合同计量数据！', [iCreatePhase]));}
  end;

  procedure SetQuantity(const AField: string);
  var
    vNode: TBillsIDTreeNode;
  begin
    // 变更应选择变更令
    if SameText(AField , 'Qc') or SameText(AField , 'Pc') then
      Allow := SelectAndUpdateBGL(GetBillsID, AValue.Owner, StrToFloatDef(Text, 0), AField);
    if not Allow then Exit;

    if CheckStringNull(Text) or CheckNumeric(Text) then
    begin
      AValue.Owner.ValueByName(AField + 'Flag').AsInteger := 0;
      AValue.Owner.ValueByName(AField + 'Formula').AsString := '';
      Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)));
    end
    else
    begin
      AValue.Owner.ValueByName(AField + 'Flag').AsInteger := 1;
      AValue.Owner.ValueByName(AField + 'Formula').AsString := Text;
      Text := FloatToStr(QuantityRoundTo(EvaluateExprs(Text)));
    end;
    
    vNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(GetBillsID));
    if vNode.Rec.CalcType.AsInteger <> 0 then
      vNode.Rec.CalcType.AsInteger := 0;
  end;

  procedure SetTotalPrice(const AField: string);
  var
    vNode: TBillsIDTreeNode;
  begin
    // 变更应选择变更令
    if SameText(AField , 'Qc') or SameText(AField , 'Pc') then
      Allow := SelectAndUpdateBGL(GetBillsID, AValue.Owner, StrToFloatDef(Text, 0), AField);
    if not Allow then Exit;

    AValue.Owner.ValueByName(AField + 'Flag').AsInteger := 2;
    AValue.Owner.ValueByName(AField + 'Quantity').AsString := '';
    if CheckStringNull(Text) or CheckNumeric(Text) then
    begin
      AValue.Owner.ValueByName(AField + 'Formula').AsString := '';
      Text := FloatToStr(TotalPriceRoundTo(StrToFloatDef(Text, 0)));
    end
    else
    begin
      AValue.Owner.ValueByName(AField + 'Formula').AsString := Text;
      Text := FloatToStr(TotalPriceRoundTo(EvaluateExprs(Text)));
    end;

    vNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(GetBillsID));
    if vNode.Rec.CalcType.AsInteger <> 1 then
      vNode.Rec.CalcType.AsInteger := 1;
  end;

  procedure DoCurChanged;
  begin
    if SameText(AColumn.FieldName, 'CurDealQuantity') then
      SetQuantity('Deal')
    else if SameText(AColumn.FieldName, 'CurQcQuantity') then
      SetQuantity('Qc')
    else if SameText(AColumn.FieldName, 'CurPcQuantity') then
      SetQuantity('Pc')
    else if SameText(AColumn.FieldName, 'CurDealTotalPrice') then
      SetTotalPrice('Deal')
    else if SameText(AColumn.FieldName, 'CurQcTotalPrice') then
      SetTotalPrice('Qc')
    else if SameText(AColumn.FieldName, 'CurPcTotalPrice') then
      SetTotalPrice('Pc')
    else if (Pos('DgnQuantity', AColumn.FieldName) > 0) or
        SameText(AColumn.FieldName, 'Quantity') then
      Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)))
    else if SameText(AColumn.FieldName, 'NewPrice') or
        SameText(AColumn.FieldName, 'Price') then
      Text := FloatToStr(PriceRoundTo(StrToFloatDef(Text, 0)));
  end;

  function CheckValidData: Boolean;
  begin
    Result := (AValue.AsString <> Text);
    if (Pos('Quantity', AColumn.FieldName) > 0) or
       (Pos('Price', AColumn.FieldName) > 0) then
    begin
      if (AValue.AsFloat = 0) and (Text = '') then
        Result := False;
    end;
  end;

begin
  if not Assigned(AValue) then Exit;
  // 修改后数据与原数据相同则不提交
  if not CheckValidData then
    Allow := False;
  if not Allow then Exit;

  CheckLockedData;
  if not Allow then Exit;

  CheckNodeWritable;
  if not Allow then Exit;

  Text := Trim(Text);
  if Pos('=', Text) = 1 then
    Text := Copy(Text, 2, Length(Text) - 1);
  DoCurChanged;
end;

procedure TBillsMeasureData.sdvBillsMeasureNeedLookupRecord(
  ARecord: TsdDataRecord; AColumn: TsdViewColumn; ANewText: String);

  function CheckNeedAddPhaseRecord(ANode: TMeasureBillsIDTreeNode): Boolean;
  begin
    Result := SameText(AColumn.FieldName, 'CurDealQuantity') or
              SameText(AColumn.FieldName, 'CurQcQuantity') or
              SameText(AColumn.FieldName, 'CurPcQuantity') or
              SameText(AColumn.FieldName, 'CurDealTotalPrice') or
              SameText(AColumn.FieldName, 'CurQcTotalPrice') or
              SameText(AColumn.FieldName, 'CurPcTotalPrice');
    Result := Result and not ANode.HasChildren;
    Result := Result and not Assigned(ANode.StageRec);
  end;

  function HasCardinalNum(AFormula: string): Boolean;
  var
    iCharIndex: Integer;
  begin
    Result := False;
    iCharIndex := 1;
    while ((iCharIndex <= Length(AFormula)) and not Result) do
    begin
      if AFormula[iCharIndex] in ['A'..'D', 'a'..'d'] then
        Result := True;
      Inc(iCharIndex);
    end;
  end;

  procedure SetQuantityRec(ANode: TBillsIDTreeNode; APhaseRec: TsdDataRecord; const AType: string);
  var
    bAllow: Boolean;
  begin
    bAllow := True;
    // 变更应选择变更令
    if SameText(AType , 'Qc') or SameText(AType , 'Pc') then
      bAllow := SelectAndUpdateBGL(ARecord.ValueByName('ID').AsInteger,
          APhaseRec, StrToFloatDef(ANewText, 0), AType);

    if bAllow then
    begin 
      if ANode.Rec.CalcType.AsInteger <> 0 then
        ANode.Rec.CalcType.AsInteger := 0;

      if CheckNumeric(ANewText) then
        APhaseRec.ValueByName(AType + 'Quantity').AsFloat := QuantityRoundTo(StrToFloatDef(ANewText, 0))
      else
      begin
        APhaseRec.ValueByName(AType + 'Flag').AsInteger := 1;
        APhaseRec.ValueByName(AType + 'Quantity').AsFloat := QuantityRoundTo(EvaluateExprs(ANewText));
        APhaseRec.ValueByName(AType + 'Formula').AsString := ANewText;
      end;
    end;
  end;

  procedure SetTotalPriceRec(ANode: TBillsIDTreeNode; APhaseRec: TsdDataRecord; const AType: string);
  begin  
    if ANode.Rec.CalcType.AsInteger <> 1 then
      ANode.Rec.CalcType.AsInteger := 1;
    APhaseRec.ValueByName(AType + 'Flag').AsInteger := 2;

    if CheckNumeric(ANewText) then
      APhaseRec.ValueByName(AType + 'TotalPrice').AsFloat := TotalPriceRoundTo(StrToFloatDef(ANewText, 0))
    else
    begin
      APhaseRec.ValueByName(AType + 'TotalPrice').AsFloat := TotalPriceRoundTo(EvaluateExprs(ANewText));
      APhaseRec.ValueByName(AType + 'Formula').AsString := ANewText;
    end;
  end;

  procedure SetNewRecValue(ANode: TBillsIDTreeNode; APhaseRec: TsdDataRecord);
  begin
    if SameText(AColumn.FieldName, 'CurDealQuantity') then
      SetQuantityRec(ANode, APhaseRec, 'Deal')
    else if SameText(AColumn.FieldName, 'CurQcQuantity') then
      SetQuantityRec(ANode, APhaseRec, 'Qc')
    else if SameText(AColumn.FieldName, 'CurPcQuantity') then
      SetQuantityRec(ANode, APhaseRec, 'Pc')
    else if SameText(AColumn.FieldName, 'CurDealTotalPrice') then
      SetTotalPriceRec(ANode, APhaseRec, 'Deal')
    else if SameText(AColumn.FieldName, 'CurQcTotalPrice') then
      SetTotalPriceRec(ANode, APhaseRec, 'Qc')
    else if SameText(AColumn.FieldName, 'CurPcTotalPrice') then
      SetTotalPriceRec(ANode, APhaseRec, 'Pc');
  end;

  function CheckNodeWritable(ANode: TBillsIDTreeNode): Boolean;
  var
    iCreatePhase: Integer;
  begin
    Result := True;

    if ANode.ID = iPriceMarginID then
      DataSetErrorMessage(Result, sBills_PMHint);

    if ANode.HasChildren then
    begin
      if ANewText = '' then
        Result := False
      else
        DataSetErrorMessage(Result, '该清单有子计算项，不能直接修改！');
    end
    else
    begin
      // 目前仅允许本期合同计量，可直接输入金额
      if SameText('CurDealTotalPrice', AColumn.FieldName) then
      begin
        if not ANode.TotalPriceEnable then
          DataSetErrorMessage(Result, '该清单不可直接输入金额，如需直接输入金额，请先清空所有数量、单价！');
      end
      else if SameText('CurDealQuantity', AColumn.FieldName) or
          SameText('CurQcQuantity', AColumn.FieldName) or
          SameText('CurPcQuantity', AColumn.FieldName) then
      begin
        if not ANode.CountPriceEnable then
          DataSetErrorMessage(Result, '该清单不可输入数量单价，如需使用数量×单价计算，请先清空所有直接输入的金额！');
      end;
    end;

    // 变更清单允许填写本期合同计量，按超计论
    {iCreatePhase := ANode.Rec.ValueByName('CreatePhaseID').AsInteger;
    if ANode.Rec.ValueByName('IsMeasureAdd').AsBoolean and (iCreatePhase > 0) and
        (SameText('CurDealQuantity', AColumn.FieldName) or
        SameText('CurDealTotalPrice', AColumn.FieldName)) then
    begin
      ErrorMessage(Format('该清单为第%d期新增清单，不可填写本期合同计量数据！', [iCreatePhase]));
      Exit;
    end; }
  end;

var
  NewRec: TStageRecord;
  vNode: TMeasureBillsIDTreeNode;
begin
  vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.FindNode(ARecord.ValueByName('ID').AsInteger));
  if not CheckNodeWritable(vNode) then
    Exit;

  if CheckNeedAddPhaseRecord(vNode) then
  begin
    if(Pos('Quantity', AColumn.FieldName) > 0) or (Pos('TotalPrice', AColumn.FieldName) > 0) then
      if HasCardinalNum(ANewText) then
        raise Exception.Create('公式不可输入参数');
    NewRec := StageData.AddStageRecord(ARecord.ValueByName('ID').AsInteger);
    vNode.StageRec := NewRec;

    SetNewRecValue(vNode, NewRec);
  end;
end;

procedure TBillsMeasureData.sdvBillsMeasureAfterClose(Sender: TObject);
begin
  FBillsMeasureTree.Active := False;
end;

function TBillsMeasureData.OnGetCardinalNum(
  const ACardinalNum: string): Double;
{
  function GetTotalPrice(ABillsID: Integer): Double;
  var
    stnNode: TsdIDTreeNode;
  begin
    stnNode := FBillsTree.FindNode(ABillsID);
    if Assigned(stnNode) then
      Result := stnNode.Rec.ValueByName('TotalPrice').AsFloat;
  end;

  function GetPhaseTotalPrice(ABillsID: Integer; const AType: string): Double;
  var
    Rec: TsdDataRecord;
  begin
    Rec := CurPhaseData.PhaseRecord(ABillsID);
    if Assigned(Rec) then
      Result := Rec.ValueByName(AType + 'TotalPrice').AsFloat;
  end;
}
  function GetTotalPrice(ANode: TsdIDTreeNode): Double;
  var
    iChild: Integer;
  begin
    Result := 0;
    if not Assigned(ANode) then Exit;
    if ANode.HasChildren then
      for iChild := 0 to ANode.ChildCount - 1 do
        Result := Result + GetTotalPrice(ANode.ChildNodes[iChild])
    else
      Result := ANode.Rec.ValueByName('TotalPrice').AsFloat;
  end;

  function GetPhaseTotalPrice(ANode: TsdIDTreeNode; const AType: string): Double;
  var
    iChild: Integer;
    Rec: TsdDataRecord;
  begin
    Result := 0;
    if not Assigned(ANode) then Exit;
    if ANode.HasChildren then
      for iChild := 0 to ANode.ChildCount - 1 do
        Result := Result + GetPhaseTotalPrice(ANode.ChildNodes[iChild], AType)
    else
    begin
      Rec := StageData.StageRecord(ANode.ID);
      if Assigned(Rec) then
        Result := Rec.ValueByName(AType + 'TotalPrice').AsFloat;
    end;
  end;

var
  iNodeID: Integer;
begin
  Result := 0;
  iNodeID := StrToIntDef(Copy(ACardinalNum, 2, Length(ACardinalNum) - 1), -1);
  case ACardinalNum[1] of
    'A','a': Result := GetTotalPrice(BillsMeasureTree.FindNode(iNodeID));
    'B','b': Result := GetPhaseTotalPrice(BillsMeasureTree.FindNode(iNodeID), 'Deal');
    'C','c': Result := GetPhaseTotalPrice(BillsMeasureTree.FindNode(iNodeID), 'Qc');
    'D','d': Result := GetPhaseTotalPrice(BillsMeasureTree.FindNode(iNodeID), 'Pc');
    {'A','a': Result := GetTotalPrice(iNodeID);
    'B','b': Result := GetPhaseTotalPrice(iNodeID, 'Deal');
    'C','c': Result := GetPhaseTotalPrice(iNodeID, 'Qc');
    'D','d': Result := GetPhaseTotalPrice(iNodeID, 'Pc');}
  end;
end;

function TBillsMeasureData.GetStageData: TStageData;
begin
  Result := TProjectData(FProjectData).PhaseData.StageData;
end;

procedure TBillsMeasureData.ExpandNodeTo(ALevel: Integer);
begin
  BillsMeasureTree.ExpandLevel := ALevel;
end;

procedure TBillsMeasureData.ExpandXmjNode;
var
  iIndex: Integer;
  stnNode: TBillsIDTreeNode;
begin
  for iIndex := 0 to BillsMeasureTree.Count - 1 do
  begin
    stnNode := TBillsIDTreeNode(BillsMeasureTree.Items[iIndex]);
    if (stnNode.ParentID <> -1) then
      stnNode.Parent.Expanded := stnNode.Rec.B_Code.AsString = '';
  end;
end;

procedure TBillsMeasureData.CalculateAll;
var
  //Cacl: TBillsCalculate;
  i: Integer;
begin
  if not TProjectData(FProjectData).StageDataReadOnly then

  for i := 0 to BillsMeasureTree.Count - 1 do
    CalculateNode(TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]));

  {Cacl := TBillsCalculate.Create(Self);
  try
    Cacl.Execute;
  finally
    Cacl.Free;
  end;}
end;

procedure TBillsMeasureData.UpdateRecordDeal(ABillsID: Integer; AQuantity,
  ATotalPrice: Double);
var
  stnNode: TsdIDTreeNode;
begin
  stnNode := BillsMeasureTree.FindNode(ABillsID);
  if not Assigned(stnNode) then Exit;
  with stnNode.Rec do
  begin
    if not stnNode.HasChildren then
      ValueByName('AddDealQuantity').AsFloat := QuantityRoundTo(
        ValueByName('AddDealQuantity').AsFloat + AQuantity);
    ValueByName('AddDealTotalPrice').AsFloat := TotalPriceRoundTo(
      ValueByName('AddDealTotalPrice').AsFloat + ATotalPrice);
  end;
  UpdateRecordGather(stnNode, AQuantity, ATotalPrice);
  UpdateRecordDeal(stnNode.ParentID, AQuantity, ATotalPrice);
end;

procedure TBillsMeasureData.UpdateRecordPc(ABillsID: Integer; AQuantity,
  ATotalPrice: Double);
var
  stnNode: TsdIDTreeNode;
begin
  stnNode := BillsMeasureTree.FindNode(ABillsID);
  if not Assigned(stnNode) then Exit;
  with stnNode.Rec do
  begin
    if not stnNode.HasChildren then
      ValueByName('AddPcQuantity').AsFloat := QuantityRoundTo(
        ValueByName('AddPcQuantity').AsFloat + AQuantity);
    ValueByName('AddPcTotalPrice').AsFloat := TotalPriceRoundTo(
      ValueByName('AddPcTotalPrice').AsFloat + ATotalPrice);
  end;
  UpdateRecordGather(stnNode, 0, ATotalPrice);
  UpdateRecordPc(stnNode.ParentID, AQuantity, ATotalPrice);
end;

procedure TBillsMeasureData.UpdateRecordQc(ABillsID: Integer; AQuantity,
  ATotalPrice: Double);
var
  stnNode: TsdIDTreeNode;
begin
  stnNode := BillsMeasureTree.FindNode(ABillsID);
  if not Assigned(stnNode) then Exit;
  with stnNode.Rec do
  begin
    if not stnNode.HasChildren then
      ValueByName('AddQcQuantity').AsFloat := QuantityRoundTo(
        ValueByName('AddQcQuantity').AsFloat + AQuantity);
    ValueByName('AddQcTotalPrice').AsFloat := TotalPriceRoundTo(
      ValueByName('AddQcTotalPrice').AsFloat + ATotalPrice);
  end;
  UpdateRecordGather(stnNode, AQuantity, ATotalPrice);
  UpdateRecordQc(stnNode.ParentID, AQuantity, ATotalPrice);
end;

procedure TBillsMeasureData.UpdateRecordGather(ANode: TsdIDTreeNode;
  AQuantity, ATotalPrice: Double);
begin
  with ANode.Rec do
  begin
    if not ANode.HasChildren then
      ValueByName('AddGatherQuantity').AsFloat := QuantityRoundTo(
        ValueByName('AddGatherQuantity').AsFloat + AQuantity);
    ValueByName('AddGatherTotalPrice').AsFloat := TotalPriceRoundTo(
      ValueByName('AddGatherTotalPrice').AsFloat + ATotalPrice);
  end;
  CalcAddDgnPrice(ANode);
  CalcAddCompleteRate(ANode);
end;

function TBillsMeasureData.GatherRelaBGL(ANode: TsdIDTreeNode): string;
var
  iChild: Integer;
  Rec: TsdDataRecord;
begin
  Result := '';
  if not Assigned(ANode) then Exit;
  if ANode.HasChildren then
  begin
    for iChild := 0 to ANode.ChildCount - 1 do
      Result := MergeRelaBGL(Result, GatherRelaBGL(ANode.ChildNodes[iChild]));
  end
  else
  begin
    with TProjectData(FProjectData).PhaseData.StageData do
      Rec := StageRecord(ANode.ID);
    if Assigned(Rec) then
      Result := MergeRelaBGL(Rec.ValueByName('QcBGLCode').AsString, Rec.ValueByName('PcBGLCode').AsString);
  end;
end;

procedure TBillsMeasureData.sdvBillsMeasureAfterValueChanged(
  AValue: TsdValue);
var
  stnNode: TsdIDTreeNode;
begin
  if TProjectData(FProjectData).PhaseData.Active then
  begin
    if AValue.FieldName = 'Price' then
      StageData.ReCalculate(AValue.Owner.ValueByName('ID').AsInteger);
    if AValue.FieldName = 'NewPrice' then
      StageData.ReCalculate(AValue.Owner.ValueByName('ID').AsInteger);
  end;
  if Pos('DgnQuantity1', AValue.FieldName) > 0 then
  begin
    stnNode := BillsMeasureTree.FindNode(AValue.Owner.ValueByName('ID').AsInteger);
    CalcAddDgnPrice(stnNode);
  end;
end;

procedure TBillsMeasureData.ExpandCurPhase;
var
  iIndex: Integer;
  stnNode: TsdIDTreeNode;
  StageRec: TStageRecord;
begin
  for iIndex := 0 to BillsMeasureTree.Count - 1 do
  begin
    stnNode := BillsMeasureTree.Items[iIndex];
    StageRec := TMeasureBillsIDTreeNode(stnNode).StageRec;
    if (stnNode.ParentID <> -1) then
      if Assigned(StageRec) then
        stnNode.Expanded := StageRec.GatherTotalPrice.AsFloat <> 0
      else
        stnNode.Expanded := False;
  end;
end;

procedure TBillsMeasureData.UpdateBGLInfo(ABillsID: Integer;
  ARec: TsdDataRecord; const AType: string);
var
  stnNode: TsdIDTreeNode;
begin
  stnNode := BillsMeasureTree.FindNode(ABillsID);
  if not Assigned(stnNode) then Exit;
  stnNode.Rec.ValueByName('Add' + AType + 'BGLCode').AsString :=
      ARec.ValueByName('End' + AType + 'BGLCode').AsString;
  stnNode.Rec.ValueByName('Add' + AType + 'BGLNum').AsString :=
      ARec.ValueByName('End' + AType + 'BGLNum').AsString;
end;

function TBillsMeasureData.SelectAndUpdateBGL(ABillsID: Integer;
  ARec: TsdDataRecord; ANewValue: Double; const AType: string): Boolean;
var
  AOrgBGL, ANewBGL: TBGLSelectInfo;
  ACurNode: TsdIDTreeNode;

  procedure UpdateBGL;
  begin
    ARec.ValueByName(AType + 'BGLCode').AsString := ANewBGL.MergedCode;
    ARec.ValueByName(AType + 'BGLNum').AsString := ANewBGL.MergedNum;
    TProjectData(ProjectData).BGLData.ApplyBGL(AOrgBGL, ANewBGL);
  end;

begin
  Result := True;
  ACurNode := BillsMeasureTree.FindNode(ABillsID);

  AOrgBGL := TBGLSelectInfo.Create(ACurNode.Rec,
      ARec.ValueByName(AType + 'Quantity').AsFloat, True);
  AOrgBGL.MergedCode := ARec.ValueByName(AType + 'BGLCode').AsString;
  AOrgBGL.MergedNum := ARec.ValueByName(AType + 'BGLNum').AsString;

  ANewBGL := TBGLSelectInfo.Create(ACurNode.Rec, ANewValue, False);
  try
    if ANewBGL.TotalNum <> 0 then
    begin
      Result := SelectBGL(AOrgBGL, ANewBGL, ProjectData);
      if Result then
        UpdateBGL;
    end
    else
      UpdateBGL;
    StageData.UpdateBGLInfo(ARec, AType);
    UpdateBGLInfo(ABillsID, ARec, AType);
  finally
    AOrgBGL.Free;
    ANewBGL.Free;
  end;
end;

procedure TBillsMeasureData.Close;
begin
  sdvBillsMeasure.Close;
end;

procedure TBillsMeasureData.CalcAddCompleteRate(ANode: TsdIDTreeNode);
var
  fDividend, fDivisor: Double;
begin
  with ANode.Rec do
  begin
    fDividend := ValueByName('AddGatherTotalPrice').AsFloat;
    fDivisor := ValueByName('TotalPrice').AsFloat + ValueByName('AddQcTotalPrice').AsFloat
        + ValueByName('AddPcTotalPrice').AsFloat;
    if fDivisor <> 0 then
      ValueByName('AddCompleteRate').AsFloat := AdvRoundTo(fDividend/fDivisor*100)
    else
      ValueByName('AddCompleteRate').Clear;
  end;
end;

procedure TBillsMeasureData.CalcAddDgnPrice(ANode: TsdIDTreeNode);
var
  fDividend, fDivisor: Double;
begin
  with ANode.Rec do
  begin
    fDividend := ValueByName('AddGatherTotalPrice').AsFloat;
    fDivisor := ValueByName('DealDgnQuantity1').AsFloat + ValueByName('CDgnQuantity1').AsFloat;
    if fDivisor <> 0 then
      ValueByName('AddDgnPrice').AsFloat := AdvRoundTo(fDividend/fDivisor);
  end;
end;

procedure TBillsMeasureData.SetOnRecChange(const Value: TRecChangeEvent);
begin
  FOnRecChange := Value;
end;

procedure TBillsMeasureData.sdvBillsMeasureCurrentChanged(
  ARecord: TsdDataRecord);
begin
  if Assigned(FOnRecChange) then
    FOnRecChange(ARecord);
end;

procedure TBillsMeasureData.ResetTreeNodeStageRec;
var
  i: Integer;
  vNode: TMeasureBillsIDTreeNode;
begin
  if not StageData.Active then Exit;
  for i := 0 to BillsMeasureTree.Count - 1 do
  begin
    vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]);
    vNode.StageRec := StageData.StageRecord(vNode.ID);
  end;
end;

procedure TBillsMeasureData.UpdateRecordPM(ABillsID: Integer;
  ADiffer: Double);
var
  stnNode: TBillsIDTreeNode;
begin
  stnNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(ABillsID));
  if not Assigned(stnNode) then Exit;

  stnNode.Rec.PM_AddTotalPrice.AsFloat := stnNode.Rec.PM_AddTotalPrice.AsFloat + ADiffer;
  UpdateRecordPM(stnNode.ParentID, ADiffer);
end;

procedure TBillsMeasureData.CalculateNode(ANode: TMeasureBillsIDTreeNode);
begin
  if Assigned(ANode.StageRec) then
  begin
    if not ANode.HasChildren then
    begin
      ANode.Rec.AddDealQuantity.AsFloat := ANode.StageRec.EndDealQuantity.AsFloat;

      ANode.Rec.AddQcQuantity.AsFloat := ANode.StageRec.EndQcQuantity.AsFloat;
      ANode.Rec.AddQcBGLCode.AsString := ANode.StageRec.EndQcBGLCode.AsString;
      ANode.Rec.AddQcBGLNum.AsString := ANode.StageRec.EndQcBGLNum.AsString;

      ANode.Rec.AddPcQuantity.AsFloat := ANode.StageRec.EndPcQuantity.AsFloat;
      ANode.Rec.AddPcBGLCode.AsString := ANode.StageRec.EndPcBGLCode.AsString;
      ANode.Rec.AddPcBGLNum.AsString := ANode.StageRec.EndPcBGLNum.AsString;

      ANode.Rec.AddGatherQuantity.AsFloat := ANode.StageRec.EndGatherQuantity.AsFloat;
    end;
    ANode.Rec.AddDealTotalPrice.AsFloat := ANode.StageRec.EndDealTotalPrice.AsFloat;
    ANode.Rec.AddQcTotalPrice.AsFloat := ANode.StageRec.EndQcTotalPrice.AsFloat;
    ANode.Rec.AddPcTotalPrice.AsFloat := ANode.StageRec.EndPcTotalPrice.AsFloat;
    ANode.Rec.AddGatherTotalPrice.AsFloat := ANode.StageRec.EndGatherTotalPrice.AsFloat;

    ANode.Rec.PM_AddTotalPrice.AsFloat := ANode.StageRec.PM_PreTotalPrice.AsFloat + ANode.StageRec.PM_TotalPrice.AsFloat;
  end;
end;

procedure TBillsMeasureData.UpdateGather(ABillsID: Integer;
  ADiffer: Double);
var
  stnNode: TBillsIDTreeNode;
begin
  stnNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(ABillsID));
  if not Assigned(stnNode) then Exit;

  with stnNode.Rec do
    AddDifferValue(AddGatherTotalPrice, ADiffer);
  UpdateGather(stnNode.ParentID, ADiffer);
end;

end.