unit BillsCompileDm; interface uses BillsDm, StandardBillsFme, SysUtils, Classes, sdDB, BillsTree, sdIDTree, DB; type TRefreshGridRowEvent = procedure (ARowIndex: Integer) of object; 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; FRefreshRow: TRefreshGridRowEvent; 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 RecursiveExportBillsJson(const AFileName: string); // 所有解锁的节点全部重新锁定 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; property RefreshRow: TRefreshGridRowEvent read FRefreshRow write FRefreshRow; end; implementation uses ProjectData, Math, ZhAPI, UtilMethods, ConstUnit, mDataRecord, Variants, ConditionalDefines; {$R *.dfm} { TBillsCompileData } constructor TBillsCompileData.Create(AProjectData: TObject); begin inherited Create(nil); FProjectData := AProjectData; FBillsData := TProjectData(FProjectData).BillsData; FBillsCompileTree := TCompileBillsIDTree.Create; FBillsCompileTree.KeyFieldName := 'ID'; FBillsCompileTree.ParentFieldName := 'ParentID'; FBillsCompileTree.NextSiblingFieldName := 'NextSiblingID'; FBillsCompileTree.AutoCreateKeyID := True; FBillsCompileTree.AutoExpand := True; FBillsCompileTree.DataView := sdvBillsCompile; FBillsCompileTree.SeedID := Max(FBillsCompileTree.SeedID, 100); FBillsCompileTree.OnReCalcNode := Calculate; end; destructor TBillsCompileData.Destroy; begin FBillsCompileTree.Free; inherited; end; procedure TBillsCompileData.Open; begin sdvBillsCompile.DataSet := TProjectData(FProjectData).BillsData.sddBills; sdvBillsCompile.Open; FBillsCompileTree.SeedID := Max(FBillsCompileTree.SeedID, 100); end; procedure TBillsCompileData.ReConnectTree; begin FBillsCompileTree.DataView := nil; FBillsCompileTree.DataView := sdvBillsCompile; end; procedure TBillsCompileData.sdvBillsCompileGetText(var Text: String; ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn; DisplayText: Boolean); procedure GetEditText; var sFormula: string; sFormulaField: string; begin sFormula := ''; if ARecord.ValueByName('CalcType').AsInteger = 0 then begin if SameText('OrgQuantity', AColumn.FieldName) then sFormula := ARecord.ValueByName('OrgFormula').AsString else if SameText('MisQuantity', AColumn.FieldName) then sFormula := ARecord.ValueByName('MisFormula').AsString else if SameText('OthQuantity', AColumn.FieldName) then sFormula := ARecord.ValueByName('OthFormula').AsString; end else if ARecord.ValueByName('CalcType').AsInteger = 1 then begin if SameText('OrgTotalPrice', AColumn.FieldName) then sFormula := ARecord.ValueByName('OrgFormula').AsString else if SameText('MisTotalPrice', AColumn.FieldName) then sFormula := ARecord.ValueByName('MisFormula').AsString else if SameText('OthTotalPrice', AColumn.FieldName) then sFormula := ARecord.ValueByName('OthFormula').AsString; end; if sFormula <> '' then Text := sFormula; end; procedure GetDisplayText; begin if AValue.DataType = ftFloat then begin if not Assigned(AValue) or (AValue.AsFloat = 0) then Text := ''; end; end; begin if DisplayText then GetDisplayText else GetEditText; end; procedure TBillsCompileData.ExpandNodeTo(ALevel: Integer); begin BillsCompileTree.ExpandLevel := ALevel; end; procedure TBillsCompileData.ExpandXmjNode; var iIndex: Integer; stnNode: TBillsIDTreeNode; begin for iIndex := 0 to BillsCompileTree.Count - 1 do begin stnNode := TBillsIDTreeNode(BillsCompileTree.Items[iIndex]); if (stnNode.ParentID <> -1) then stnNode.Parent.Expanded := stnNode.Rec.B_Code.AsString = ''; end; end; procedure TBillsCompileData.sdvBillsCompileAfterValueChanged( AValue: TsdValue); procedure ResetChildrenLockedInfo(ANode: TsdIDTreeNode; ALockedInfo: Boolean); var iChild: Integer; begin if not Assigned(ANode) then Exit; if ANode.Rec.ValueByName('LockedLevel').AsBoolean then ANode.Rec.ValueByName('LockedInfo').AsBoolean := ALockedInfo; if ANode.HasChildren then for iChild := 0 to ANode.ChildCount - 1 do ResetChildrenLockedInfo(ANode.ChildNodes[iChild], ALockedInfo); end; var vNode: TBillsIDTreeNode; begin vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(AValue.Owner.ValueByName('ID').AsInteger)); if SameText(AValue.FieldName, 'OrgQuantity') or SameText(AValue.FieldName, 'OrgTotalPrice') then CalculateOrg(AValue.Owner.ValueByName('ID').AsInteger) else if SameText(AValue.FieldName, 'MisQuantity') or SameText(AValue.FieldName, 'MisTotalPrice') then CalculateMis(AValue.Owner.ValueByName('ID').AsInteger) else if SameText(AValue.FieldName, 'OthQuantity') or SameText(AValue.FieldName, 'OthTotalPrice') then CalculateOth(AValue.Owner.ValueByName('ID').AsInteger) else if SameText(AValue.FieldName, 'Price') then CalculateTotal(AValue.Owner.ValueByName('ID').AsInteger) else if SameText(AValue.FieldName, 'DgnQuantity1') then CalculateDesignPrice(vNode); if (AValue.FieldName = 'LockedInfo') then ResetChildrenLockedInfo(vNode, AValue.AsBoolean); if (AValue.FieldName = 'B_Code') then begin AValue.Owner.ValueByName('DgnQuantity1').Clear; AValue.Owner.ValueByName('DgnQuantity2').Clear; AValue.Owner.ValueByName('DgnPrice').Clear; end; if (AValue.FieldName = 'IsGatherZJJL') then BillsData.SyncSetOthersGatherZJJL(vNode, BillsCompileTree); 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); function CheckParentExist(ANode: TBillsIDTreeNode): Boolean; var vParent: TBillsIDTreeNode; begin Result := False; vParent := TBillsIDTreeNode(ANode.Parent); while Assigned(vParent) and not Result do begin if vParent.Rec.IsGatherZJJL.AsBoolean then Result := True; vParent := TBillsIDTreeNode(vParent.Parent); end; end; procedure CancelParentCheck(ANode: TBillsIDTreeNode); var vParent: TBillsIDTreeNode; begin vParent := TBillsIDTreeNode(ANode.Parent); while Assigned(vParent) do begin if vParent.Rec.IsGatherZJJL.AsBoolean then vParent.Rec.IsGatherZJJL.AsBoolean := False; vParent := TBillsIDTreeNode(vParent.Parent); end; end; function CheckChildrenExist(ANode: TBillsIDTreeNode): Boolean; var iChild: Integer; vChild: TBillsIDTreeNode; begin Result := False; for iChild := 0 to ANode.ChildCount - 1 do begin vChild := TBillsIDTreeNode(ANode.ChildNodes[iChild]); if vChild.Rec.IsGatherZJJL.AsBoolean or CheckChildrenExist(vChild) then begin Result := True; Break; end; end; end; procedure CancelChildrenCheck(ANode: TBillsIDTreeNode); var iChild: Integer; vChild: TBillsIDTreeNode; begin for iChild := 0 to ANode.ChildCount - 1 do begin vChild := TBillsIDTreeNode(ANode.ChildNodes[iChild]); if vChild.Rec.IsGatherZJJL.AsBoolean then vChild.Rec.IsGatherZJJL.AsBoolean := False else CancelChildrenCheck(vChild); end; end; var vNode: TBillsIDTreeNode; 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 else if SameText(AValue.FieldName, 'IsGatherZJJL') then begin Allow := (TProjectData(FProjectData).ProjProperties.PhaseCount = 0) or TProjectData(FProjectData).CanUnlockInfo; vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(AValue.Owner.ValueByName('ID').AsInteger)); if Allow then begin if CheckParentExist(vNode) then begin if QuestMessage('父项已勾选,继续将取消父项勾选。') then CancelParentCheck(vNode) else Allow := False; end else if CheckChildrenExist(vNode) then begin if QuestMessage('子项已勾选,继续将取消子项勾选。') then CancelChildrenCheck(vNode) else Allow := False; end; end else WarningMessage('开始计量后,计量汇总列不可编辑,如需修改,请先解锁。'); if not Allow and Assigned(FRefreshRow) then RefreshRow(vNode.MajorIndex); end; end; procedure TBillsCompileData.CalculateAll; procedure RecursiveCalc(ANode: TsdIDTreeNode); begin if not Assigned(ANode) then Exit; if ANode.HasChildren then begin RecursiveCalc(ANode.FirstChild); GatherNode(TBillsIDTreeNode(ANode)); end else CalculateLeaf(TBillsIDTreeNode(ANode)); RecursiveCalc(ANode.NextSibling); end; procedure BeginCalc; begin sdvBillsCompile.BeforeValueChange := nil; sdvBillsCompile.AfterValueChanged := nil; end; procedure EndCalc; begin sdvBillsCompile.BeforeValueChange := sdvBillsCompileBeforeValueChange; sdvBillsCompile.AfterValueChanged := sdvBillsCompileAfterValueChanged; end; begin BeginCalc; try RecursiveCalc(BillsCompileTree.FirstNode); finally EndCalc; end; end; procedure TBillsCompileData.AddBillsFromLib(ANode: TsdIDTreeNode; ABillsType: TBillsType); begin if not Assigned(ANode) then Exit; if ABillsType = btXm then AddXmjBillsFromLib(ANode) else if ABillsType = btGcl then AddGclBillsFromLib(ANode); end; procedure TBillsCompileData.AddGclBillsFromLib( AStdBillsNode: TsdIDTreeNode); var stnParent, stnStdNode: TsdIDTreeNode; iLevel: Integer; begin if not CanAddGclBills then raise Exception.Create('当前节点下不可添加工程量清单!'); stnParent := GetGclBillsParent(BillsCompileTree.Selected); if TBillsIDTreeNode(stnParent).HasLedger or (not stnParent.HasChildren and TBillsIDTreeNode(stnParent).HasMeasure) then raise Exception.Create('当前节点不可添加工程量清单!'); stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level); for iLevel := 1 to AStdBillsNode.Level + 1 do begin if stnStdNode.Rec.ValueByName('B_Code').AsString <> '' then if FindChild(stnParent, stnStdNode) <> nil then stnParent := FindChild(stnParent, stnStdNode) else stnParent := InsertChild(stnParent, stnStdNode); stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level - iLevel); end; end; procedure TBillsCompileData.AddXmjBillsFromLib( AStdBillsNode: TsdIDTreeNode); var stnStdNode, stnCurNode: TsdIDTreeNode; iLevel: Integer; begin stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level); stnCurNode := nil; for iLevel := 1 to AStdBillsNode.Level + 1 do begin if FindChild(stnCurNode, stnStdNode) <> nil then stnCurNode := FindChild(stnCurNode, stnStdNode) else if Assigned(stnCurNode) then begin if TBillsIDTreeNode(stnCurNode).HasLedger or (not stnCurNode.HasChildren and TBillsIDTreeNode(stnCurNode).HasMeasure) then raise Exception.Create('不可添加该项目节数据!') else stnCurNode := InsertChild(stnCurNode, stnStdNode); end else Break; stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level - iLevel); end; end; function TBillsCompileData.CanAddGclBills: Boolean; function CheckChildrenHasXmj(ANode: TsdIDTreeNode): Boolean; var stnCurNode: TsdIDTreeNode; begin Result := False; if not ANode.HasChildren then Exit; stnCurNode := ANode.FirstChild; while not Result and Assigned(stnCurNode) do begin Result := Result or (stnCurNode.Rec.ValueByName('Code').AsString <> ''); if stnCurNode.HasChildren then Result := Result or CheckChildrenHasXmj(stnCurNode); stnCurNode := stnCurNode.NextSibling; end; end; function CheckParentIsXmj(ANode: TsdIDTreeNode): Boolean; begin Result := False; if not Assigned(ANode) then Exit; Result := ANode.Rec.ValueByName('Code').AsString <> ''; if not Result then Result := Result or CheckParentIsXmj(ANode.Parent); end; begin Result := False; if not Assigned(BillsCompileTree.Selected) then Exit; Result := CheckParentIsXmj(BillsCompileTree.Selected) and not CheckChildrenHasXmj(BillsCompileTree.Selected); end; function TBillsCompileData.CompareNodeCode(ANode, ACompareNode: TsdIDTreeNode): Integer; begin if ANode.Rec.ValueByName('Code').AsString <> '' then Result := CompareCode(ANode.Rec.ValueByName('Code').AsString, ACompareNode.Rec.ValueByName('Code').AsString) else if ANode.Rec.ValueByName('B_Code').AsString <> '' then Result := CompareCode(ANode.Rec.ValueByName('B_Code').AsString, ACompareNode.Rec.ValueByName('B_Code').AsString); end; function TBillsCompileData.GetGclBillsParent( AChildNode: TsdIDTreeNode): TsdIDTreeNode; begin if AChildNode.Rec.ValueByName('B_Code').AsString <> '' then Result := GetGclBillsParent(AChildNode.Parent) else Result := AChildNode; end; function TBillsCompileData.GetNextSiblingID(AParent, ANode: TsdIDTreeNode): Integer; var stnCurNode: TsdIDTreeNode; begin Result := -1; if Assigned(AParent) then stnCurNode := AParent.FirstChild else stnCurNode := BillsCompileTree.FirstNode; if not Assigned(stnCurNode) then Exit; while Assigned(stnCurNode) do begin if CompareNodeCode(stnCurNode, ANode) >= 0 then begin Result := stnCurNode.ID; Exit; end; stnCurNode := stnCurNode.NextSibling; end; end; function TBillsCompileData.GetTopParentNode(ANode: TsdIDTreeNode; ALevel: Integer): TsdIDTreeNode; begin Result := ANode; while Assigned(Result.Parent) and (Result.Level + ALevel > ANode.Level) do Result := Result.Parent; end; function TBillsCompileData.IsSameNode(ANode, ACompareNode: TsdIDTreeNode): Boolean; begin if ANode.Rec.ValueByName('StaticID').AsInteger > 0 then Result := (ANode.Rec.ValueByName('StaticID').AsInteger = ACompareNode.Rec.ValueByName('ID').AsInteger) else Result := (ANode.Rec.ValueByName('Code').AsString = ACompareNode.Rec.ValueByName('Code').AsString) and (ANode.Rec.ValueByName('B_Code').AsString = ACompareNode.Rec.ValueByName('B_Code').AsString) and (ANode.Rec.ValueByName('Name').AsString = ACompareNode.Rec.ValueByName('Name').AsString); end; function TBillsCompileData.FindChild(AParentNode, ANode: TsdIDTreeNode): TsdIDTreeNode; function FindSibling(AFirstNode, ANode: TsdIDTreeNode): TsdIDTreeNode; var stnCurNode: TsdIDTreeNode; begin Result := nil; stnCurNode := AFirstNode; while Assigned(stnCurNode) and not Assigned(Result) do begin if IsSameNode(ANode, stnCurNode) then Result := stnCurNode; stnCurNode := stnCurNode.NextSibling; end; end; begin if not Assigned(AParentNode) then Result := FindSibling(BillsCompileTree.FirstNode, ANode) else Result := FindSibling(AParentNode.FirstChild, ANode); end; function TBillsCompileData.InsertChild(AParentNode, ANode: TsdIDTreeNode): TsdIDTreeNode; var iID, iNextSiblingID: Integer; begin iNextSiblingID := GetNextSiblingID(AParentNode, ANode); iID := ANode.Rec.ValueByName('StaticID').AsInteger; if Assigned(AParentNode) then Result := BillsCompileTree.AddNode(AParentNode.ID, iNextSiblingID, iID) else Result := BillsCompileTree.AddNode(-1, iNextSiblingID, iID); Result.Rec.ValueByName('Code').AsString := ANode.Rec.ValueByName('Code').AsString; Result.Rec.ValueByName('B_Code').AsString := ANode.Rec.ValueByName('B_Code').AsString; Result.Rec.ValueByName('Name').AsString := ANode.Rec.ValueByName('Name').AsString; Result.Rec.ValueByName('Units').AsString := ANode.Rec.ValueByName('Unit').AsString; end; procedure TBillsCompileData.sdvBillsCompileSetText(var Text: String; ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn; var Allow: Boolean); procedure SetTextErrorHint(const AHint: string); begin ErrorMessage(AHint); Allow := False; end; procedure SetQuantity(const AFieldName: string); var sPre: string; begin sPre := StringReplace(AFieldName, 'Quantity', '', [rfIgnoreCase, rfReplaceAll]); if CheckStringNull(Text) or CheckNumeric(Text) then begin ARecord.ValueByName(sPre + 'Formula').AsString := ''; Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0))); end else begin ARecord.ValueByName(sPre + 'Formula').AsString := Text; Text := FloatToStr(QuantityRoundTo(EvaluateExprs(Text))); end; ARecord.ValueByName('CalcType').AsInteger := 0; end; procedure SetTotalPrice(const AFieldName: string); var sPre: string; begin sPre := StringReplace(AFieldName, 'TotalPrice', '', [rfIgnoreCase, rfReplaceAll]); if CheckStringNull(Text) or CheckNumeric(Text) then begin ARecord.ValueByName(sPre + 'Formula').AsString := ''; Text := FloatToStr(TotalPriceRoundTo(StrToFloatDef(Text, 0))); end else begin ARecord.ValueByName(sPre + 'Formula').AsString := Text; Text := FloatToStr(TotalPriceRoundTo(EvaluateExprs(Text))); end; ARecord.ValueByName('CalcType').AsInteger := 1; end; procedure SetDgnQuantity; begin Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0))); end; procedure SetPrice; begin Text := FloatToStr(PriceRoundTo(StrToFloatDef(Text, 0))); ARecord.ValueByName('CalcType').AsInteger := 0; end; procedure DoCurChanged(ANode: TBillsIDTreeNode); begin if SameText(AColumn.FieldName, 'OrgQuantity') or SameText(AColumn.FieldName, 'MisQuantity') or SameText(AColumn.FieldName, 'OthQuantity')then SetQuantity(AColumn.FieldName) else if SameText(AColumn.FieldName, 'OrgTotalPrice') or SameText(AColumn.FieldName, 'MisTotalPrice') or SameText(AColumn.FieldName, 'OthTotalPrice') then SetTotalPrice(AColumn.FieldName) else if Pos('DgnQuantity', AColumn.FieldName) = 1 then SetDgnQuantity else if SameText(AColumn.FieldName, 'Price') then SetPrice else if SameText(AColumn.FieldName, 'Code') then BillsCompileTree.RecodeChildrenCode(ANode, AValue.AsString, Text) else if SameText(AColumn.FieldName, 'B_Code') then BillsCompileTree.RecodeChildrenB_Code(ANode, AValue.AsString, Text); end; procedure CheckLockedData; begin if SameText(AColumn.FieldName, 'Code') or SameText(AColumn.FieldName, 'B_Code') or SameText(AColumn.FieldName, 'Name') or SameText(AColumn.FieldName, 'Units') or SameText(AColumn.FieldName, 'Price') or SameText(AColumn.FieldName, 'OrgQuantity') or SameText(AColumn.FieldName, 'OrgTotalPrice') or SameText(AColumn.FieldName, 'MisQuantity') or SameText(AColumn.FieldName, 'MisTotalPrice') or SameText(AColumn.FieldName, 'OthQuantity') or SameText(AColumn.FieldName, 'OthTotalPrice') or SameText(AColumn.FieldName, 'DrawingCode')then if ARecord.ValueByName('LockedInfo').AsBoolean then SetTextErrorHint('清单信息已被锁定,不允许修改编号、名称、单位、清单单价、0号台账数量与金额、图号!'); end; procedure CheckNodeWritable(ANode: TBillsIDTreeNode); var iCreatePhase: Integer; begin if not Allow then Exit; iCreatePhase := ANode.Rec.ValueByName('CreatePhaseID').AsInteger; if ANode.ID = iPriceMarginID then SetTextErrorHint(sBills_PMHint); if ANode.HasChildren then begin if Text = '' then Exit else if ((Pos('Quantity', AColumn.FieldName) > 0) and (Pos('Dgn', AColumn.FieldName) <=0)) or (Pos('TotalPrice', AColumn.FieldName) > 0) then SetTextErrorHint('该清单有子计算项,不能直接修改!') else if (Pos('Price', AColumn.FieldName) > 0) then SetTextErrorHint('仅最底层清单可输入单价!'); if not Allow then Exit; end else begin if SameText('OrgTotalPrice', AColumn.FieldName) or SameText('MisTotalPrice', AColumn.FieldName) or SameText('OthTotalPrice', AColumn.FieldName) then begin if not ANode.TotalPriceEnable then SetTextErrorHint('该清单不可直接输入金额,如需直接输入金额,请先清空所有数量、单价!'); end; if not Allow then Exit; if SameText('Price', AColumn.FieldName) or SameText('OrgQuantity', AColumn.FieldName) or SameText('MisQuantity', AColumn.FieldName) or SameText('OthQuantity', AColumn.FieldName) then begin if not ANode.CountPriceEnable then SetTextErrorHint('该清单不可输入数量单价,如需使用数量×单价计算,请先清空所有直接输入的金额!'); end; if not Allow then Exit; end; // 清单编号和项目节编号不可同时存在 if SameText(AValue.FieldName, 'Code') then begin if AValue.Owner.ValueByName('B_Code').AsString <> '' then SetTextErrorHint('已存在清单编号,不可输入项目节编号!'); end else if SameText(AValue.FieldName, 'B_Code') then begin if AValue.Owner.ValueByName('Code').AsString <> '' then SetTextErrorHint('已存在项目节编号,不可输入清单编号!'); end // else if SameText(AValue.FieldName, 'Price') then begin if AValue.Owner.ValueByName('AddGatherTotalPrice').AsFloat <> 0 then SetTextErrorHint('该清单已经开始计量,不可修改单价!'); end // 变更清单不可修改0号台账数据 else if SameText(AValue.FieldName, 'OrgQuantity') or SameText(AValue.FieldName, 'OrgTotalPrice') or SameText(AValue.FieldName, 'MisQuantity') or SameText(AValue.FieldName, 'MisTotalPrice') or SameText(AValue.FieldName, 'OthQuantity') or SameText(AValue.FieldName, 'OthTotalPrice') then begin if AValue.Owner.ValueByName('IsMeasureAdd').AsBoolean then SetTextErrorHint('变更清单不可填写0号台账数量与金额'); end; if not Allow then Exit; if SameText('Code', AColumn.FieldName) or SameText('B_Code', AColumn.FieldName) or SameText('Name', AColumn.FieldName) or SameText('Units', AColumn.FieldName) or SameText('Price', AColumn.FieldName) then if TBillsIDTreeNode(ANode).HasMeasure then SetTextErrorHint('该清单已经计量,不可修改清单编号'); end; function CheckValidData: Boolean; begin Result := (AValue.AsString <> Text); if SameText(AColumn.FieldName, 'OrgQuantity') or SameText(AColumn.FieldName, 'OrgTotalPrice') or SameText(AColumn.FieldName, 'MisQuantity') or SameText(AColumn.FieldName, 'MisTotalPrice') or SameText(AColumn.FieldName, 'OthQuantity') or SameText(AColumn.FieldName, 'OthTotalPrice') or SameText(AColumn.FieldName, 'Price') then begin if (AValue.AsFloat = 0) and (Text = '') then Result := False; end; end; var vNode: TBillsIDTreeNode; begin if not Assigned(AValue) then Exit; // 修改后数据与原数据相同则不提交 if not CheckValidData then Allow := False; if not Allow then Exit; vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ARecord.ValueByName('ID').AsInteger)); CheckLockedData; if not Allow then Exit; CheckNodeWritable(vNode); if not Allow then Exit; Text := Trim(Text); if Pos('=', Text) = 1 then Text := Copy(Text, 2, Length(Text) - 1); DoCurChanged(vNode); end; function TBillsCompileData.GetActive: Boolean; begin Result := sdvBillsCompile.Active; end; function TBillsCompileData.GetLeafXmjParentID(ABillsID: Integer): Integer; var stnNode: TsdIDTreeNode; begin stnNode := BillsCompileTree.FindNode(ABillsID); Result := GetGclBillsParent(stnNode).ID; end; procedure TBillsCompileData.sdvBillsCompileAfterOpen(Sender: TObject); begin BillsCompileTree.Active := True; end; procedure TBillsCompileData.sdvBillsCompileAfterClose(Sender: TObject); begin BillsCompileTree.Active := False; end; procedure TBillsCompileData.ReorderChildrenCode(ANode: TsdIDTreeNode); var iChild: Integer; sParentCode: string; stnChild: TsdIDTreeNode; begin if not Assigned(ANode) then Exit; sParentCode := ANode.Rec.ValueByName('Code').AsString; for iChild := 0 to ANode.ChildCount - 1 do begin stnChild := ANode.ChildNodes[iChild]; if stnChild.Rec.ValueByName('Code').AsString <> '' then stnChild.Rec.ValueByName('Code').AsString := sParentCode + '-' + IntToStr(iChild + 1); ReorderChildrenCode(stnChild); end; end; procedure TBillsCompileData.sdvBillsCompileAfterAddRecord( ARecord: TsdDataRecord); begin // 解锁前,新增清单为变更清单,解锁后,新增清单为0号台账清单 if TProjectData(FProjectData).ProjProperties.PhaseCount > 0 then ARecord.ValueByName('IsMeasureAdd').AsBoolean := not TProjectData(FProjectData).CanUnlockInfo; end; procedure TBillsCompileData.DoOnAfterDeleteNode(AParent: TsdIDTreeNode); begin if Assigned(AParent) and (AParent.ID > 0) then Calculate(AParent.ID); end; procedure TBillsCompileData.Close; begin sdvBillsCompile.Close; end; procedure TBillsCompileData.SetOnRecChange(const Value: TRecChangeEvent); begin FOnRecChange := Value; end; procedure TBillsCompileData.sdvBillsCompileCurrentChanged( ARecord: TsdDataRecord); begin if Assigned(FOnRecChange) then FOnRecChange(ARecord); end; procedure TBillsCompileData.ReLockBaseData; procedure LockNodeBaseData(ANode: TsdIDTreeNode); begin if not Assigned(ANode) then Exit; if ANode.Rec.ValueByName('LockedLevel').AsBoolean then if not ANode.Rec.ValueByName('LockedInfo').AsBoolean then ANode.Rec.ValueByName('LockedInfo').AsBoolean := True; LockNodeBaseData(ANode.FirstChild); LockNodeBaseData(ANode.NextSibling); end; begin sdvBillsCompile.AfterValueChanged := nil; try LockNodeBaseData(FBillsCompileTree.FirstNode); finally sdvBillsCompile.AfterValueChanged := sdvBillsCompileAfterValueChanged; end; end; procedure TBillsCompileData.AddBillsFromDealBills(ARec: TsdDataRecord); var stnParent, stnNode: TsdIDTreeNode; begin if not CanAddGclBills then raise Exception.Create('当前节点下不可添加工程量清单!'); stnParent := GetGclBillsParent(BillsCompileTree.Selected); if TBillsIDTreeNode(stnParent).HasLedger or (not stnParent.HasChildren and TBillsIDTreeNode(stnParent).HasMeasure) then raise Exception.Create('当前节点不可添加工程量清单!'); stnNode := BillsCompileTree.Add(stnParent.ID, -1); stnNode.Rec.ValueByName('B_Code').AsString := ARec.ValueByName('B_Code').AsString; stnNode.Rec.ValueByName('Name').AsString := ARec.ValueByName('Name').AsString; stnNode.Rec.ValueByName('Units').AsString := ARec.ValueByName('Units').AsString; stnNode.Rec.ValueByName('Price').AsString := ARec.ValueByName('Price').AsString; end; procedure TBillsCompileData.CalculateMis(ABillsID: Integer); var vNode: TBillsIDTreeNode; iChild: Integer; begin vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID)); if not Assigned(vNode) then Exit; if vNode.HasChildren then begin for iChild := 0 to vNode.ChildCount - 1 do CalculateMis(vNode.ChildNodes[iChild].ID); end else begin with vNode.Rec do begin // 数量单价模式则计算金额 if CalcType.AsInteger = 0 then MisTotalPrice.AsFloat := TotalPriceRoundTo(MisQuantity.AsFloat * Price.AsFloat); SetFloatValue(Quantity, QuantityRoundTo( OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat)); // 金额与修改前不一样,则向父项增量 if MisTotalPrice.AsFloat <> CacheMisTP then begin UpdateParent(vNode.ParentID, MisTotalPrice.AsFloat - CacheMisTP, 'MisTotalPrice'); TotalPrice.AsFloat := TotalPriceRoundTo( OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat); CacheMisTP := MisTotalPrice.AsFloat; end; end; end; CalculateDesignPrice(vNode); end; procedure TBillsCompileData.CalculateOrg(ABillsID: Integer); var vNode: TBillsIDTreeNode; iChild: Integer; fValue: Double; begin vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID)); if not Assigned(vNode) then Exit; if vNode.HasChildren then begin for iChild := 0 to vNode.ChildCount - 1 do CalculateOrg(vNode.ChildNodes[iChild].ID); end else begin with vNode.Rec do begin // 数量单价模式则计算金额 if CalcType.AsInteger = 0 then OrgTotalPrice.AsFloat := TotalPriceRoundTo(OrgQuantity.AsFloat * Price.AsFloat); SetFloatValue(Quantity, QuantityRoundTo( OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat)); // 金额与修改前不一样,则向父项增量 if CacheOrgTP <> OrgTotalPrice.AsFloat then begin UpdateParent(vNode.ParentID, OrgTotalPrice.AsFloat - CacheOrgTP, 'OrgTotalPrice'); TotalPrice.AsFloat := TotalPriceRoundTo( OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat); CacheOrgTP := OrgTotalPrice.AsFloat; end; end; end; CalculateDesignPrice(vNode); end; procedure TBillsCompileData.CalculateOth(ABillsID: Integer); var vNode: TBillsIDTreeNode; iChild: Integer; begin vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID)); if not Assigned(vNode) then Exit; if vNode.HasChildren then begin for iChild := 0 to vNode.ChildCount - 1 do CalculateOth(vNode.ChildNodes[iChild].ID); end else begin with vNode.Rec do begin // 数量单价模式则计算金额 if CalcType.AsInteger = 0 then OthTotalPrice.AsFloat := TotalPriceRoundTo(OthQuantity.AsFloat * Price.AsFloat); SetFloatValue(Quantity, QuantityRoundTo( OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat)); // 金额与修改前不一样,则向父项增量 if OthTotalPrice.AsFloat <> CacheOthTP then begin UpdateParent(vNode.ParentID, OthTotalPrice.AsFloat - CacheOthTP, 'OthTotalPrice'); TotalPrice.AsFloat := TotalPriceRoundTo( OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat+ OthTotalPrice.AsFloat); CacheOthTP := OthTotalPrice.AsFloat; end; end; end; CalculateDesignPrice(vNode); end; function TBillsCompileData.GatherChildren(ANode: TsdIDTreeNode; const AFieldName: string): Double; var iChild: Integer; begin Result := 0; if not Assigned(ANode) then Exit; if ANode.HasChildren and Assigned(ANode.FirstChild) then begin Result := 0; for iChild := 0 to ANode.ChildCount - 1 do Result := Result + ANode.Rec.ValueByName(AFieldName).AsFloat; Result := TotalPriceRoundTo(Result); end else if Assigned(ANode.Rec) and Assigned(ANode.Rec.ValueByName(AFieldName)) then Result := ANode.Rec.ValueByName(AFieldName).AsFloat; end; procedure TBillsCompileData.UpdateParent(ABillsID: Integer; ADifferTotalPrice: Double; const AFieldName: string); var vNode: TBillsIDTreeNode; begin vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID)); if not Assigned(vNode) then Exit; with vNode.Rec do begin ValueByName(AFieldName).AsFloat := TotalPriceRoundTo( ValueByName(AFieldName).AsFloat + ADifferTotalPrice); TotalPrice.AsFloat := TotalPriceRoundTo(TotalPrice.AsFloat + ADifferTotalPrice); end; CalculateDesignPrice(vNode); UpdateParent(vNode.ParentID, ADifferTotalPrice, AFieldName); end; procedure TBillsCompileData.CalculateTotal(ABillsID: Integer); begin CalculateOrg(ABillsID); CalculateMis(ABillsID); CalculateOth(ABillsID); end; procedure TBillsCompileData.CalculateBills(ANode: TsdIDTreeNode); var iChild: Integer; begin if not Assigned(ANode) then Exit; if ANode.HasChildren then begin for iChild := 0 to ANode.ChildCount - 1 do CalculateBills(ANode.ChildNodes[iChild]); GatherNode(TBillsIDTreeNode(ANode)); end else CalculateLeaf(TBillsIDTreeNode(ANode)); end; procedure TBillsCompileData.CalculateLeaf(ANode: TBillsIDTreeNode); begin if not Assigned(ANode) or ANode.HasChildren then Exit; with ANode.Rec do begin // 分项 if CalcType.AsFloat = 0 then begin OrgTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OrgQuantity.AsFloat); MisTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * MisQuantity.AsFloat); OthTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OthQuantity.AsFloat); end; // 汇总 Quantity.AsFloat := QuantityRoundTo( OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat); TotalPrice.AsFloat := TotalPriceRoundTo( OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat); end; CalculateDesignPrice(ANode); end; procedure TBillsCompileData.GatherNode(ANode: TBillsIDTreeNode); var iChild: Integer; fOrg, fMis, fOth: Double; vChild: TBillsIDTreeNode; begin fOrg := 0; fMis := 0; fOth := 0; for iChild := 0 to ANode.ChildCount - 1 do begin vChild := TBillsIDTreeNode(ANode.ChildNodes[iChild]); fOrg := fOrg + vChild.Rec.OrgTotalPrice.AsFloat; fMis := fMis + vChild.Rec.MisTotalPrice.AsFloat; fOth := fOth + vChild.Rec.OthTotalPrice.AsFloat; end; ANode.Rec.OrgTotalPrice.AsFloat := TotalPriceRoundTo(fOrg); ANode.Rec.MisTotalPrice.AsFloat := TotalPriceRoundTo(fMis); ANode.Rec.OthTotalPrice.AsFloat := TotalPriceRoundTo(fOth); ANode.Rec.TotalPrice.AsFloat := TotalPriceRoundTo(fOrg + fMis + fOth); CalculateDesignPrice(ANode); end; procedure TBillsCompileData.Calculate(ABillsID: Integer); procedure UpdateParent(ANode: TBillsIDTreeNode; ADifferOrg, ADifferMis, ADifferOth: Double); begin if not Assigned(ANode) then Exit; with ANode.Rec do begin OrgTotalPrice.AsFloat := TotalPriceRoundTo(OrgTotalPrice.AsFloat + ADifferOrg); MisTotalPrice.AsFloat := TotalPriceRoundTo(MisTotalPrice.AsFloat + ADifferMis); OthTotalPrice.AsFloat := TotalPriceRoundTo(OthTotalPrice.AsFloat + ADifferOth); TotalPrice.AsFloat := TotalPriceRoundTo( TotalPrice.AsFloat + ADifferOrg + ADifferMis + ADifferOth); if DgnQuantity1.AsFloat <> 0 then DgnPrice.AsFloat := PriceRoundTo(TotalPrice.AsFloat/DgnQuantity1.AsFloat); end; UpdateParent(TBillsIDTreeNode(ANode.Parent), ADifferOrg, ADifferMis, ADifferOth); end; var vNode: TBillsIDTreeNode; iChild: Integer; fOrg, fMis, fOth: Double; begin vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID)); if not Assigned(vNode) then Exit; fOrg := vNode.Rec.OrgTotalPrice.AsFloat; fMis := vNode.Rec.MisTotalPrice.AsFloat; fOth := vNode.Rec.OthTotalPrice.AsFloat; CalculateBills(vNode); fOrg := vNode.Rec.OrgTotalPrice.AsFloat - fOrg; fMis := vNode.Rec.MisTotalPrice.AsFloat - fMis; fOth := vNode.Rec.OthTotalPrice.AsFloat - fOth; UpdateParent(TBillsIDTreeNode(vNode.Parent), fOrg, fMis, fOth); end; procedure TBillsCompileData.CalculateDesignPrice(ANode: TBillsIDTreeNode); begin if QuantityRoundTo(ANode.Rec.DgnQuantity1.AsFloat) <> 0 then ANode.Rec.DgnPrice.AsFloat := PriceRoundTo( ANode.Rec.TotalPrice.AsFloat/ANode.Rec.DgnQuantity1.AsFloat) else ANode.Rec.DgnPrice.Clear; end; procedure TBillsCompileData.ExpandPegXmjNode; function HasPegChild(ANode: TBillsIDTreeNode): Boolean; var NextNode: TBillsIDTreeNode; begin Result := False; NextNode := TBillsIDTreeNode(ANode.NextNode); while ((NextNode.MajorIndex - ANode.MajorIndex) <= ANode.PosterityCount) do begin if CheckPeg(NextNode.Rec.Name.AsString) then begin Result := True; Break; end; NextNode := TBillsIDTreeNode(NextNode.NextNode); end; end; function HasGclChild(ANode: TBillsIDTreeNode): Boolean; var vChild: TBillsIDTreeNode; begin Result := True; vChild := TBillsIDTreeNode(ANode.FirstChild); while Assigned(vChild) and not Result do begin if vChild.Rec.B_Code.AsString <> '' then Result := False; vChild := TBillsIDTreeNode(vChild.NextSibling); end; end; var iIndex: Integer; vNode: TBillsIDTreeNode; begin for iIndex := 0 to BillsCompileTree.Count - 1 do begin vNode := TBillsIDTreeNode(BillsCompileTree.Items[iIndex]); if vNode.HasChildren then vNode.Expanded := HasPegChild(vNode) or not HasGclChild(vNode); end; end; procedure TBillsCompileData.RecursiveExportBillsJson( const AFileName: string); var sgs: TStrings; function GetNodeData(ANode: TBillsIDTreeNode; AOrder: Integer; AFullPath: string): string; const sBillsJson = '"id": %d, "pid": %d, "order": %d, "full_path": "%s", "level": %d, "is_leaf" : %d, ' + '"code": "%s", "b_code": "%s", "name": "%s", "unit": "%s"'; begin Result := Format(sBillsJson, [ANode.Rec.ID.AsInteger, ANode.Rec.ParentID.AsInteger, AOrder, AFullPath, ANode.Level + 1, Integer(not ANode.HasChildren), ANode.Rec.Code.AsString, ANode.Rec.B_Code.AsString, ANode.Rec.Name.AsString, ANode.Rec.Units.AsString]); end; procedure ExportNode(ANode: TsdIDTreeNode; AOrder: Integer; AParentPath: string); var sNodePath: string; begin if not Assigned(ANode) then Exit; if AParentPath = '' then sNodePath := IntToStr(ANode.ID) else sNodePath := AParentPath + '-' + IntToStr(ANode.ID); sgs.Strings[sgs.Count - 1] := sgs.Strings[sgs.Count - 1] + '{'; sgs.Add(Format(' %s', [AnsiToUtf8(GetNodeData(TBillsIDTreeNode(ANode), AOrder, sNodePath))])); sgs.Add('}'); if Assigned(ANode.NextNode) then sgs.Strings[sgs.Count - 1] := sgs.Strings[sgs.Count - 1] + ','; ExportNode(ANode.FirstChild, 1, sNodePath); ExportNode(ANode.NextSibling, AOrder + 1, AParentPath); end; begin sgs := TStringList.Create; try sgs.Add('['); ExportNode(FBillsCompileTree.FirstNode, 1, ''); sgs.Strings[sgs.Count - 1] := sgs.Strings[sgs.Count - 1] + ']'; sgs.SaveToFile(AFileName); finally sgs.Free; end; end; end.