Measure/DataModules/BillsCompileDm.pas

unit BillsCompileDm;

interface

uses
  BillsDm, StandardBillsFme,
  SysUtils, Classes, sdDB, BillsTree, sdIDTree;

type
  TBillsCompileData = class(TDataModule)
    sdvBillsCompile: TsdDataView;
    procedure sdvBillsCompileGetText(var Text: String;
      ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
      DisplayText: Boolean);
    procedure sdvBillsCompileAfterValueChanged(AValue: TsdValue);
    procedure sdvBillsCompileBeforeValueChange(AValue: TsdValue;
      const NewValue: Variant; var Allow: Boolean);
    procedure sdvBillsCompileSetText(var Text: String;
      ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
      var Allow: Boolean);
    procedure sdvBillsCompileAfterOpen(Sender: TObject);
    procedure sdvBillsCompileAfterClose(Sender: TObject);
    procedure sdvBillsCompileAfterAddRecord(ARecord: TsdDataRecord);
    procedure sdvBillsCompileCurrentChanged(ARecord: TsdDataRecord);
  private
    FProjectData: TObject;
    FBillsData: TBillsData;
    FBillsCompileTree: TBillsIDTree;

    FOnRecChange: TRecChangeEvent;

    function GatherChildrenOrg(ANode: TsdIDTreeNode): Double;
    procedure UpdateRecordOrg(ABillsID: Integer; ATotalPrice: Double);

    function FindChild(AParentNode, ANode: TsdIDTreeNode): TsdIDTreeNode;
    function InsertChild(AParentNode, ANode: TsdIDTreeNode): TsdIDTreeNode;

    function CompareNodeCode(ANode, ACompareNode: TsdIDTreeNode): Integer;
    function GetNextSiblingID(AParent, ANode: TsdIDTreeNode): Integer;
    function IsSameNode(ANode, ACompareNode: TsdIDTreeNode): Boolean;
    function GetTopParentNode(ANode: TsdIDTreeNode; ALevel: Integer): TsdIDTreeNode;
    procedure AddXmjBillsFromLib(AStdBillsNode: TsdIDTreeNode);

    function CanAddGclBills: Boolean;
    function GetGclBillsParent(AChildNode: TsdIDTreeNode): TsdIDTreeNode;
    procedure AddGclBillsFromLib(AStdBillsNode: TsdIDTreeNode);

    procedure DoOnAfterDeleteNode(AParent: TsdIDTreeNode);

    function GatherChildren(ANode: TsdIDTreeNode; const AFieldName: string): Double;
    procedure UpdateParent(ABillsID: Integer; ADifferTotalPrice: Double; const AFieldName: string);
    // 经济指标[与其他节点无关]
    procedure CalculateDesignPrice(ANode: TBillsIDTreeNode);
    // 施工图原设计[增量]
    procedure CalculateOrg(ABillsID: Integer);
    // 设计错漏增减[增量]
    procedure CalculateMis(ABillsID: Integer);
    // 其他错漏增减[增量]
    procedure CalculateOth(ABillsID: Integer);
    procedure CalculateTotal(ABillsID: Integer);

    procedure CalculateLeaf(ANode: TBillsIDTreeNode);
    procedure GatherNode(ANode: TBillsIDTreeNode);
    procedure CalculateBills(ANode: TsdIDTreeNode);

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

    procedure Open;
    procedure Close;
    procedure ReConnectTree;

    procedure AddBillsFromLib(ANode: TsdIDTreeNode; ABillsType: TBillsType);
    procedure AddBillsFromDealBills(ARec: TsdDataRecord);

    procedure Calculate(ABillsID: Integer);
    procedure CalculateAll;

    function GetLeafXmjParentID(ABillsID: Integer): Integer;

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

    procedure ReorderChildrenCode(ANode: TsdIDTreeNode);

    // 所有解锁的节点全部重新锁定
    procedure ReLockBaseData;

    property ProjectData: TObject read FProjectData;
    property BillsData: TBillsData read FBillsData;
    property BillsCompileTree: TBillsIDTree read FBillsCompileTree;
    property Active: Boolean read GetActive;

    property OnRecChange: TRecChangeEvent read FOnRecChange write SetOnRecChange;
  end;

implementation

uses
  ProjectData, Math, ZhAPI, UtilMethods, ConstUnit, mDataRecord;

{$R *.dfm}

{ TBillsCompileData }

constructor TBillsCompileData.Create(AProjectData: TObject);
begin
  inherited Create(nil);
  FProjectData := AProjectData;
  FBillsData := TProjectData(FProjectData).BillsData;
  FBillsCompileTree := TBillsIDTree.Create;
  FBillsCompileTree.KeyFieldName := 'ID';
  FBillsCompileTree.ParentFieldName := 'ParentID';
  FBillsCompileTree.NextSiblingFieldName := 'NextSiblingID';
  FBillsCompileTree.AutoCreateKeyID := True;
  FBillsCompileTree.AutoExpand := True;
  FBillsCompileTree.DataView := sdvBillsCompile;
  FBillsCompileTree.SeedID := Max(FBillsCompileTree.SeedID, 100);
  FBillsCompileTree.DoOnAfterDeleteNode := DoOnAfterDeleteNode;
  FBillsCompileTree.OnReCalcParent := Calculate;
