| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194 | unit BillsCompileDm;interfaceuses  BillsDm, StandardBillsFme,  SysUtils, Classes, sdDB, BillsTree, sdIDTree, DB;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: TCompileBillsIDTree;    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: TCompileBillsIDTree read FBillsCompileTree;    property Active: Boolean read GetActive;    property OnRecChange: TRecChangeEvent read FOnRecChange write SetOnRecChange;  end;implementationuses  ProjectData, Math, ZhAPI, UtilMethods, ConstUnit, mDataRecord, Variants,  ConditionalDefines;{$R *.dfm}{ TBillsCompileData }constructor TBillsCompileData.Create(AProjectData: TObject);begin  inherited Create(nil);  FProjectData := AProjectData;  FBillsData := TProjectData(FProjectData).BillsData;  FBillsCompileTree := TCompileBillsIDTree.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.OnReCalcNode := 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;    sFormulaField: string;  begin    sFormula := '';    if ARecord.ValueByName('CalcType').AsInteger = 0 then    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;    end    else if ARecord.ValueByName('CalcType').AsInteger = 1 then    begin      if SameText('OrgTotalPrice', AColumn.FieldName) then        sFormula := ARecord.ValueByName('OrgFormula').AsString      else if SameText('MisTotalPrice', AColumn.FieldName) then        sFormula := ARecord.ValueByName('MisFormula').AsString      else if SameText('OthTotalPrice', AColumn.FieldName) then        sFormula := ARecord.ValueByName('OthFormula').AsString;    end;    if sFormula <> '' then      Text := sFormula;  end;  procedure GetDisplayText;  begin    if AValue.DataType = ftFloat then    begin      if not Assigned(AValue) or (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: TBillsIDTreeNode;begin  for iIndex := 0 to BillsCompileTree.Count - 1 do  begin    stnNode := TBillsIDTreeNode(BillsCompileTree.Items[iIndex]);    if (stnNode.ParentID <> -1) then      stnNode.Parent.Expanded := stnNode.Rec.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  vNode: TBillsIDTreeNode;begin  vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(AValue.Owner.ValueByName('ID').AsInteger));  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') then    CalculateTotal(AValue.Owner.ValueByName('ID').AsInteger)  else if SameText(AValue.FieldName, 'DgnQuantity1') then    CalculateDesignPrice(vNode);  if (AValue.FieldName = 'LockedInfo') then    ResetChildrenLockedInfo(vNode, AValue.AsBoolean);  if (AValue.FieldName = 'B_Code') then  begin    AValue.Owner.ValueByName('DgnQuantity1').Clear;    AValue.Owner.ValueByName('DgnQuantity2').Clear;    AValue.Owner.ValueByName('DgnPrice').Clear;  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, '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 if Assigned(stnCurNode) then    begin      if TBillsIDTreeNode(stnCurNode).HasLedger or          (not stnCurNode.HasChildren and TBillsIDTreeNode(stnCurNode).HasMeasure) then        raise Exception.Create('不可添加该项目节数据!')      else        stnCurNode := InsertChild(stnCurNode, stnStdNode);    end    else      Break;    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  if ANode.Rec.ValueByName('StaticID').AsInteger > 0 then    Result := (ANode.Rec.ValueByName('StaticID').AsInteger = ACompareNode.Rec.ValueByName('ID').AsInteger)  else    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  iID, iNextSiblingID: Integer;begin  iNextSiblingID := GetNextSiblingID(AParentNode, ANode);  iID := ANode.Rec.ValueByName('StaticID').AsInteger;  if Assigned(AParentNode) then    Result := BillsCompileTree.AddNode(AParentNode.ID, iNextSiblingID, iID)  else    Result := BillsCompileTree.AddNode(-1, iNextSiblingID, iID);  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    begin      ARecord.ValueByName(sPre + 'Formula').AsString := '';      Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)));    end    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    begin      ARecord.ValueByName(sPre + 'Formula').AsString := '';      Text := FloatToStr(TotalPriceRoundTo(StrToFloatDef(Text, 0)));    end    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)));    ARecord.ValueByName('CalcType').AsInteger := 0;  end;  procedure DoCurChanged(ANode: TBillsIDTreeNode);  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    else if SameText(AColumn.FieldName, 'Code') then      BillsCompileTree.RecodeChildrenCode(ANode, AValue.AsString, Text)    else if SameText(AColumn.FieldName, 'B_Code') then      BillsCompileTree.RecodeChildrenB_Code(ANode, AValue.AsString, Text);  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(ANode: TBillsIDTreeNode);  var    iCreatePhase: Integer;  begin    if not Allow then Exit;    iCreatePhase := ANode.Rec.ValueByName('CreatePhaseID').AsInteger;    if ANode.ID = iPriceMarginID then      SetTextErrorHint(sBills_PMHint);    if ANode.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 ANode.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 ANode.CountPriceEnable then          SetTextErrorHint('该清单不可输入数量单价,如需使用数量×单价计算,请先清空所有直接输入的金额!');      end;      if not Allow then Exit;    end;    // 清单编号和项目节编号不可同时存在    if SameText(AValue.FieldName, 'Code') then    begin      if AValue.Owner.ValueByName('B_Code').AsString <> '' then        SetTextErrorHint('已存在清单编号,不可输入项目节编号!');    end    else if SameText(AValue.FieldName, 'B_Code') then    begin      if AValue.Owner.ValueByName('Code').AsString <> '' then        SetTextErrorHint('已存在项目节编号,不可输入清单编号!');    end    //    else if SameText(AValue.FieldName, 'Price') then    begin      if AValue.Owner.ValueByName('AddGatherTotalPrice').AsFloat <> 0 then        SetTextErrorHint('该清单已经开始计量,不可修改单价!');    end    // 变更清单不可修改0号台账数据    else if SameText(AValue.FieldName, 'OrgQuantity') or        SameText(AValue.FieldName, 'OrgTotalPrice') or        SameText(AValue.FieldName, 'MisQuantity') or        SameText(AValue.FieldName, 'MisTotalPrice') or        SameText(AValue.FieldName, 'OthQuantity') or        SameText(AValue.FieldName, 'OthTotalPrice') then    begin      if AValue.Owner.ValueByName('IsMeasureAdd').AsBoolean then        SetTextErrorHint('变更清单不可填写0号台账数量与金额');    end;    if not Allow then Exit;    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(ANode).HasMeasure then        SetTextErrorHint('该清单已经计量,不可修改清单编号');  end;  function CheckValidData: Boolean;  begin    Result := (AValue.AsString <> Text);    if 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, 'Price') then    begin      if (AValue.AsFloat = 0) and (Text = '') then        Result := False;    end;  end;var  vNode: TBillsIDTreeNode;begin  if not Assigned(AValue) then Exit;  // 修改后数据与原数据相同则不提交  if not CheckValidData then    Allow := False;  if not Allow then Exit;  vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ARecord.ValueByName('ID').AsInteger));  CheckLockedData;  if not Allow then Exit;  CheckNodeWritable(vNode);  if not Allow then Exit;  Text := Trim(Text);  if Pos('=', Text) = 1 then    Text := Copy(Text, 2, Length(Text) - 1);  DoCurChanged(vNode);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);      SetFloatValue(Quantity, QuantityRoundTo(          OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat));       // 金额与修改前不一样,则向父项增量      if MisTotalPrice.AsFloat <> CacheMisTP then      begin        UpdateParent(vNode.ParentID, MisTotalPrice.AsFloat - CacheMisTP, 'MisTotalPrice');        TotalPrice.AsFloat := TotalPriceRoundTo(            OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);        CacheMisTP := MisTotalPrice.AsFloat;      end;    end;  end;  CalculateDesignPrice(vNode);end;procedure TBillsCompileData.CalculateOrg(ABillsID: Integer);var  vNode: TBillsIDTreeNode;  iChild: Integer;  fValue: Double;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);      SetFloatValue(Quantity, QuantityRoundTo(          OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat));      // 金额与修改前不一样,则向父项增量      if CacheOrgTP <> OrgTotalPrice.AsFloat then      begin        UpdateParent(vNode.ParentID, OrgTotalPrice.AsFloat - CacheOrgTP, 'OrgTotalPrice');        TotalPrice.AsFloat := TotalPriceRoundTo(            OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);        CacheOrgTP := OrgTotalPrice.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);      SetFloatValue(Quantity, QuantityRoundTo(          OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat));      // 金额与修改前不一样,则向父项增量      if OthTotalPrice.AsFloat <> CacheOthTP then      begin        UpdateParent(vNode.ParentID, OthTotalPrice.AsFloat - CacheOthTP, 'OthTotalPrice');        TotalPrice.AsFloat := TotalPriceRoundTo(            OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat+ OthTotalPrice.AsFloat);        CacheOthTP := 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 QuantityRoundTo(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.
 |