| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186 | 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;{$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    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    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;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 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.
 |