end;

destructor TBillsCompileData.Destroy;
begin
  FBillsCompileTree.Free;
  inherited;
end;

procedure TBillsCompileData.Open;
begin
  sdvBillsCompile.DataSet := TProjectData(FProjectData).BillsData.sddBills;
  sdvBillsCompile.Open;
  FBillsCompileTree.SeedID := Max(FBillsCompileTree.SeedID, 100);
end;

procedure TBillsCompileData.ReConnectTree;
begin
  FBillsCompileTree.DataView := nil;
  FBillsCompileTree.DataView := sdvBillsCompile;
end;

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

  procedure GetEditText;
  var
    sFormula: string;
  begin
    if SameText('OrgQuantity', AColumn.FieldName) then
      sFormula := ARecord.ValueByName('OrgFormula').AsString
    else if SameText('MisQuantity', AColumn.FieldName) then
      sFormula := ARecord.ValueByName('MisFormula').AsString
    else if SameText('OthQuantity', AColumn.FieldName) then
      sFormula := ARecord.ValueByName('OthFormula').AsString
    else
      sFormula := '';
    if sFormula <> '' then
      Text := sFormula;
  end;

  procedure GetDisplayText;
  begin
    if (Pos('Price', AColumn.FieldName) > 0) or
       (Pos('Quantity', AColumn.FieldName) > 0) then
    begin
      if Assigned(AValue) and (AValue.AsFloat = 0) then
        Text := '';
    end;
  end;

begin
  if DisplayText then
    GetDisplayText
  else
    GetEditText;
end;

procedure TBillsCompileData.ExpandNodeTo(ALevel: Integer);
begin
  BillsCompileTree.ExpandLevel := ALevel;
end;

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

procedure TBillsCompileData.sdvBillsCompileAfterValueChanged(
  AValue: TsdValue);

  procedure ResetChildrenLockedInfo(ANode: TsdIDTreeNode; ALockedInfo: Boolean);
  var
    iChild: Integer;
  begin
    if not Assigned(ANode) then Exit;
    if ANode.Rec.ValueByName('LockedLevel').AsBoolean then
      ANode.Rec.ValueByName('LockedInfo').AsBoolean := ALockedInfo;
    if ANode.HasChildren then
      for iChild := 0 to ANode.ChildCount - 1 do
        ResetChildrenLockedInfo(ANode.ChildNodes[iChild], ALockedInfo);
  end;

var
  stnNode: TsdIDTreeNode;
begin
  if SameText(AValue.FieldName, 'OrgQuantity') or
      SameText(AValue.FieldName, 'OrgTotalPrice') then
    CalculateOrg(AValue.Owner.ValueByName('ID').AsInteger)
  else if SameText(AValue.FieldName, 'MisQuantity') or
      SameText(AValue.FieldName, 'MisTotalPrice') then
    CalculateMis(AValue.Owner.ValueByName('ID').AsInteger)
  else if SameText(AValue.FieldName, 'OthQuantity') or
      SameText(AValue.FieldName, 'OthTotalPrice') then
    CalculateOth(AValue.Owner.ValueByName('ID').AsInteger)
  else if SameText(AValue.FieldName, 'Price') or
      SameText(AValue.FieldName, 'DgnQuantity1') then
    CalculateTotal(AValue.Owner.ValueByName('ID').AsInteger);

  if (AValue.FieldName = 'LockedInfo') then
  begin
    stnNode := BillsCompileTree.FindNode(AValue.Owner.ValueByName('ID').AsInteger);
    ResetChildrenLockedInfo(stnNode, AValue.AsBoolean);
  end;
end;

function TBillsCompileData.GatherChildrenOrg(ANode: TsdIDTreeNode): Double;
var
  iChild: Integer;
begin
  if ANode = nil then Exit;
  if ANode.HasChildren and Assigned(ANode.FirstChild) then
  begin
    Result := 0;
    for iChild := 0 to ANode.ChildCount - 1 do
      Result := Result + GatherChildrenOrg(ANode.ChildNodes[iChild]);
    Result := TotalPriceRoundTo(Result);
  end
  else
    if Assigned(ANode.Rec) and Assigned(ANode.Rec.ValueByName('TotalPrice')) then
      Result := ANode.Rec.ValueByName('TotalPrice').AsFloat
    else
      Result := 0;
end;

procedure TBillsCompileData.UpdateRecordOrg(ABillsID: Integer;
  ATotalPrice: Double);
var
  stnNode: TsdIDTreeNode;
begin
  stnNode := BillsCompileTree.FindNode(ABillsID);
  if not Assigned(stnNode) then Exit;
  with stnNode.Rec do
  begin
    ValueByName('TotalPrice').AsFloat := TotalPriceRoundTo(
      ValueByName('TotalPrice').AsFloat + ATotalPrice);
    if ValueByName('DgnQuantity1').AsFloat <> 0 then
      ValueByName('DgnPrice').AsFloat := PriceRoundTo(
          ValueByName('TotalPrice').AsFloat/ValueByName('DgnQuantity1').AsFloat);
  end;
  UpdateRecordOrg(stnNode.ParentID, ATotalPrice);
end;

procedure TBillsCompileData.sdvBillsCompileBeforeValueChange(
  AValue: TsdValue; const NewValue: Variant; var Allow: Boolean);
