unit BillsCompileDm; interface uses 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: TBillsIDTree; FBeforeChangeParentID: Integer; 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 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 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; 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); var fDgnPrice: Double; begin if AValue.DataType = ftFloat then begin if Assigned(AValue) and (AValue.AsFloat = 0) then Text := ''; end; 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 stnNode: TsdIDTreeNode; begin if SameText(AValue.FieldName, 'OrgQuantity') then CalculateOrg(AValue.Owner.ValueByName('ID').AsInteger) else if SameText(AValue.FieldName, 'MisQuantity') then CalculateMis(AValue.Owner.ValueByName('ID').AsInteger) else if SameText(AValue.FieldName, 'OthQuantity') 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 = 'ParentID') then begin Calculate(FBeforeChangeParentID); Calculate(AValue.AsInteger); end; 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, 'ParentID') then FBeforeChangeParentID := AValue.AsInteger; 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; begin // 0号台账改为三项合计后,不记录输入的功能,但允许公式计算 if CheckStringNull(Text) or CheckNumeric(Text) then Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0))) else Text := FloatToStr(QuantityRoundTo(EvaluateExprs(Text))); 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 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: TsdIDTreeNode; iCreatePhase: Integer; begin if not Allow then Exit; vNode := BillsCompileTree.FindNode(ARecord.ValueByName('ID').AsInteger); iCreatePhase := vNode.Rec.ValueByName('CreatePhaseID').AsInteger; if vNode.ID = iPriceMarginID then SetTextErrorHint(sBills_PMHint); if vNode.HasChildren then begin if Text = '' then Exit else if (SameText('Quantity', AColumn.FieldName)) or (SameText('TotalPrice', AColumn.FieldName)) then SetTextErrorHint('该清单有子计算项,不能直接修改!') else if (Pos('Price', AColumn.FieldName) > 0) then SetTextErrorHint('仅最底层清单可输入单价!'); end else if (Pos('TotalPrice', AColumn.FieldName) > 0) and (vNode.Rec.ValueByName('Price').AsFloat <> 0) then SetTextErrorHint('不可直接输入!如需直接输入金额,请先删除清单单价!'); 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(vNode).HasMeasure then SetTextErrorHint('该清单已经计量,不可修改清单编号'); end; begin if not Assigned(AValue) then Exit; // 修改后数据与原数据相同则不提交 if AValue.AsString = Text then Exit; CheckLockedData; 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; fTotalPrice: Double; 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 fTotalPrice := TotalPriceRoundTo(MisQuantity.AsFloat * Price.AsFloat); if MisTotalPrice.AsFloat <> fTotalPrice then begin UpdateParent(vNode.ParentID, fTotalPrice - MisTotalPrice.AsFloat, 'MisTotalPrice'); MisTotalPrice.AsFloat := fTotalPrice; Quantity.AsFloat := QuantityRoundTo( OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat); TotalPrice.AsFloat := TotalPriceRoundTo( OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat); end; end; end; if vNode.Rec.DgnQuantity1.AsFloat <> 0 then vNode.Rec.DgnPrice.AsFloat := PriceRoundTo( vNode.Rec.TotalPrice.AsFloat/vNode.Rec.DgnQuantity1.AsFloat) else vNode.Rec.DgnPrice.AsFloat := 0; end; procedure TBillsCompileData.CalculateOrg(ABillsID: Integer); var vNode: TBillsIDTreeNode; fTotalPrice: Double; 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 fTotalPrice := TotalPriceRoundTo(OrgQuantity.AsFloat * Price.AsFloat); if OrgTotalPrice.AsFloat <> fTotalPrice then begin UpdateParent(vNode.ParentID, fTotalPrice - OrgTotalPrice.AsFloat, 'OrgTotalPrice'); OrgTotalPrice.AsFloat := fTotalPrice; Quantity.AsFloat := QuantityRoundTo( OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat); TotalPrice.AsFloat := TotalPriceRoundTo( OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat); end; end; end; if vNode.Rec.DgnQuantity1.AsFloat <> 0 then vNode.Rec.DgnPrice.AsFloat := PriceRoundTo( vNode.Rec.TotalPrice.AsFloat/vNode.Rec.DgnQuantity1.AsFloat) else vNode.Rec.DgnPrice.AsFloat := 0; end; procedure TBillsCompileData.CalculateOth(ABillsID: Integer); var vNode: TBillsIDTreeNode; fTotalPrice: Double; 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 fTotalPrice := TotalPriceRoundTo(OthQuantity.AsFloat * Price.AsFloat); if OthTotalPrice.AsFloat <> fTotalPrice then begin UpdateParent(vNode.ParentID, fTotalPrice - OthTotalPrice.AsFloat, 'OthTotalPrice'); OthTotalPrice.AsFloat := fTotalPrice; Quantity.AsFloat := QuantityRoundTo( OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat); TotalPrice.AsFloat := TotalPriceRoundTo( OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat+ OthTotalPrice.AsFloat); end; end; end; if vNode.Rec.DgnQuantity1.AsFloat <> 0 then vNode.Rec.DgnPrice.AsFloat := PriceRoundTo( vNode.Rec.TotalPrice.AsFloat/vNode.Rec.DgnQuantity1.AsFloat) else vNode.Rec.DgnPrice.AsFloat := 0; 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); if DgnQuantity1.AsFloat <> 0 then DgnPrice.AsFloat := PriceRoundTo(TotalPrice.AsFloat/DgnQuantity1.AsFloat); end; 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 // 分项 OrgTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OrgQuantity.AsFloat); MisTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * MisQuantity.AsFloat); OthTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OthQuantity.AsFloat); // 汇总 Quantity.AsFloat := QuantityRoundTo( OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat); TotalPrice.AsFloat := TotalPriceRoundTo( OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat); // 经济指标 if DgnQuantity1.AsFloat <> 0 then DgnPrice.AsFloat := PriceRoundTo(TotalPrice.AsFloat/DgnQuantity1.AsFloat); end; 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); if ANode.Rec.DgnQuantity1.AsFloat <> 0 then ANode.Rec.DgnPrice.AsFloat := PriceRoundTo( ANode.Rec.TotalPrice.AsFloat/ANode.Rec.DgnQuantity1.AsFloat); 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; end.