unit BillsCompileDm; interface uses BillsDm, StandardBillsFme, SysUtils, Classes, sdDB, BillsTree, sdIDTree; type TBillsCompileData = class(TDataModule) sdvBillsCompile: TsdDataView; procedure sdvBillsCompileGetText(var Text: String; ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn; DisplayText: Boolean); procedure sdvBillsCompileAfterValueChanged(AValue: TsdValue); procedure sdvBillsCompileBeforeValueChange(AValue: TsdValue; const NewValue: Variant; var Allow: Boolean); procedure sdvBillsCompileSetText(var Text: String; ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn; var Allow: Boolean); procedure sdvBillsCompileAfterOpen(Sender: TObject); procedure sdvBillsCompileAfterClose(Sender: TObject); procedure sdvBillsCompileAfterAddRecord(ARecord: TsdDataRecord); procedure sdvBillsCompileCurrentChanged(ARecord: TsdDataRecord); private FProjectData: TObject; FBillsData: TBillsData; FBillsCompileTree: TBillsIDTree; 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 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 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); procedure GetEditText; var sFormula: string; begin if SameText('OrgQuantity', AColumn.FieldName) then sFormula := ARecord.ValueByName('OrgFormula').AsString else if SameText('MisQuantity', AColumn.FieldName) then sFormula := ARecord.ValueByName('MisFormula').AsString else if SameText('OthQuantity', AColumn.FieldName) then sFormula := ARecord.ValueByName('OthFormula').AsString else sFormula := ''; if sFormula <> '' then Text := sFormula; end; procedure GetDisplayText; begin if (Pos('Price', AColumn.FieldName) > 0) or (Pos('Quantity', AColumn.FieldName) > 0) then begin if Assigned(AValue) and (AValue.AsFloat = 0) then Text := ''; end; end; begin if DisplayText then GetDisplayText else GetEditText; end; procedure TBillsCompileData.ExpandNodeTo(ALevel: Integer); begin BillsCompileTree.ExpandLevel := ALevel; end; procedure TBillsCompileData.ExpandXmjNode; var iIndex: Integer; stnNode: TsdIDTreeNode; begin for iIndex := 0 to BillsCompileTree.Count - 1 do begin stnNode := BillsCompileTree.Items[iIndex]; if (stnNode.ParentID <> -1) then stnNode.Parent.Expanded := stnNode.Rec.ValueByName('B_Code').AsString = ''; end; end; procedure TBillsCompileData.sdvBillsCompileAfterValueChanged( AValue: TsdValue); procedure ResetChildrenLockedInfo(ANode: TsdIDTreeNode; ALockedInfo: Boolean); var iChild: Integer; begin if not Assigned(ANode) then Exit; if ANode.Rec.ValueByName('LockedLevel').AsBoolean then ANode.Rec.ValueByName('LockedInfo').AsBoolean := ALockedInfo; if ANode.HasChildren then for iChild := 0 to ANode.ChildCount - 1 do ResetChildrenLockedInfo(ANode.ChildNodes[iChild], ALockedInfo); end; var stnNode: TsdIDTreeNode; begin if SameText(AValue.FieldName, 'OrgQuantity') or SameText(AValue.FieldName, 'OrgTotalPrice') then CalculateOrg(AValue.Owner.ValueByName('ID').AsInteger) else if SameText(AValue.FieldName, 'MisQuantity') or SameText(AValue.FieldName, 'MisTotalPrice') then CalculateMis(AValue.Owner.ValueByName('ID').AsInteger) else if SameText(AValue.FieldName, 'OthQuantity') or SameText(AValue.FieldName, 'OthTotalPrice') then CalculateOth(AValue.Owner.ValueByName('ID').AsInteger) else if SameText(AValue.FieldName, 'Price') or SameText(AValue.FieldName, 'DgnQuantity1') then CalculateTotal(AValue.Owner.ValueByName('ID').AsInteger); if (AValue.FieldName = '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; 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 APre: string); begin // 0号台账改为三项合计后,不记录输入的公式,但允许公式计算 if CheckStringNull(Text) or CheckNumeric(Text) then Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0))) else begin ARecord.ValueByName(APre + 'Formula').AsString := Text; Text := FloatToStr(QuantityRoundTo(EvaluateExprs(Text))); end; ARecord.ValueByName('CalcType').AsInteger := 0; end; procedure SetTotalPrice; begin Text := FloatToStr(TotalPriceRoundTo(StrToFloatDef(Text, 0))); ARecord.ValueByName('CalcType').AsInteger := 1; end; procedure SetDgnQuantity; begin Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0))); end; procedure SetPrice; begin Text := FloatToStr(PriceRoundTo(StrToFloatDef(Text, 0))); end; procedure DoCurChanged; begin if SameText(AColumn.FieldName, 'OrgQuantity') then SetQuantity('Org') else if SameText(AColumn.FieldName, 'MisQuantity') then SetQuantity('Mis') else if SameText(AColumn.FieldName, 'OthQuantity') then SetQuantity('Oth') else if SameText(AColumn.FieldName, 'OrgTotalPrice') or SameText(AColumn.FieldName, 'MisTotalPrice') or SameText(AColumn.FieldName, 'OthTotalPrice') then SetTotalPrice else if Pos('DgnQuantity', AColumn.FieldName) = 1 then SetDgnQuantity else if SameText(AColumn.FieldName, 'Price') then SetPrice; end; procedure CheckLockedData; begin if SameText(AColumn.FieldName, 'Code') or SameText(AColumn.FieldName, 'B_Code') or SameText(AColumn.FieldName, 'Name') or SameText(AColumn.FieldName, 'Units') or SameText(AColumn.FieldName, 'Price') or SameText(AColumn.FieldName, 'OrgQuantity') or SameText(AColumn.FieldName, 'OrgTotalPrice') or SameText(AColumn.FieldName, 'MisQuantity') or SameText(AColumn.FieldName, 'MisTotalPrice') or SameText(AColumn.FieldName, 'OthQuantity') or SameText(AColumn.FieldName, 'OthTotalPrice') or SameText(AColumn.FieldName, 'DrawingCode')then if ARecord.ValueByName('LockedInfo').AsBoolean then SetTextErrorHint('清单信息已被锁定,不允许修改编号、名称、单位、清单单价、0号台账数量与金额、图号!'); end; procedure CheckNodeWritable; var vNode: TBillsIDTreeNode; iCreatePhase: Integer; begin if not Allow then Exit; vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ARecord.ValueByName('ID').AsInteger)); iCreatePhase := vNode.Rec.ValueByName('CreatePhaseID').AsInteger; if vNode.HasChildren then begin if Text = '' then Exit else if (Pos('Quantity', AColumn.FieldName) > 0) or (Pos('TotalPrice', AColumn.FieldName) > 0) then SetTextErrorHint('该清单有子计算项,不能直接修改!') else if (Pos('Price', AColumn.FieldName) > 0) then SetTextErrorHint('仅最底层清单可输入单价!'); if not Allow then Exit; end else begin if SameText('OrgTotalPrice', AColumn.FieldName) or SameText('MisTotalPrice', AColumn.FieldName) or SameText('OthTotalPrice', AColumn.FieldName) then begin if not vNode.TotalPriceEnable then SetTextErrorHint('该清单不可直接输入金额,如需直接输入金额,请先清空所有数量、单价!'); end; if not Allow then Exit; if SameText('Price', AColumn.FieldName) or SameText('OrgQuantity', AColumn.FieldName) or SameText('MisQuantity', AColumn.FieldName) or SameText('OthQuantity', AColumn.FieldName) then begin if not vNode.CountPriceEnable then SetTextErrorHint('该清单不可输入数量单价,如需使用数量×单价计算,请先清空所有直接输入的金额!'); end; if not Allow then Exit; end; if SameText('Code', AColumn.FieldName) or SameText('B_Code', AColumn.FieldName) or SameText('Name', AColumn.FieldName) or SameText('Units', AColumn.FieldName) or SameText('Price', AColumn.FieldName) then if TBillsIDTreeNode(vNode).HasMeasure then SetTextErrorHint('该清单已经计量,不可修改清单编号'); end; begin if not Assigned(AValue) then Exit; // 修改后数据与原数据相同则不提交 if AValue.AsString = Text then Exit; CheckLockedData; if not Allow then Exit; CheckNodeWritable; if not Allow then Exit; Text := Trim(Text); if Pos('=', Text) = 1 then Text := Copy(Text, 2, Length(Text) - 1); DoCurChanged; end; function TBillsCompileData.GetActive: Boolean; begin Result := sdvBillsCompile.Active; end; function TBillsCompileData.GetLeafXmjParentID(ABillsID: Integer): Integer; var stnNode: TsdIDTreeNode; begin stnNode := BillsCompileTree.FindNode(ABillsID); Result := GetGclBillsParent(stnNode).ID; end; procedure TBillsCompileData.sdvBillsCompileAfterOpen(Sender: TObject); begin BillsCompileTree.Active := True; end; procedure TBillsCompileData.sdvBillsCompileAfterClose(Sender: TObject); begin BillsCompileTree.Active := False; end; procedure TBillsCompileData.ReorderChildrenCode(ANode: TsdIDTreeNode); var iChild: Integer; sParentCode: string; stnChild: TsdIDTreeNode; begin if not Assigned(ANode) then Exit; sParentCode := ANode.Rec.ValueByName('Code').AsString; for iChild := 0 to ANode.ChildCount - 1 do begin stnChild := ANode.ChildNodes[iChild]; if stnChild.Rec.ValueByName('Code').AsString <> '' then stnChild.Rec.ValueByName('Code').AsString := sParentCode + '-' + IntToStr(iChild + 1); ReorderChildrenCode(stnChild); end; end; procedure TBillsCompileData.sdvBillsCompileAfterAddRecord( ARecord: TsdDataRecord); begin // 解锁前,新增清单为变更清单,解锁后,新增清单为0号台账清单 if TProjectData(FProjectData).ProjProperties.PhaseCount > 0 then ARecord.ValueByName('IsMeasureAdd').AsBoolean := not TProjectData(FProjectData).CanUnlockInfo; end; procedure TBillsCompileData.DoOnAfterDeleteNode(AParent: TsdIDTreeNode); begin if Assigned(AParent) and (AParent.ID > 0) then Calculate(AParent.ID); end; procedure TBillsCompileData.Close; begin sdvBillsCompile.Close; end; procedure TBillsCompileData.SetOnRecChange(const Value: TRecChangeEvent); begin FOnRecChange := Value; end; procedure TBillsCompileData.sdvBillsCompileCurrentChanged( ARecord: TsdDataRecord); begin if Assigned(FOnRecChange) then FOnRecChange(ARecord); end; procedure TBillsCompileData.ReLockBaseData; procedure LockNodeBaseData(ANode: TsdIDTreeNode); begin if not Assigned(ANode) then Exit; if ANode.Rec.ValueByName('LockedLevel').AsBoolean then if not ANode.Rec.ValueByName('LockedInfo').AsBoolean then ANode.Rec.ValueByName('LockedInfo').AsBoolean := True; LockNodeBaseData(ANode.FirstChild); LockNodeBaseData(ANode.NextSibling); end; begin sdvBillsCompile.AfterValueChanged := nil; try LockNodeBaseData(FBillsCompileTree.FirstNode); finally sdvBillsCompile.AfterValueChanged := sdvBillsCompileAfterValueChanged; end; end; procedure TBillsCompileData.AddBillsFromDealBills(ARec: TsdDataRecord); var stnParent, stnNode: TsdIDTreeNode; begin if not CanAddGclBills then raise Exception.Create('当前节点下不可添加工程量清单!'); stnParent := GetGclBillsParent(BillsCompileTree.Selected); if TBillsIDTreeNode(stnParent).HasLedger or (not stnParent.HasChildren and TBillsIDTreeNode(stnParent).HasMeasure) then raise Exception.Create('当前节点不可添加工程量清单!'); stnNode := BillsCompileTree.Add(stnParent.ID, -1); stnNode.Rec.ValueByName('B_Code').AsString := ARec.ValueByName('B_Code').AsString; stnNode.Rec.ValueByName('Name').AsString := ARec.ValueByName('Name').AsString; stnNode.Rec.ValueByName('Units').AsString := ARec.ValueByName('Units').AsString; stnNode.Rec.ValueByName('Price').AsString := ARec.ValueByName('Price').AsString; end; procedure TBillsCompileData.CalculateMis(ABillsID: Integer); var vNode: TBillsIDTreeNode; iChild: Integer; begin vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID)); if not Assigned(vNode) then Exit; if vNode.HasChildren then begin for iChild := 0 to vNode.ChildCount - 1 do CalculateMis(vNode.ChildNodes[iChild].ID); end else begin with vNode.Rec do begin // 数量单价模式则计算金额 if CalcType.AsInteger = 0 then MisTotalPrice.AsFloat := TotalPriceRoundTo(MisQuantity.AsFloat * Price.AsFloat); // 金额与修改前不一样,则向父项增量 if MisTotalPrice.AsFloat <> CacheMisTP then begin UpdateParent(vNode.ParentID, MisTotalPrice.AsFloat - CacheMisTP, 'MisTotalPrice'); Quantity.AsFloat := QuantityRoundTo( OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat); TotalPrice.AsFloat := TotalPriceRoundTo( OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat); end; end; end; CalculateDesignPrice(vNode); end; procedure TBillsCompileData.CalculateOrg(ABillsID: Integer); var vNode: TBillsIDTreeNode; iChild: Integer; begin vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID)); if not Assigned(vNode) then Exit; if vNode.HasChildren then begin for iChild := 0 to vNode.ChildCount - 1 do CalculateOrg(vNode.ChildNodes[iChild].ID); end else begin with vNode.Rec do begin // 数量单价模式则计算金额 if CalcType.AsInteger = 0 then OrgTotalPrice.AsFloat := TotalPriceRoundTo(OrgQuantity.AsFloat * Price.AsFloat); // 金额与修改前不一样,则向父项增量 if CacheOrgTP <> OrgTotalPrice.AsFloat then begin UpdateParent(vNode.ParentID, OrgTotalPrice.AsFloat - CacheOrgTP, 'OrgTotalPrice'); Quantity.AsFloat := QuantityRoundTo( OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat); TotalPrice.AsFloat := TotalPriceRoundTo( OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat); end; end; end; CalculateDesignPrice(vNode); end; procedure TBillsCompileData.CalculateOth(ABillsID: Integer); var vNode: TBillsIDTreeNode; iChild: Integer; begin vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID)); if not Assigned(vNode) then Exit; if vNode.HasChildren then begin for iChild := 0 to vNode.ChildCount - 1 do CalculateOth(vNode.ChildNodes[iChild].ID); end else begin with vNode.Rec do begin // 数量单价模式则计算金额 if CalcType.AsInteger = 0 then OthTotalPrice.AsFloat := TotalPriceRoundTo(OthQuantity.AsFloat * Price.AsFloat); // 金额与修改前不一样,则向父项增量 if OthTotalPrice.AsFloat <> CacheOthTP then begin UpdateParent(vNode.ParentID, OthTotalPrice.AsFloat - CacheOthTP, 'OthTotalPrice'); Quantity.AsFloat := QuantityRoundTo( OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat); TotalPrice.AsFloat := TotalPriceRoundTo( OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat+ OthTotalPrice.AsFloat); end; end; end; CalculateDesignPrice(vNode); end; function TBillsCompileData.GatherChildren(ANode: TsdIDTreeNode; const AFieldName: string): Double; var iChild: Integer; begin Result := 0; if not Assigned(ANode) then Exit; if ANode.HasChildren and Assigned(ANode.FirstChild) then begin Result := 0; for iChild := 0 to ANode.ChildCount - 1 do Result := Result + ANode.Rec.ValueByName(AFieldName).AsFloat; Result := TotalPriceRoundTo(Result); end else if Assigned(ANode.Rec) and Assigned(ANode.Rec.ValueByName(AFieldName)) then Result := ANode.Rec.ValueByName(AFieldName).AsFloat; end; procedure TBillsCompileData.UpdateParent(ABillsID: Integer; ADifferTotalPrice: Double; const AFieldName: string); var vNode: TBillsIDTreeNode; begin vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID)); if not Assigned(vNode) then Exit; with vNode.Rec do begin ValueByName(AFieldName).AsFloat := TotalPriceRoundTo( ValueByName(AFieldName).AsFloat + ADifferTotalPrice); TotalPrice.AsFloat := TotalPriceRoundTo(TotalPrice.AsFloat + ADifferTotalPrice); end; CalculateDesignPrice(vNode); UpdateParent(vNode.ParentID, ADifferTotalPrice, AFieldName); end; procedure TBillsCompileData.CalculateTotal(ABillsID: Integer); begin CalculateOrg(ABillsID); CalculateMis(ABillsID); CalculateOth(ABillsID); end; procedure TBillsCompileData.CalculateBills(ANode: TsdIDTreeNode); var iChild: Integer; begin if not Assigned(ANode) then Exit; if ANode.HasChildren then begin for iChild := 0 to ANode.ChildCount - 1 do CalculateBills(ANode.ChildNodes[iChild]); GatherNode(TBillsIDTreeNode(ANode)); end else CalculateLeaf(TBillsIDTreeNode(ANode)); end; procedure TBillsCompileData.CalculateLeaf(ANode: TBillsIDTreeNode); begin if not Assigned(ANode) or ANode.HasChildren then Exit; with ANode.Rec do begin // 分项 if CalcType.AsFloat = 0 then begin OrgTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OrgQuantity.AsFloat); MisTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * MisQuantity.AsFloat); OthTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OthQuantity.AsFloat); end; // 汇总 Quantity.AsFloat := QuantityRoundTo( OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat); TotalPrice.AsFloat := TotalPriceRoundTo( OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat); end; CalculateDesignPrice(ANode); end; procedure TBillsCompileData.GatherNode(ANode: TBillsIDTreeNode); var iChild: Integer; fOrg, fMis, fOth: Double; vChild: TBillsIDTreeNode; begin fOrg := 0; fMis := 0; fOth := 0; for iChild := 0 to ANode.ChildCount - 1 do begin vChild := TBillsIDTreeNode(ANode.ChildNodes[iChild]); fOrg := fOrg + vChild.Rec.OrgTotalPrice.AsFloat; fMis := fMis + vChild.Rec.MisTotalPrice.AsFloat; fOth := fOth + vChild.Rec.OthTotalPrice.AsFloat; end; ANode.Rec.OrgTotalPrice.AsFloat := TotalPriceRoundTo(fOrg); ANode.Rec.MisTotalPrice.AsFloat := TotalPriceRoundTo(fMis); ANode.Rec.OthTotalPrice.AsFloat := TotalPriceRoundTo(fOth); ANode.Rec.TotalPrice.AsFloat := TotalPriceRoundTo(fOrg + fMis + fOth); CalculateDesignPrice(ANode); end; procedure TBillsCompileData.Calculate(ABillsID: Integer); procedure UpdateParent(ANode: TBillsIDTreeNode; ADifferOrg, ADifferMis, ADifferOth: Double); begin if not Assigned(ANode) then Exit; with ANode.Rec do begin OrgTotalPrice.AsFloat := TotalPriceRoundTo(OrgTotalPrice.AsFloat + ADifferOrg); MisTotalPrice.AsFloat := TotalPriceRoundTo(MisTotalPrice.AsFloat + ADifferMis); OthTotalPrice.AsFloat := TotalPriceRoundTo(OthTotalPrice.AsFloat + ADifferOth); TotalPrice.AsFloat := TotalPriceRoundTo( TotalPrice.AsFloat + ADifferOrg + ADifferMis + ADifferOth); if DgnQuantity1.AsFloat <> 0 then DgnPrice.AsFloat := PriceRoundTo(TotalPrice.AsFloat/DgnQuantity1.AsFloat); end; UpdateParent(TBillsIDTreeNode(ANode.Parent), ADifferOrg, ADifferMis, ADifferOth); end; var vNode: TBillsIDTreeNode; iChild: Integer; fOrg, fMis, fOth: Double; begin vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID)); if not Assigned(vNode) then Exit; fOrg := vNode.Rec.OrgTotalPrice.AsFloat; fMis := vNode.Rec.MisTotalPrice.AsFloat; fOth := vNode.Rec.OthTotalPrice.AsFloat; CalculateBills(vNode); fOrg := vNode.Rec.OrgTotalPrice.AsFloat - fOrg; fMis := vNode.Rec.MisTotalPrice.AsFloat - fMis; fOth := vNode.Rec.OthTotalPrice.AsFloat - fOth; UpdateParent(TBillsIDTreeNode(vNode.Parent), fOrg, fMis, fOth); end; procedure TBillsCompileData.CalculateDesignPrice(ANode: TBillsIDTreeNode); begin if ANode.Rec.DgnQuantity1.AsFloat <> 0 then ANode.Rec.DgnPrice.AsFloat := PriceRoundTo( ANode.Rec.TotalPrice.AsFloat/ANode.Rec.DgnQuantity1.AsFloat) else ANode.Rec.DgnPrice.Clear; end; end.