begin
  // 清单编号和项目节编号不可同时存在
  if SameText(AValue.FieldName, 'Code') then
  begin
    if AValue.Owner.ValueByName('B_Code').AsString <> '' then
      DataSetErrorMessage(Allow, '已存在清单编号，不可输入项目节编号！');
  end
  else if SameText(AValue.FieldName, 'B_Code') then
  begin
    if AValue.Owner.ValueByName('Code').AsString <> '' then
      DataSetErrorMessage(Allow, '已存在项目节编号，不可输入清单编号！');
  end
  //
  else if SameText(AValue.FieldName, 'Price') then
  begin
    if AValue.Owner.ValueByName('AddGatherTotalPrice').AsFloat <> 0 then
      DataSetErrorMessage(Allow, '该清单已经开始计量，不可修改单价！');
  end
  // 变更清单不可修改0号台账数据
  else if SameText(AValue.FieldName, 'OrgQuantity') or
      SameText(AValue.FieldName, 'MisQuantity') or
      SameText(AValue.FieldName, 'OthQuantity') then
  begin
    if AValue.Owner.ValueByName('IsMeasureAdd').AsBoolean then
      DataSetErrorMessage(Allow, '变更清单不可填写0号台账数量与金额');
  end;
  if not Allow then Exit;
    
  if SameText(AValue.FieldName, 'OrgQuantity') or
      SameText(AValue.FieldName, 'MisQuantity') or
      SameText(AValue.FieldName, 'OthQuantity') or
      SameText(AValue.FieldName, 'OrgTotalPrice') or
      SameText(AValue.FieldName, 'MisTotalPrice') or
      SameText(AValue.FieldName, 'OthTotalPrice') or
      SameText(AValue.FieldName, 'Price') then
  begin
    TBillsRecord(AValue.Owner).CacheOrgTP := AValue.Owner.ValueByName('OrgTotalPrice').AsFloat;
    TBillsRecord(AValue.Owner).CacheMisTP := AValue.Owner.ValueByName('MisTotalPrice').AsFloat;
    TBillsRecord(AValue.Owner).CacheOthTP := AValue.Owner.ValueByName('OthTotalPrice').AsFloat;
  end;
end;

procedure TBillsCompileData.CalculateAll;

  procedure RecursiveCalc(ANode: TsdIDTreeNode);
  begin
    if not Assigned(ANode) then Exit;
    if ANode.HasChildren then
    begin
      RecursiveCalc(ANode.FirstChild);
      GatherNode(TBillsIDTreeNode(ANode));
    end
    else
      CalculateLeaf(TBillsIDTreeNode(ANode));
    RecursiveCalc(ANode.NextSibling);
  end;

  procedure BeginCalc;
  begin
    sdvBillsCompile.BeforeValueChange := nil;
    sdvBillsCompile.AfterValueChanged := nil;
  end;

  procedure EndCalc;
  begin
    sdvBillsCompile.BeforeValueChange := sdvBillsCompileBeforeValueChange;
    sdvBillsCompile.AfterValueChanged := sdvBillsCompileAfterValueChanged;
  end;

begin
  BeginCalc;
  try
    RecursiveCalc(BillsCompileTree.FirstNode);
  finally
    EndCalc;
  end;
end;

procedure TBillsCompileData.AddBillsFromLib(ANode: TsdIDTreeNode;
  ABillsType: TBillsType);
begin
  if not Assigned(ANode) then Exit;
  if ABillsType = btXm then
    AddXmjBillsFromLib(ANode)
  else if ABillsType = btGcl then
    AddGclBillsFromLib(ANode);
end;

procedure TBillsCompileData.AddGclBillsFromLib(
  AStdBillsNode: TsdIDTreeNode);
var
  stnParent, stnStdNode: TsdIDTreeNode;
  iLevel: Integer;
begin
  if not CanAddGclBills then
    raise Exception.Create('当前节点下不可添加工程量清单！');

  stnParent := GetGclBillsParent(BillsCompileTree.Selected);
  if TBillsIDTreeNode(stnParent).HasLedger or
     (not stnParent.HasChildren and TBillsIDTreeNode(stnParent).HasMeasure) then
    raise Exception.Create('当前节点不可添加工程量清单！');

  stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level);
  for iLevel := 1 to AStdBillsNode.Level + 1 do
  begin
    if stnStdNode.Rec.ValueByName('B_Code').AsString <> '' then
      if FindChild(stnParent, stnStdNode) <> nil then
        stnParent := FindChild(stnParent, stnStdNode)
      else
        stnParent := InsertChild(stnParent, stnStdNode);
    stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level - iLevel);
  end;
end;

procedure TBillsCompileData.AddXmjBillsFromLib(
  AStdBillsNode: TsdIDTreeNode);
var
  stnStdNode, stnCurNode: TsdIDTreeNode;
  iLevel: Integer;
begin
  stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level);
  stnCurNode := nil;
  for iLevel := 1 to AStdBillsNode.Level + 1 do
  begin
    if FindChild(stnCurNode, stnStdNode) <> nil then
      stnCurNode := FindChild(stnCurNode, stnStdNode)
    else
    begin
      if TBillsIDTreeNode(stnCurNode).HasLedger or
         (not stnCurNode.HasChildren and TBillsIDTreeNode(stnCurNode).HasMeasure) then
        raise Exception.Create('不可添加该项目节数据！')
      else
        stnCurNode := InsertChild(stnCurNode, stnStdNode);
    end;
    stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level - iLevel);
  end;
end;

function TBillsCompileData.CanAddGclBills: Boolean;

  function CheckChildrenHasXmj(ANode: TsdIDTreeNode): Boolean;
  var
    stnCurNode: TsdIDTreeNode;
  begin
    Result := False;
    if not ANode.HasChildren then Exit;

    stnCurNode := ANode.FirstChild;
    while not Result and Assigned(stnCurNode) do
    begin
      Result := Result or (stnCurNode.Rec.ValueByName('Code').AsString <> '');
      if stnCurNode.HasChildren then
        Result := Result or CheckChildrenHasXmj(stnCurNode);
      stnCurNode := stnCurNode.NextSibling;
    end;
  end;

  function CheckParentIsXmj(ANode: TsdIDTreeNode): Boolean;
  begin
    Result := False;
    if not Assigned(ANode) then Exit;

    Result := ANode.Rec.ValueByName('Code').AsString <> '';
    if not Result then
      Result := Result or CheckParentIsXmj(ANode.Parent);
  end;

begin
  Result := False;
  if not Assigned(BillsCompileTree.Selected) then Exit;
  Result := CheckParentIsXmj(BillsCompileTree.Selected)
    and not CheckChildrenHasXmj(BillsCompileTree.Selected);
end;

function TBillsCompileData.CompareNodeCode(ANode,
  ACompareNode: TsdIDTreeNode): Integer;
begin
  if ANode.Rec.ValueByName('Code').AsString <> '' then
    Result := CompareCode(ANode.Rec.ValueByName('Code').AsString,
      ACompareNode.Rec.ValueByName('Code').AsString)
  else if ANode.Rec.ValueByName('B_Code').AsString <> '' then
    Result := CompareCode(ANode.Rec.ValueByName('B_Code').AsString,
      ACompareNode.Rec.ValueByName('B_Code').AsString);
end;

function TBillsCompileData.GetGclBillsParent(
  AChildNode: TsdIDTreeNode): TsdIDTreeNode;
begin
  if AChildNode.Rec.ValueByName('B_Code').AsString <> '' then
    Result := GetGclBillsParent(AChildNode.Parent)
  else
    Result := AChildNode;
end;

function TBillsCompileData.GetNextSiblingID(AParent,
  ANode: TsdIDTreeNode): Integer;
var
  stnCurNode: TsdIDTreeNode;
begin
  Result := -1;
  if Assigned(AParent) then
    stnCurNode := AParent.FirstChild
  else
    stnCurNode := BillsCompileTree.FirstNode;
  if not Assigned(stnCurNode) then Exit;

  while Assigned(stnCurNode) do
  begin
    if CompareNodeCode(stnCurNode, ANode) >= 0 then
    begin
      Result := stnCurNode.ID;
      Exit;
    end;
    stnCurNode := stnCurNode.NextSibling;
  end;
end;

function TBillsCompileData.GetTopParentNode(ANode: TsdIDTreeNode;
  ALevel: Integer): TsdIDTreeNode;
begin
  Result := ANode;
  while Assigned(Result.Parent) and (Result.Level + ALevel > ANode.Level) do
    Result := Result.Parent;
end;

function TBillsCompileData.IsSameNode(ANode,
  ACompareNode: TsdIDTreeNode): Boolean;
begin
  Result := (ANode.Rec.ValueByName('Code').AsString = ACompareNode.Rec.ValueByName('Code').AsString)
        and (ANode.Rec.ValueByName('B_Code').AsString = ACompareNode.Rec.ValueByName('B_Code').AsString)
        and (ANode.Rec.ValueByName('Name').AsString = ACompareNode.Rec.ValueByName('Name').AsString);
end;

function TBillsCompileData.FindChild(AParentNode,
  ANode: TsdIDTreeNode): TsdIDTreeNode;

  function FindSibling(AFirstNode, ANode: TsdIDTreeNode): TsdIDTreeNode;
  var
    stnCurNode: TsdIDTreeNode;
  begin
    Result := nil;
    stnCurNode := AFirstNode;
    while Assigned(stnCurNode) and not Assigned(Result) do
    begin
      if IsSameNode(ANode, stnCurNode) then
        Result := stnCurNode;
      stnCurNode := stnCurNode.NextSibling;
    end;
  end;

begin
  if not Assigned(AParentNode) then
    Result := FindSibling(BillsCompileTree.FirstNode, ANode)
  else
    Result := FindSibling(AParentNode.FirstChild, ANode);
end;

function TBillsCompileData.InsertChild(AParentNode,
  ANode: TsdIDTreeNode): TsdIDTreeNode;
var
  iNextSiblingID: Integer;
begin
  iNextSiblingID := GetNextSiblingID(AParentNode, ANode);
  if Assigned(AParentNode) then
    Result := BillsCompileTree.Add(AParentNode.ID, iNextSiblingID)
  else
    Result := BillsCompileTree.Add(-1, iNextSiblingID);
  Result.Rec.ValueByName('Code').AsString := ANode.Rec.ValueByName('Code').AsString;
  Result.Rec.ValueByName('B_Code').AsString := ANode.Rec.ValueByName('B_Code').AsString;
  Result.Rec.ValueByName('Name').AsString := ANode.Rec.ValueByName('Name').AsString;
  Result.Rec.ValueByName('Units').AsString := ANode.Rec.ValueByName('Unit').AsString;
end;

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

  procedure SetTextErrorHint(const AHint: string);
  begin
    ErrorMessage(AHint);
    Allow := False;
  end;

  procedure SetQuantity(const AFieldName: string);
  var
    sPre: string;
  begin
    sPre := StringReplace(AFieldName, 'Quantity', '', [rfIgnoreCase, rfReplaceAll]);
    if CheckStringNull(Text) or CheckNumeric(Text) then
      Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)))
    else
    begin
      ARecord.ValueByName(sPre + 'Formula').AsString := Text;
      Text := FloatToStr(QuantityRoundTo(EvaluateExprs(Text)));
    end;
    ARecord.ValueByName('CalcType').AsInteger := 0;
  end;

  procedure SetTotalPrice(const AFieldName: string);
  var
    sPre: string;
  begin
    sPre := StringReplace(AFieldName, 'TotalPrice', '', [rfIgnoreCase, rfReplaceAll]);
    if CheckStringNull(Text) or CheckNumeric(Text) then
      Text := FloatToStr(TotalPriceRoundTo(StrToFloatDef(Text, 0)))
    else
    begin
      ARecord.ValueByName(sPre + 'Formula').AsString := Text;
      Text := FloatToStr(TotalPriceRoundTo(EvaluateExprs(Text)));
    end;
    ARecord.ValueByName('CalcType').AsInteger := 1;
  end;

  procedure SetDgnQuantity;
  begin
    Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)));
  end;

  procedure SetPrice;
  begin
    Text := FloatToStr(PriceRoundTo(StrToFloatDef(Text, 0)));
  end;

  procedure DoCurChanged;
  begin
    if SameText(AColumn.FieldName, 'OrgQuantity') or
        SameText(AColumn.FieldName, 'MisQuantity') or
        SameText(AColumn.FieldName, 'OthQuantity')then
      SetQuantity(AColumn.FieldName)
    else if SameText(AColumn.FieldName, 'OrgTotalPrice') or
        SameText(AColumn.FieldName, 'MisTotalPrice') or
        SameText(AColumn.FieldName, 'OthTotalPrice') then
      SetTotalPrice(AColumn.FieldName)
    else if Pos('DgnQuantity', AColumn.FieldName) = 1 then
      SetDgnQuantity
    else if SameText(AColumn.FieldName, 'Price') then
      SetPrice;
  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') or
       SameText(AColumn.FieldName, 'OrgQuantity') or
       SameText(AColumn.FieldName, 'OrgTotalPrice') or
       SameText(AColumn.FieldName, 'MisQuantity') or
       SameText(AColumn.FieldName, 'MisTotalPrice') or
       SameText(AColumn.FieldName, 'OthQuantity') or
       SameText(AColumn.FieldName, 'OthTotalPrice') or
       SameText(AColumn.FieldName, 'DrawingCode')then
       if ARecord.ValueByName('LockedInfo').AsBoolean then
         SetTextErrorHint('清单信息已被锁定，不允许修改编号、名称、单位、清单单价、0号台账数量与金额、图号！');
  end;

  procedure CheckNodeWritable;
  var
    vNode: TBillsIDTreeNode;
    iCreatePhase: Integer;
  begin
    if not Allow then Exit;
    vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ARecord.ValueByName('ID').AsInteger));
    iCreatePhase := vNode.Rec.ValueByName('CreatePhaseID').AsInteger;

    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
        SetTextErrorHint('该清单有子计算项，不能直接修改！')
      else if (Pos('Price', AColumn.FieldName) > 0) then
        SetTextErrorHint('仅最底层清单可输入单价！');
      if not Allow then Exit;
    end
    else
    begin
      if SameText('OrgTotalPrice', AColumn.FieldName) or
          SameText('MisTotalPrice', AColumn.FieldName) or
          SameText('OthTotalPrice', AColumn.FieldName) then
      begin
        if not vNode.TotalPriceEnable then
          SetTextErrorHint('该清单不可直接输入金额，如需直接输入金额，请先清空所有数量、单价！');
      end;
      if not Allow then Exit;

      if SameText('Price', AColumn.FieldName) or
          SameText('OrgQuantity', AColumn.FieldName) or
          SameText('MisQuantity', AColumn.FieldName) or
          SameText('OthQuantity', AColumn.FieldName) then
      begin
        if not vNode.CountPriceEnable then
          SetTextErrorHint('该清单不可输入数量单价，如需使用数量×单价计算，请先清空所有直接输入的金额！');
      end;
      if not Allow then Exit;
    end;

    if SameText('Code', AColumn.FieldName) or
       SameText('B_Code', AColumn.FieldName) or
       SameText('Name', AColumn.FieldName) or
       SameText('Units', AColumn.FieldName) or
       SameText('Price', AColumn.FieldName) then
      if TBillsIDTreeNode(vNode).HasMeasure then
        SetTextErrorHint('该清单已经计量，不可修改清单编号');
  end;

begin
  if not Assigned(AValue) then Exit;
  // 修改后数据与原数据相同则不提交
  if (AValue.AsString = Text) or ((AValue.AsFloat = 0) and (Text = '')) 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;

function TBillsCompileData.GetActive: Boolean;
begin
  Result := sdvBillsCompile.Active;
end;

function TBillsCompileData.GetLeafXmjParentID(ABillsID: Integer): Integer;
var
  stnNode: TsdIDTreeNode;
begin
  stnNode := BillsCompileTree.FindNode(ABillsID);
  Result := GetGclBillsParent(stnNode).ID;
end;

procedure TBillsCompileData.sdvBillsCompileAfterOpen(Sender: TObject);
begin
  BillsCompileTree.Active := True;
end;

procedure TBillsCompileData.sdvBillsCompileAfterClose(Sender: TObject);
begin
  BillsCompileTree.Active := False;
end;

procedure TBillsCompileData.ReorderChildrenCode(ANode: TsdIDTreeNode);
var
  iChild: Integer;
  sParentCode: string;
  stnChild: TsdIDTreeNode;
begin
  if not Assigned(ANode) then Exit;
  sParentCode := ANode.Rec.ValueByName('Code').AsString;
  for iChild := 0 to ANode.ChildCount - 1 do
  begin
    stnChild := ANode.ChildNodes[iChild];
    if stnChild.Rec.ValueByName('Code').AsString <> '' then
      stnChild.Rec.ValueByName('Code').AsString := sParentCode + '-' + IntToStr(iChild + 1);
    ReorderChildrenCode(stnChild);
  end;
end;

procedure TBillsCompileData.sdvBillsCompileAfterAddRecord(
  ARecord: TsdDataRecord);
begin
  // 解锁前，新增清单为变更清单，解锁后，新增清单为0号台账清单
  if TProjectData(FProjectData).ProjProperties.PhaseCount > 0 then
    ARecord.ValueByName('IsMeasureAdd').AsBoolean := not TProjectData(FProjectData).CanUnlockInfo;
end;

procedure TBillsCompileData.DoOnAfterDeleteNode(AParent: TsdIDTreeNode);
begin
  if Assigned(AParent) and (AParent.ID > 0) then
    Calculate(AParent.ID);
end;

procedure TBillsCompileData.Close;
begin
  sdvBillsCompile.Close;
end;

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

procedure TBillsCompileData.sdvBillsCompileCurrentChanged(
  ARecord: TsdDataRecord);
begin
  if Assigned(FOnRecChange) then
    FOnRecChange(ARecord);
end;

procedure TBillsCompileData.ReLockBaseData;

  procedure LockNodeBaseData(ANode: TsdIDTreeNode);
  begin
    if not Assigned(ANode) then Exit;
    if ANode.Rec.ValueByName('LockedLevel').AsBoolean then
      if not ANode.Rec.ValueByName('LockedInfo').AsBoolean then
        ANode.Rec.ValueByName('LockedInfo').AsBoolean := True;
    LockNodeBaseData(ANode.FirstChild);
    LockNodeBaseData(ANode.NextSibling);
  end;

begin
  sdvBillsCompile.AfterValueChanged := nil;
  try
    LockNodeBaseData(FBillsCompileTree.FirstNode);
  finally
    sdvBillsCompile.AfterValueChanged := sdvBillsCompileAfterValueChanged;
  end;
end;

procedure TBillsCompileData.AddBillsFromDealBills(ARec: TsdDataRecord);
var
  stnParent, stnNode: TsdIDTreeNode;
begin
  if not CanAddGclBills then
    raise Exception.Create('当前节点下不可添加工程量清单！');

  stnParent := GetGclBillsParent(BillsCompileTree.Selected);
  if TBillsIDTreeNode(stnParent).HasLedger or
     (not stnParent.HasChildren and TBillsIDTreeNode(stnParent).HasMeasure) then
    raise Exception.Create('当前节点不可添加工程量清单！');

  stnNode := BillsCompileTree.Add(stnParent.ID, -1);
  stnNode.Rec.ValueByName('B_Code').AsString := ARec.ValueByName('B_Code').AsString;
  stnNode.Rec.ValueByName('Name').AsString := ARec.ValueByName('Name').AsString;
  stnNode.Rec.ValueByName('Units').AsString := ARec.ValueByName('Units').AsString;
  stnNode.Rec.ValueByName('Price').AsString := ARec.ValueByName('Price').AsString;
end;

procedure TBillsCompileData.CalculateMis(ABillsID: Integer);
var
  vNode: TBillsIDTreeNode;
  iChild: Integer;
begin
  vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  if not Assigned(vNode) then Exit;

  if vNode.HasChildren then
  begin
    for iChild := 0 to vNode.ChildCount - 1 do
      CalculateMis(vNode.ChildNodes[iChild].ID);
  end
  else
  begin
    with vNode.Rec do
    begin
      // 数量单价模式则计算金额
      if CalcType.AsInteger = 0 then
        MisTotalPrice.AsFloat := TotalPriceRoundTo(MisQuantity.AsFloat * Price.AsFloat);

      // 金额与修改前不一样，则向父项增量
      if MisTotalPrice.AsFloat <> CacheMisTP then
      begin
        UpdateParent(vNode.ParentID, MisTotalPrice.AsFloat - CacheMisTP, 'MisTotalPrice');
        Quantity.AsFloat := QuantityRoundTo(
            OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
        TotalPrice.AsFloat := TotalPriceRoundTo(
            OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
      end;
    end;
  end;

  CalculateDesignPrice(vNode);
end;

procedure TBillsCompileData.CalculateOrg(ABillsID: Integer);
var
  vNode: TBillsIDTreeNode;
  iChild: Integer;
begin
  vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  if not Assigned(vNode) then Exit;

  if vNode.HasChildren then
  begin
    for iChild := 0 to vNode.ChildCount - 1 do
      CalculateOrg(vNode.ChildNodes[iChild].ID);
  end
  else
  begin
    with vNode.Rec do
    begin
      // 数量单价模式则计算金额
      if CalcType.AsInteger = 0 then
        OrgTotalPrice.AsFloat := TotalPriceRoundTo(OrgQuantity.AsFloat * Price.AsFloat);

      // 金额与修改前不一样，则向父项增量
      if CacheOrgTP <> OrgTotalPrice.AsFloat then
      begin
        UpdateParent(vNode.ParentID, OrgTotalPrice.AsFloat - CacheOrgTP, 'OrgTotalPrice');
        Quantity.AsFloat := QuantityRoundTo(
            OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
        TotalPrice.AsFloat := TotalPriceRoundTo(
            OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
      end;
    end;
  end;

  CalculateDesignPrice(vNode);
end;

procedure TBillsCompileData.CalculateOth(ABillsID: Integer);
var
  vNode: TBillsIDTreeNode;
  iChild: Integer;
begin
  vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  if not Assigned(vNode) then Exit;

  if vNode.HasChildren then
  begin
    for iChild := 0 to vNode.ChildCount - 1 do
      CalculateOth(vNode.ChildNodes[iChild].ID);
  end
  else
  begin
    with vNode.Rec do
    begin
      // 数量单价模式则计算金额
      if CalcType.AsInteger = 0 then
        OthTotalPrice.AsFloat := TotalPriceRoundTo(OthQuantity.AsFloat * Price.AsFloat);

      // 金额与修改前不一样，则向父项增量
      if OthTotalPrice.AsFloat <> CacheOthTP then
      begin
        UpdateParent(vNode.ParentID, OthTotalPrice.AsFloat - CacheOthTP, 'OthTotalPrice');
        Quantity.AsFloat := QuantityRoundTo(
            OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
        TotalPrice.AsFloat := TotalPriceRoundTo(
            OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat+ OthTotalPrice.AsFloat);
      end;
    end;
  end;

  CalculateDesignPrice(vNode);
end;

function TBillsCompileData.GatherChildren(ANode: TsdIDTreeNode;
  const AFieldName: string): Double;
var
  iChild: Integer;
begin
  Result := 0;
  if not Assigned(ANode) then Exit;

  if ANode.HasChildren and Assigned(ANode.FirstChild) then
  begin
    Result := 0;
    for iChild := 0 to ANode.ChildCount - 1 do
      Result := Result + ANode.Rec.ValueByName(AFieldName).AsFloat;
    Result := TotalPriceRoundTo(Result);
  end
  else
    if Assigned(ANode.Rec) and Assigned(ANode.Rec.ValueByName(AFieldName)) then
      Result := ANode.Rec.ValueByName(AFieldName).AsFloat;
end;

procedure TBillsCompileData.UpdateParent(ABillsID: Integer;
  ADifferTotalPrice: Double; const AFieldName: string);
var
  vNode: TBillsIDTreeNode;
begin
  vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  if not Assigned(vNode) then Exit;

  with vNode.Rec do
  begin
    ValueByName(AFieldName).AsFloat := TotalPriceRoundTo(
        ValueByName(AFieldName).AsFloat + ADifferTotalPrice);
    TotalPrice.AsFloat := TotalPriceRoundTo(TotalPrice.AsFloat + ADifferTotalPrice);
  end;
  CalculateDesignPrice(vNode);
  UpdateParent(vNode.ParentID, ADifferTotalPrice, AFieldName);
end;

procedure TBillsCompileData.CalculateTotal(ABillsID: Integer);
begin
  CalculateOrg(ABillsID);
  CalculateMis(ABillsID);
  CalculateOth(ABillsID);
end;

procedure TBillsCompileData.CalculateBills(ANode: TsdIDTreeNode);
var
  iChild: Integer;
begin
  if not Assigned(ANode) then Exit;

  if ANode.HasChildren then
  begin
    for iChild := 0 to ANode.ChildCount - 1 do
      CalculateBills(ANode.ChildNodes[iChild]);
    GatherNode(TBillsIDTreeNode(ANode));
  end
  else
    CalculateLeaf(TBillsIDTreeNode(ANode));
end;

procedure TBillsCompileData.CalculateLeaf(ANode: TBillsIDTreeNode);
begin
  if not Assigned(ANode) or ANode.HasChildren then Exit;

  with ANode.Rec do
  begin
    // 分项
    if CalcType.AsFloat = 0 then
    begin
      OrgTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OrgQuantity.AsFloat);
      MisTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * MisQuantity.AsFloat);
      OthTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OthQuantity.AsFloat);
    end;
    // 汇总
    Quantity.AsFloat := QuantityRoundTo(
        OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
    TotalPrice.AsFloat := TotalPriceRoundTo(
        OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
  end;
  CalculateDesignPrice(ANode);
end;

procedure TBillsCompileData.GatherNode(ANode: TBillsIDTreeNode);
var
  iChild: Integer;
  fOrg, fMis, fOth: Double;
  vChild: TBillsIDTreeNode;
begin
  fOrg := 0;
  fMis := 0;
  fOth := 0;
  for iChild := 0 to ANode.ChildCount - 1 do
  begin
    vChild := TBillsIDTreeNode(ANode.ChildNodes[iChild]);
    fOrg := fOrg + vChild.Rec.OrgTotalPrice.AsFloat;
    fMis := fMis + vChild.Rec.MisTotalPrice.AsFloat;
    fOth := fOth + vChild.Rec.OthTotalPrice.AsFloat;
  end;
  ANode.Rec.OrgTotalPrice.AsFloat := TotalPriceRoundTo(fOrg);
  ANode.Rec.MisTotalPrice.AsFloat := TotalPriceRoundTo(fMis);
  ANode.Rec.OthTotalPrice.AsFloat := TotalPriceRoundTo(fOth);
  ANode.Rec.TotalPrice.AsFloat := TotalPriceRoundTo(fOrg + fMis + fOth);

  CalculateDesignPrice(ANode);
end;

procedure TBillsCompileData.Calculate(ABillsID: Integer);

  procedure UpdateParent(ANode: TBillsIDTreeNode; ADifferOrg, ADifferMis, ADifferOth: Double);
  begin
    if not Assigned(ANode) then Exit;

    with ANode.Rec do
    begin
      OrgTotalPrice.AsFloat := TotalPriceRoundTo(OrgTotalPrice.AsFloat + ADifferOrg);
      MisTotalPrice.AsFloat := TotalPriceRoundTo(MisTotalPrice.AsFloat + ADifferMis);
      OthTotalPrice.AsFloat := TotalPriceRoundTo(OthTotalPrice.AsFloat + ADifferOth);
      TotalPrice.AsFloat := TotalPriceRoundTo(
          TotalPrice.AsFloat + ADifferOrg + ADifferMis + ADifferOth);
      if DgnQuantity1.AsFloat <> 0 then
        DgnPrice.AsFloat := PriceRoundTo(TotalPrice.AsFloat/DgnQuantity1.AsFloat);
    end;

    UpdateParent(TBillsIDTreeNode(ANode.Parent), ADifferOrg, ADifferMis, ADifferOth);
  end;

var
  vNode: TBillsIDTreeNode;
  iChild: Integer;
  fOrg, fMis, fOth: Double;
begin
  vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  if not Assigned(vNode) then Exit;

  fOrg := vNode.Rec.OrgTotalPrice.AsFloat;
  fMis := vNode.Rec.MisTotalPrice.AsFloat;
  fOth := vNode.Rec.OthTotalPrice.AsFloat;

  CalculateBills(vNode);

  fOrg := vNode.Rec.OrgTotalPrice.AsFloat - fOrg;
  fMis := vNode.Rec.MisTotalPrice.AsFloat - fMis;
  fOth := vNode.Rec.OthTotalPrice.AsFloat - fOth;

  UpdateParent(TBillsIDTreeNode(vNode.Parent), fOrg, fMis, fOth);
end;

procedure TBillsCompileData.CalculateDesignPrice(ANode: TBillsIDTreeNode);
begin
  if ANode.Rec.DgnQuantity1.AsFloat <> 0 then
    ANode.Rec.DgnPrice.AsFloat := PriceRoundTo(
        ANode.Rec.TotalPrice.AsFloat/ANode.Rec.DgnQuantity1.AsFloat)
  else
    ANode.Rec.DgnPrice.Clear;
end;

procedure TBillsCompileData.ExpandPegXmjNode;

  function HasPegChild(ANode: TBillsIDTreeNode): Boolean;
  var
    NextNode: TBillsIDTreeNode;
  begin
    Result := False;
    NextNode := TBillsIDTreeNode(ANode.NextNode);
    while ((NextNode.MajorIndex - ANode.MajorIndex) <= ANode.PosterityCount) do
    begin
      if CheckPeg(NextNode.Rec.Name.AsString) then
      begin
        Result := True;
        Break;
      end;
      NextNode := TBillsIDTreeNode(NextNode.NextNode);
    end;
  end;

  function HasGclChild(ANode: TBillsIDTreeNode): Boolean;
  var
    vChild: TBillsIDTreeNode;
  begin
    Result := True;
    vChild := TBillsIDTreeNode(ANode.FirstChild);
    while Assigned(vChild) and not Result do
    begin
      if vChild.Rec.B_Code.AsString <> '' then
        Result := False;
      vChild := TBillsIDTreeNode(vChild.NextSibling);
    end;
  end;

var
  iIndex: Integer;
  vNode: TBillsIDTreeNode;
begin
  for iIndex := 0 to BillsCompileTree.Count - 1 do
  begin
    vNode := TBillsIDTreeNode(BillsCompileTree.Items[iIndex]);
    if vNode.HasChildren then
      vNode.Expanded := HasPegChild(vNode) or not HasGclChild(vNode);
  end;
end;

end.