unit BillsMeasureDm; interface uses BillsDm, BillsTree, FormulaCalc, sdIDTree, StageDm, SysUtils, Classes, sdDB, DB, CalcDecimal; type TLocateZJJLEvent = procedure (ABillsID: Integer) of object; TBillsMeasureData = class(TDataModule) sdvBillsMeasure: TsdDataView; procedure sdvBillsMeasureAfterOpen(Sender: TObject); procedure sdvBillsMeasureAfterAddRecord(ARecord: TsdDataRecord); procedure sdvBillsMeasureGetText(var Text: String; ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn; DisplayText: Boolean); procedure sdvBillsMeasureSetText(var Text: String; ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn; var Allow: Boolean); procedure sdvBillsMeasureNeedLookupRecord(ARecord: TsdDataRecord; AColumn: TsdViewColumn; ANewText: String); procedure sdvBillsMeasureAfterClose(Sender: TObject); procedure sdvBillsMeasureAfterValueChanged(AValue: TsdValue); procedure sdvBillsMeasureCurrentChanged(ARecord: TsdDataRecord); procedure sdvBillsMeasureBeforeValueChange(AValue: TsdValue; const NewValue: Variant; var Allow: Boolean); private FProjectData: TObject; FBillsData: TBillsData; FBillsMeasureTree: TMeasureBillsIDTree; FFormulaCalc: TFormulaCalc; FShowParentData: Boolean; FOnRecChange: TRecChangeEvent; function OnGetCardinalNum(const ACardinalNum: string): Double; procedure CalcAddCompleteRate(ANode: TsdIDTreeNode); procedure CalcAddDgnPrice(ANode: TsdIDTreeNode); function SelectAndUpdateBGL(ABillsID: Integer; ARec: TsdDataRecord; ANewValue: Double; const AType: string): Boolean; procedure CalculateNode(ANode: TMeasureBillsIDTreeNode); procedure UpdateRecordGather(ANode: TsdIDTreeNode; AQuantity, ATotalPrice: Double); function GetStageData: TStageData; procedure SetOnRecChange(const Value: TRecChangeEvent); function GetDecimal: TCalcDecimal; public constructor Create(AProjectData: TObject); destructor Destroy; override; procedure Open; procedure Close; procedure ReConnectTree; function CheckNodeGatherCalc(ANode: TMeasureBillsIDTreeNode): Boolean; procedure CalculateAll; procedure ResetPhaseStageLink; procedure ResetTreeNodeStageRec; procedure FreeTreeNodeStageRec; procedure ExpandNodeTo(ALevel: Integer); procedure ExpandXmjNode; procedure ExpandCurPhase; function GatherRelaBGL(ANode: TsdIDTreeNode): string; function FindNodeWithZJJL(ANode: TsdIDTreeNode): TsdIDTreeNode; procedure CalcMeasureFilter; // 计算 修改各期原报审核数据时,需对累计数据做增量 procedure UpdateRecordDeal(ABillsID: Integer; AQuantity, ATotalPrice: Double); procedure UpdateRecordQc(ABillsID: Integer; AQuantity, ATotalPrice: Double); procedure UpdateRecordPc(ABillsID: Integer; AQuantity, ATotalPrice: Double); procedure UpdateRecordPM(ABillsID: Integer; ADiffer: Double); procedure UpdateGather(ABillsID: Integer; ADiffer: Double); procedure UpdateBGLInfo(ABillsID: Integer; ARec: TsdDataRecord; const AType: string); property ProjectData: TObject read FProjectData; property BillsData: TBillsData read FBillsData; property BillsMeasureTree: TMeasureBillsIDTree read FBillsMeasureTree; property Decimal: TCalcDecimal read GetDecimal; property StageData: TStageData read GetStageData; property ShowParentData: Boolean read FShowParentData write FShowParentData; property OnRecChange: TRecChangeEvent read FOnRecChange write SetOnRecChange; end; implementation uses ProjectData, PhaseData, Math, ZhAPI, BillsCommand, BGLSelectFrm, BGLDm, UtilMethods, mDataRecord, ConstUnit, Variants, ConditionalDefines; {$R *.dfm} { TBillsMeasureData } constructor TBillsMeasureData.Create(AProjectData: TObject); begin inherited Create(nil); FProjectData := AProjectData; FBillsData := TProjectData(FProjectData).BillsData; FBillsMeasureTree := TMeasureBillsIDTree.Create; FBillsMeasureTree.KeyFieldName := 'ID'; FBillsMeasureTree.ParentFieldName := 'ParentID'; FBillsMeasureTree.NextSiblingFieldName := 'NextSiblingID'; FBillsMeasureTree.AutoCreateKeyID := True; FBillsMeasureTree.AutoExpand := True; FBillsMeasureTree.DataView := sdvBillsMeasure; FBillsMeasureTree.SeedID := Max(FBillsMeasureTree.SeedID, 100); FBillsMeasureTree.Link(TProjectData(FProjectData).BillsCompileData.BillsCompileTree, True); FBillsMeasureTree.CompileTree := TProjectData(FProjectData).BillsCompileData.BillsCompileTree; FFormulaCalc := TFormulaCalc.Create(FBillsMeasureTree); FFormulaCalc.OnGetValue := OnGetCardinalNum; end; destructor TBillsMeasureData.Destroy; begin FFormulaCalc.Free; FBillsMeasureTree.Free; inherited; end; procedure TBillsMeasureData.Open; begin sdvBillsMeasure.DataSet := TProjectData(FProjectData).BillsData.sddBills; sdvBillsMeasure.Open; end; procedure TBillsMeasureData.ReConnectTree; begin FBillsMeasureTree.DataView := nil; FBillsMeasureTree.DataView := sdvBillsMeasure; FBillsMeasureTree.Link(TProjectData(FProjectData).BillsCompileData.BillsCompileTree, True); end; procedure TBillsMeasureData.ResetPhaseStageLink; begin with TProjectData(FProjectData).PhaseData do begin sdvBillsMeasure.Columns.FindColumn('CurDealQuantity').LookupDataSet := StageData.sddStage; sdvBillsMeasure.Columns.FindColumn('CurDealTotalPrice').LookupDataSet := StageData.sddStage; sdvBillsMeasure.Columns.FindColumn('CurQcQuantity').LookupDataSet := StageData.sddStage; sdvBillsMeasure.Columns.FindColumn('CurQcTotalPrice').LookupDataSet := StageData.sddStage; sdvBillsMeasure.Columns.FindColumn('CurQcBGLCode').LookupDataSet := StageData.sddStage; sdvBillsMeasure.Columns.FindColumn('CurPcQuantity').LookupDataSet := StageData.sddStage; sdvBillsMeasure.Columns.FindColumn('CurPcTotalPrice').LookupDataSet := StageData.sddStage; sdvBillsMeasure.Columns.FindColumn('CurPcBGLCode').LookupDataSet := StageData.sddStage; sdvBillsMeasure.Columns.FindColumn('CurGatherQuantity').LookupDataSet := StageData.sddStage; sdvBillsMeasure.Columns.FindColumn('CurGatherTotalPrice').LookupDataSet := StageData.sddStage; sdvBillsMeasure.Columns.FindColumn('EndDealQuantity').LookupDataSet := StageData.sddStage; sdvBillsMeasure.Columns.FindColumn('EndDealTotalPrice').LookupDataSet := StageData.sddStage; sdvBillsMeasure.Columns.FindColumn('EndQcQuantity').LookupDataSet := StageData.sddStage; sdvBillsMeasure.Columns.FindColumn('EndQcTotalPrice').LookupDataSet := StageData.sddStage; sdvBillsMeasure.Columns.FindColumn('EndPcQuantity').LookupDataSet := StageData.sddStage; sdvBillsMeasure.Columns.FindColumn('EndPcTotalPrice').LookupDataSet := StageData.sddStage; sdvBillsMeasure.Columns.FindColumn('EndGatherQuantity').LookupDataSet := StageData.sddStage; sdvBillsMeasure.Columns.FindColumn('EndGatherTotalPrice').LookupDataSet := StageData.sddStage; sdvBillsMeasure.Columns.FindColumn('PM_PreTotalPrice').LookupDataSet := StageData.sddStage; sdvBillsMeasure.Columns.FindColumn('PM_TotalPrice').LookupDataSet := StageData.sddStage; end; end; procedure TBillsMeasureData.sdvBillsMeasureAfterOpen(Sender: TObject); begin FBillsMeasureTree.Active := True; end; procedure TBillsMeasureData.sdvBillsMeasureAfterAddRecord( ARecord: TsdDataRecord); begin if TProjectData(FProjectData).PhaseData.Active then ARecord.ValueByName('IsMeasureAdd').AsBoolean := True; end; procedure TBillsMeasureData.sdvBillsMeasureGetText(var Text: String; ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn; DisplayText: Boolean); function GetQuantityValueOrFormula(const AQtyType: string): string; begin with AValue.Owner do begin if ValueByName(AQtyType + 'Flag').AsInteger = 1 then Result := ValueByName(AQtyType + 'Formula').AsString else Result := Text; end; end; function GetTotalPriceValueOrFormula(const AQtyType: string): string; begin with AValue.Owner do begin if ValueByName(AQtyType + 'Formula').AsString <> '' then Result := ValueByName(AQtyType + 'Formula').AsString else Result := Text; end; end; procedure GetDisplayText(var AText: string; AValue: TsdValue; AColumn: TsdViewColumn); var stnNode: TsdIDTreeNode; begin if Assigned(AValue) and (AValue.DataType = ftFloat) and (AValue.AsFloat = 0) then begin Text := ''; Exit; end; // 所有本期数据,当节点为父节点时,不显示值(实际上需要计算其中的金额值,但又不能显示) // 有病。每天都在变。 if not ShowParentData and (Pos('Cur', AColumn.FieldName) > 0) and (Pos('Gather', AColumn.FieldName) = 0) then begin stnNode := BillsMeasureTree.FindNode(AValue.Owner.ValueByName('BillsID').AsInteger); if stnNode.HasChildren then Text := ''; end; end; procedure GetEditText(var AText: string; AValue: TsdValue; AColumn: TsdViewColumn); begin if SameText(AColumn.FieldName, 'Quantity') then Text := GetQuantityValueOrFormula('Qty') else if SameText(AColumn.FieldName, 'CurDealQuantity') then Text := GetQuantityValueOrFormula('Deal') else if SameText(AColumn.FieldName, 'CurQcQuantity') then Text := GetQuantityValueOrFormula('Qc') else if SameText(AColumn.FieldName, 'CurPcQuantity') then Text := GetQuantityValueOrFormula('Pc') else if SameText(AColumn.FieldName, 'CurDealTotalPrice') then Text := GetTotalPriceValueOrFormula('Deal') else if SameText(AColumn.FieldName, 'CurQcTotalPrice') then Text := GetTotalPriceValueOrFormula('Qc') else if SameText(AColumn.FieldName, 'CurPcTotalPrice') then Text := GetTotalPriceValueOrFormula('Pc'); end; var fPercent: Double; begin if not Assigned(AValue) then Exit; if DisplayText then GetDisplayText(Text, AValue, AColumn) else GetEditText(Text, AValue, AColumn); end; procedure TBillsMeasureData.sdvBillsMeasureSetText(var Text: String; ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn; var Allow: Boolean); function GetBillsID: Integer; begin if Pos('Cur', AColumn.FieldName) = 1 then Result := AValue.Owner.ValueByName('BillsID').AsInteger else Result := ARecord.ValueByName('ID').AsInteger; 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') then if ARecord.ValueByName('LockedInfo').AsBoolean then DataSetErrorMessage(Allow, '清单信息已被锁定,不允许修改编号、名称、单位、清单单价!'); if not Allow then Exit; if SameText(AColumn.FieldName, 'NewPrice') then if ARecord.ValueByName('LockedNewPrice').AsBoolean then DataSetErrorMessage(Allow, '变更单价已被锁定,不允许修改!'); end; procedure CheckNodeWritable(ANode: TBillsIDTreeNode); var iCreatePhase: Integer; begin iCreatePhase := ANode.Rec.ValueByName('CreatePhaseID').AsInteger; {if ANode.ID = iPriceMarginID then DataSetErrorMessage(Allow, sBills_PMHint);} if SameText('B_Code', AColumn.FieldName) or SameText('Name', AColumn.FieldName) or SameText('Units', AColumn.FieldName) then if ANode.Rec.ValueByName('AddQcQuantity').AsFloat <> 0 then DataSetErrorMessage(Allow, '该清单已进行过变更,不可修改清单编号、名称、单位!'); if not Allow then Exit; if SameText('Price', AColumn.FieldName) then if ANode.Rec.ValueByName('AddGatherTotalPrice').AsFloat <> 0 then DataSetErrorMessage(Allow, '该清单已经计量,不可修改清单单价!'); if not Allow then Exit; if SameText('NewPrice', AColumn.FieldName) then if ANode.Rec.ValueByName('AddPcTotalPrice').AsFloat <> 0 then DataSetErrorMessage(Allow, '该清单已经计量,不可修改清单变更单价!'); if not Allow then Exit; 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 DataSetErrorMessage(Allow, '该清单有子计算项,不能直接修改!') else if (Pos('Price', AColumn.FieldName) > 0) then DataSetErrorMessage(Allow, '仅最底层清单可输入单价!'); end else begin // 目前仅允许本期合同计量,可直接输入金额 if SameText('CurDealTotalPrice', AColumn.FieldName) then begin if not ANode.TotalPriceEnable then DataSetErrorMessage(Allow, '该清单不可直接输入金额,如需直接输入金额,请先清空所有数量、单价!'); end else if SameText('CurDealQuantity', AColumn.FieldName) or SameText('CurQcQuantity', AColumn.FieldName) or SameText('CurPcQuantity', AColumn.FieldName) or SameText('Price', AColumn.FieldName) then begin if not ANode.CountPriceEnable then DataSetErrorMessage(Allow, '该清单不可输入数量单价,如需使用数量×单价计算,请先清空所有直接输入的金额!'); end; end; if not Allow then Exit; // 变更清单允许填写本期合同计量,按超计论 {if vNode.Rec.ValueByName('IsMeasureAdd').AsBoolean and (iCreatePhase > 0) and (SameText('CurDealQuantity', AColumn.FieldName) or SameText('CurDealTotalPrice', AColumn.FieldName)) then DataSetErrorMessage(Allow, Format('该清单为第%d期新增清单,不可填写本期合同计量数据!', [iCreatePhase]));} end; procedure SetQuantity(ANode: TBillsIDTreeNode; const AField: string); var vNode: TBillsIDTreeNode; begin // 变更应选择变更令 if SameText(AField , 'Qc') or SameText(AField , 'Pc') then Allow := SelectAndUpdateBGL(GetBillsID, AValue.Owner, StrToFloatDef(Text, 0), AField); if not Allow then Exit; if CheckStringNull(Text) or CheckNumeric(Text) then begin AValue.Owner.ValueByName(AField + 'Flag').AsInteger := 0; AValue.Owner.ValueByName(AField + 'Formula').AsString := ''; Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0))); end else begin AValue.Owner.ValueByName(AField + 'Flag').AsInteger := 1; AValue.Owner.ValueByName(AField + 'Formula').AsString := Text; Text := FloatToStr(QuantityRoundTo(EvaluateExprs(Text))); end; ANode.Rec.SetIntValue(ANode.Rec.CalcType, 0); end; procedure SetTotalPrice(ANode: TBillsIDTreeNode; const AField: string); begin // 变更应选择变更令 if SameText(AField , 'Qc') or SameText(AField , 'Pc') then Allow := SelectAndUpdateBGL(GetBillsID, AValue.Owner, StrToFloatDef(Text, 0), AField); if not Allow then Exit; AValue.Owner.ValueByName(AField + 'Flag').AsInteger := 2; AValue.Owner.ValueByName(AField + 'Quantity').AsString := ''; if CheckStringNull(Text) or CheckNumeric(Text) then begin AValue.Owner.ValueByName(AField + 'Formula').AsString := ''; Text := FloatToStr(TotalPriceRoundTo(StrToFloatDef(Text, 0))); end else begin AValue.Owner.ValueByName(AField + 'Formula').AsString := Text; Text := FloatToStr(TotalPriceRoundTo(EvaluateExprs(Text))); end; ANode.Rec.SetIntValue(ANode.Rec.CalcType, 1); end; procedure DoCurChanged(ANode: TBillsIDTreeNode); begin if SameText(AColumn.FieldName, 'CurDealQuantity') then SetQuantity(ANode, 'Deal') else if SameText(AColumn.FieldName, 'CurQcQuantity') then SetQuantity(ANode, 'Qc') else if SameText(AColumn.FieldName, 'CurPcQuantity') then SetQuantity(ANode, 'Pc') else if SameText(AColumn.FieldName, 'CurDealTotalPrice') then SetTotalPrice(ANode, 'Deal') else if SameText(AColumn.FieldName, 'CurQcTotalPrice') then SetTotalPrice(ANode, 'Qc') else if SameText(AColumn.FieldName, 'CurPcTotalPrice') then SetTotalPrice(ANode, 'Pc') else if (Pos('DgnQuantity', AColumn.FieldName) > 0) or SameText(AColumn.FieldName, 'Quantity') then Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0))) else if SameText(AColumn.FieldName, 'NewPrice') or SameText(AColumn.FieldName, 'Price') then Text := FloatToStr(PriceRoundTo(StrToFloatDef(Text, 0))) else if SameText(AColumn.FieldName, 'Code') then BillsMeasureTree.RecodeChildrenCode(ANode, AValue.AsString, Text) else if SameText(AColumn.FieldName, 'B_Code') then BillsMeasureTree.RecodeChildrenB_Code(ANode, AValue.AsString, Text); end; function CheckValidData: Boolean; begin Result := (AValue.AsString <> Text); if (Pos('Quantity', AColumn.FieldName) > 0) or (Pos('Price', AColumn.FieldName) > 0) 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(BillsMeasureTree.FindNode(GetBillsID)); 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; procedure TBillsMeasureData.sdvBillsMeasureNeedLookupRecord( ARecord: TsdDataRecord; AColumn: TsdViewColumn; ANewText: String); function CheckNeedAddPhaseRecord(ANode: TMeasureBillsIDTreeNode): Boolean; begin Result := SameText(AColumn.FieldName, 'CurDealQuantity') or SameText(AColumn.FieldName, 'CurQcQuantity') or SameText(AColumn.FieldName, 'CurPcQuantity') or SameText(AColumn.FieldName, 'CurDealTotalPrice') or SameText(AColumn.FieldName, 'CurQcTotalPrice') or SameText(AColumn.FieldName, 'CurPcTotalPrice'); Result := Result and not ANode.HasChildren; Result := Result and not Assigned(ANode.StageRec); end; function HasCardinalNum(AFormula: string): Boolean; var iCharIndex: Integer; begin Result := False; iCharIndex := 1; while ((iCharIndex <= Length(AFormula)) and not Result) do begin if AFormula[iCharIndex] in ['A'..'D', 'a'..'d'] then Result := True; Inc(iCharIndex); end; end; procedure SetQuantityRec(ANode: TBillsIDTreeNode; APhaseRec: TsdDataRecord; const AType: string); var bAllow: Boolean; begin bAllow := True; // 变更应选择变更令 if SameText(AType , 'Qc') or SameText(AType , 'Pc') then bAllow := SelectAndUpdateBGL(ARecord.ValueByName('ID').AsInteger, APhaseRec, StrToFloatDef(ANewText, 0), AType); if bAllow then begin if ANode.Rec.CalcType.AsInteger <> 0 then ANode.Rec.CalcType.AsInteger := 0; if CheckNumeric(ANewText) then APhaseRec.ValueByName(AType + 'Quantity').AsFloat := QuantityRoundTo(StrToFloatDef(ANewText, 0)) else begin APhaseRec.ValueByName(AType + 'Flag').AsInteger := 1; APhaseRec.ValueByName(AType + 'Quantity').AsFloat := QuantityRoundTo(EvaluateExprs(ANewText)); APhaseRec.ValueByName(AType + 'Formula').AsString := ANewText; end; end; end; procedure SetTotalPriceRec(ANode: TBillsIDTreeNode; APhaseRec: TsdDataRecord; const AType: string); begin if ANode.Rec.CalcType.AsInteger <> 1 then ANode.Rec.CalcType.AsInteger := 1; APhaseRec.ValueByName(AType + 'Flag').AsInteger := 2; if CheckNumeric(ANewText) then APhaseRec.ValueByName(AType + 'TotalPrice').AsFloat := TotalPriceRoundTo(StrToFloatDef(ANewText, 0)) else begin APhaseRec.ValueByName(AType + 'TotalPrice').AsFloat := TotalPriceRoundTo(EvaluateExprs(ANewText)); APhaseRec.ValueByName(AType + 'Formula').AsString := ANewText; end; end; procedure SetNewRecValue(ANode: TBillsIDTreeNode; APhaseRec: TsdDataRecord); begin if SameText(AColumn.FieldName, 'CurDealQuantity') then SetQuantityRec(ANode, APhaseRec, 'Deal') else if SameText(AColumn.FieldName, 'CurQcQuantity') then SetQuantityRec(ANode, APhaseRec, 'Qc') else if SameText(AColumn.FieldName, 'CurPcQuantity') then SetQuantityRec(ANode, APhaseRec, 'Pc') else if SameText(AColumn.FieldName, 'CurDealTotalPrice') then SetTotalPriceRec(ANode, APhaseRec, 'Deal') else if SameText(AColumn.FieldName, 'CurQcTotalPrice') then SetTotalPriceRec(ANode, APhaseRec, 'Qc') else if SameText(AColumn.FieldName, 'CurPcTotalPrice') then SetTotalPriceRec(ANode, APhaseRec, 'Pc'); end; function CheckNodeWritable(ANode: TBillsIDTreeNode): Boolean; var iCreatePhase: Integer; begin Result := True; {if ANode.ID = iPriceMarginID then DataSetErrorMessage(Result, sBills_PMHint);} if ANode.HasChildren then begin if ANewText = '' then Result := False else DataSetErrorMessage(Result, '该清单有子计算项,不能直接修改!'); end else begin // 目前仅允许本期合同计量,可直接输入金额 if SameText('CurDealTotalPrice', AColumn.FieldName) then begin if not ANode.TotalPriceEnable then DataSetErrorMessage(Result, '该清单不可直接输入金额,如需直接输入金额,请先清空所有数量、单价!'); end else if SameText('CurDealQuantity', AColumn.FieldName) or SameText('CurQcQuantity', AColumn.FieldName) or SameText('CurPcQuantity', AColumn.FieldName) then begin if not ANode.CountPriceEnable then DataSetErrorMessage(Result, '该清单不可输入数量单价,如需使用数量×单价计算,请先清空所有直接输入的金额!'); end; end; // 变更清单允许填写本期合同计量,按超计论 {iCreatePhase := ANode.Rec.ValueByName('CreatePhaseID').AsInteger; if ANode.Rec.ValueByName('IsMeasureAdd').AsBoolean and (iCreatePhase > 0) and (SameText('CurDealQuantity', AColumn.FieldName) or SameText('CurDealTotalPrice', AColumn.FieldName)) then begin ErrorMessage(Format('该清单为第%d期新增清单,不可填写本期合同计量数据!', [iCreatePhase])); Exit; end; } end; var NewRec: TStageRecord; vNode: TMeasureBillsIDTreeNode; begin vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.FindNode(ARecord.ValueByName('ID').AsInteger)); if not CheckNodeWritable(vNode) then Exit; if CheckNeedAddPhaseRecord(vNode) then begin if (Pos('Quantity', AColumn.FieldName) > 0) or (Pos('TotalPrice', AColumn.FieldName) > 0) then if HasCardinalNum(ANewText) then raise Exception.Create('公式不可输入参数'); NewRec := StageData.AddStageRecord(ARecord.ValueByName('ID').AsInteger); vNode.StageRec := NewRec; SetNewRecValue(vNode, NewRec); end; end; procedure TBillsMeasureData.sdvBillsMeasureAfterClose(Sender: TObject); begin FBillsMeasureTree.Active := False; end; function TBillsMeasureData.OnGetCardinalNum( const ACardinalNum: string): Double; { function GetTotalPrice(ABillsID: Integer): Double; var stnNode: TsdIDTreeNode; begin stnNode := FBillsTree.FindNode(ABillsID); if Assigned(stnNode) then Result := stnNode.Rec.ValueByName('TotalPrice').AsFloat; end; function GetPhaseTotalPrice(ABillsID: Integer; const AType: string): Double; var Rec: TsdDataRecord; begin Rec := CurPhaseData.PhaseRecord(ABillsID); if Assigned(Rec) then Result := Rec.ValueByName(AType + 'TotalPrice').AsFloat; end; } function GetTotalPrice(ANode: TsdIDTreeNode): Double; var iChild: Integer; begin Result := 0; if not Assigned(ANode) then Exit; if ANode.HasChildren then for iChild := 0 to ANode.ChildCount - 1 do Result := Result + GetTotalPrice(ANode.ChildNodes[iChild]) else Result := ANode.Rec.ValueByName('TotalPrice').AsFloat; end; function GetPhaseTotalPrice(ANode: TsdIDTreeNode; const AType: string): Double; var iChild: Integer; Rec: TsdDataRecord; begin Result := 0; if not Assigned(ANode) then Exit; if ANode.HasChildren then for iChild := 0 to ANode.ChildCount - 1 do Result := Result + GetPhaseTotalPrice(ANode.ChildNodes[iChild], AType) else begin Rec := StageData.StageRecord(ANode.ID); if Assigned(Rec) then Result := Rec.ValueByName(AType + 'TotalPrice').AsFloat; end; end; var iNodeID: Integer; begin Result := 0; iNodeID := StrToIntDef(Copy(ACardinalNum, 2, Length(ACardinalNum) - 1), -1); case ACardinalNum[1] of 'A','a': Result := GetTotalPrice(BillsMeasureTree.FindNode(iNodeID)); 'B','b': Result := GetPhaseTotalPrice(BillsMeasureTree.FindNode(iNodeID), 'Deal'); 'C','c': Result := GetPhaseTotalPrice(BillsMeasureTree.FindNode(iNodeID), 'Qc'); 'D','d': Result := GetPhaseTotalPrice(BillsMeasureTree.FindNode(iNodeID), 'Pc'); {'A','a': Result := GetTotalPrice(iNodeID); 'B','b': Result := GetPhaseTotalPrice(iNodeID, 'Deal'); 'C','c': Result := GetPhaseTotalPrice(iNodeID, 'Qc'); 'D','d': Result := GetPhaseTotalPrice(iNodeID, 'Pc');} end; end; function TBillsMeasureData.GetStageData: TStageData; begin Result := TProjectData(FProjectData).PhaseData.StageData; end; procedure TBillsMeasureData.ExpandNodeTo(ALevel: Integer); begin BillsMeasureTree.ExpandLevel := ALevel; end; procedure TBillsMeasureData.ExpandXmjNode; var iIndex: Integer; stnNode: TBillsIDTreeNode; begin for iIndex := 0 to BillsMeasureTree.Count - 1 do begin stnNode := TBillsIDTreeNode(BillsMeasureTree.Items[iIndex]); if (stnNode.ParentID <> -1) then stnNode.Parent.Expanded := stnNode.Rec.B_Code.AsString = ''; end; end; procedure TBillsMeasureData.CalculateAll; var //Cacl: TBillsCalculate; i: Integer; begin if not TProjectData(FProjectData).StageDataReadOnly then for i := 0 to BillsMeasureTree.Count - 1 do CalculateNode(TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i])); {Cacl := TBillsCalculate.Create(Self); try Cacl.Execute; finally Cacl.Free; end;} end; procedure TBillsMeasureData.UpdateRecordDeal(ABillsID: Integer; AQuantity, ATotalPrice: Double); var stnNode: TsdIDTreeNode; begin stnNode := BillsMeasureTree.FindNode(ABillsID); if not Assigned(stnNode) then Exit; with stnNode.Rec do begin if not stnNode.HasChildren then ValueByName('AddDealQuantity').AsFloat := QuantityRoundTo( ValueByName('AddDealQuantity').AsFloat + AQuantity); ValueByName('AddDealTotalPrice').AsFloat := TotalPriceRoundTo( ValueByName('AddDealTotalPrice').AsFloat + ATotalPrice); end; UpdateRecordGather(stnNode, AQuantity, ATotalPrice); UpdateRecordDeal(stnNode.ParentID, AQuantity, ATotalPrice); end; procedure TBillsMeasureData.UpdateRecordPc(ABillsID: Integer; AQuantity, ATotalPrice: Double); var stnNode: TsdIDTreeNode; begin stnNode := BillsMeasureTree.FindNode(ABillsID); if not Assigned(stnNode) then Exit; with stnNode.Rec do begin if not stnNode.HasChildren then ValueByName('AddPcQuantity').AsFloat := QuantityRoundTo( ValueByName('AddPcQuantity').AsFloat + AQuantity); ValueByName('AddPcTotalPrice').AsFloat := TotalPriceRoundTo( ValueByName('AddPcTotalPrice').AsFloat + ATotalPrice); end; UpdateRecordGather(stnNode, 0, ATotalPrice); UpdateRecordPc(stnNode.ParentID, AQuantity, ATotalPrice); end; procedure TBillsMeasureData.UpdateRecordQc(ABillsID: Integer; AQuantity, ATotalPrice: Double); var stnNode: TsdIDTreeNode; begin stnNode := BillsMeasureTree.FindNode(ABillsID); if not Assigned(stnNode) then Exit; with stnNode.Rec do begin if not stnNode.HasChildren then ValueByName('AddQcQuantity').AsFloat := QuantityRoundTo( ValueByName('AddQcQuantity').AsFloat + AQuantity); ValueByName('AddQcTotalPrice').AsFloat := TotalPriceRoundTo( ValueByName('AddQcTotalPrice').AsFloat + ATotalPrice); end; UpdateRecordGather(stnNode, AQuantity, ATotalPrice); UpdateRecordQc(stnNode.ParentID, AQuantity, ATotalPrice); end; procedure TBillsMeasureData.UpdateRecordGather(ANode: TsdIDTreeNode; AQuantity, ATotalPrice: Double); begin with ANode.Rec do begin if not ANode.HasChildren then ValueByName('AddGatherQuantity').AsFloat := QuantityRoundTo( ValueByName('AddGatherQuantity').AsFloat + AQuantity); ValueByName('AddGatherTotalPrice').AsFloat := TotalPriceRoundTo( ValueByName('AddGatherTotalPrice').AsFloat + ATotalPrice); end; CalcAddDgnPrice(ANode); CalcAddCompleteRate(ANode); end; function TBillsMeasureData.GatherRelaBGL(ANode: TsdIDTreeNode): string; var iChild: Integer; Rec: TsdDataRecord; begin Result := ''; if not Assigned(ANode) then Exit; if ANode.HasChildren then begin for iChild := 0 to ANode.ChildCount - 1 do Result := MergeRelaBGL(Result, GatherRelaBGL(ANode.ChildNodes[iChild])); end else begin with TProjectData(FProjectData).PhaseData.StageData do Rec := StageRecord(ANode.ID); if Assigned(Rec) then Result := MergeRelaBGL(Rec.ValueByName('QcBGLCode').AsString, Rec.ValueByName('PcBGLCode').AsString); end; end; procedure TBillsMeasureData.sdvBillsMeasureAfterValueChanged( AValue: TsdValue); var iID: Integer; vNode: TBillsIDTreeNode; begin iID := AValue.Owner.ValueByName('ID').AsInteger; vNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(iID)); if AValue.Owner.Owner.Name = 'sddBills' then begin if SameText(AValue.FieldName, 'Price') then TProjectData(FProjectData).BillsCompileData.Calculate(iID); if TProjectData(FProjectData).PhaseData.Active then begin if AValue.FieldName = 'Price' then StageData.ReCalculate(iID); if AValue.FieldName = 'NewPrice' then StageData.ReCalculate(iID); end; if Pos('DgnQuantity1', AValue.FieldName) > 0 then CalcAddDgnPrice(vNode); if (AValue.FieldName = 'Code') then BillsMeasureTree.RecodeChildrenCode(vNode, VarToStrDef(AValue.OldValue, ''), AValue.AsString) else if (AValue.FieldName = 'B_Code') then BillsMeasureTree.RecodeChildrenB_Code(vNode, VarToStrDef(AValue.OldValue, ''), AValue.AsString); end; end; procedure TBillsMeasureData.ExpandCurPhase; var iIndex: Integer; stnNode: TsdIDTreeNode; StageRec: TStageRecord; begin for iIndex := 0 to BillsMeasureTree.Count - 1 do begin stnNode := BillsMeasureTree.Items[iIndex]; StageRec := TMeasureBillsIDTreeNode(stnNode).StageRec; if (stnNode.ParentID <> -1) then if Assigned(StageRec) then stnNode.Expanded := StageRec.GatherTotalPrice.AsFloat <> 0 else stnNode.Expanded := False; end; end; procedure TBillsMeasureData.UpdateBGLInfo(ABillsID: Integer; ARec: TsdDataRecord; const AType: string); var stnNode: TsdIDTreeNode; begin stnNode := BillsMeasureTree.FindNode(ABillsID); if not Assigned(stnNode) then Exit; stnNode.Rec.ValueByName('Add' + AType + 'BGLCode').AsString := ARec.ValueByName('End' + AType + 'BGLCode').AsString; stnNode.Rec.ValueByName('Add' + AType + 'BGLNum').AsString := ARec.ValueByName('End' + AType + 'BGLNum').AsString; end; function TBillsMeasureData.SelectAndUpdateBGL(ABillsID: Integer; ARec: TsdDataRecord; ANewValue: Double; const AType: string): Boolean; var AOrgBGL, ANewBGL: TBGLSelectInfo; ACurNode: TsdIDTreeNode; procedure UpdateBGL; begin ARec.ValueByName(AType + 'BGLCode').AsString := ANewBGL.MergedCode; ARec.ValueByName(AType + 'BGLNum').AsString := ANewBGL.MergedNum; TProjectData(ProjectData).BGLData.ApplyBGL(AOrgBGL, ANewBGL); end; begin Result := True; ACurNode := BillsMeasureTree.FindNode(ABillsID); AOrgBGL := TBGLSelectInfo.Create(ACurNode.Rec, ARec.ValueByName(AType + 'Quantity').AsFloat, True); AOrgBGL.MergedCode := ARec.ValueByName(AType + 'BGLCode').AsString; AOrgBGL.MergedNum := ARec.ValueByName(AType + 'BGLNum').AsString; ANewBGL := TBGLSelectInfo.Create(ACurNode.Rec, ANewValue, False); try if ANewBGL.TotalNum <> 0 then begin Result := SelectBGL(AOrgBGL, ANewBGL, ProjectData); if Result then UpdateBGL; end else UpdateBGL; StageData.UpdateBGLInfo(ARec, AType); UpdateBGLInfo(ABillsID, ARec, AType); finally AOrgBGL.Free; ANewBGL.Free; end; end; procedure TBillsMeasureData.Close; begin sdvBillsMeasure.Close; end; procedure TBillsMeasureData.CalcAddCompleteRate(ANode: TsdIDTreeNode); var fDividend, fDivisor: Double; begin with ANode.Rec do begin fDividend := ValueByName('AddGatherTotalPrice').AsFloat; //fDivisor := CommonCalcRoundTo(ValueByName('TotalPrice').AsFloat + ValueByName('AddQcTotalPrice').AsFloat // + ValueByName('AddPcTotalPrice').AsFloat); fDivisor := TotalPriceRoundTo(ValueByName('TotalPrice').AsFloat + ValueByName('AddQcTotalPrice').AsFloat + ValueByName('AddPcTotalPrice').AsFloat); if fDivisor <> 0 then ValueByName('AddCompleteRate').AsFloat := AdvRoundTo(fDividend/fDivisor*100) else ValueByName('AddCompleteRate').Clear; end; end; procedure TBillsMeasureData.CalcAddDgnPrice(ANode: TsdIDTreeNode); var fDividend, fDivisor: Double; begin with ANode.Rec do begin fDividend := ValueByName('AddGatherTotalPrice').AsFloat; fDivisor := ValueByName('DealDgnQuantity1').AsFloat + ValueByName('CDgnQuantity1').AsFloat; if fDivisor <> 0 then ValueByName('AddDgnPrice').AsFloat := AdvRoundTo(fDividend/fDivisor) else ValueByName('AddDgnPrice').Clear; end; end; procedure TBillsMeasureData.SetOnRecChange(const Value: TRecChangeEvent); begin FOnRecChange := Value; end; procedure TBillsMeasureData.sdvBillsMeasureCurrentChanged( ARecord: TsdDataRecord); begin if Assigned(FOnRecChange) then FOnRecChange(ARecord); end; procedure TBillsMeasureData.ResetTreeNodeStageRec; var i: Integer; vNode: TMeasureBillsIDTreeNode; begin if not StageData.Active then Exit; for i := 0 to BillsMeasureTree.Count - 1 do begin vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]); vNode.StageRec := StageData.StageRecord(vNode.ID); end; end; procedure TBillsMeasureData.UpdateRecordPM(ABillsID: Integer; ADiffer: Double); var stnNode: TBillsIDTreeNode; begin stnNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(ABillsID)); if not Assigned(stnNode) then Exit; stnNode.Rec.PM_AddTotalPrice.AsFloat := stnNode.Rec.PM_AddTotalPrice.AsFloat + ADiffer; UpdateRecordPM(stnNode.ParentID, ADiffer); end; procedure TBillsMeasureData.CalculateNode(ANode: TMeasureBillsIDTreeNode); begin if Assigned(ANode.StageRec) then begin if not ANode.HasChildren then begin ANode.Rec.AddDealQuantity.AsFloat := ANode.StageRec.EndDealQuantity.AsFloat; ANode.Rec.AddQcQuantity.AsFloat := ANode.StageRec.EndQcQuantity.AsFloat; ANode.Rec.AddQcBGLCode.AsString := ANode.StageRec.EndQcBGLCode.AsString; ANode.Rec.AddQcBGLNum.AsString := ANode.StageRec.EndQcBGLNum.AsString; ANode.Rec.AddPcQuantity.AsFloat := ANode.StageRec.EndPcQuantity.AsFloat; ANode.Rec.AddPcBGLCode.AsString := ANode.StageRec.EndPcBGLCode.AsString; ANode.Rec.AddPcBGLNum.AsString := ANode.StageRec.EndPcBGLNum.AsString; ANode.Rec.AddGatherQuantity.AsFloat := ANode.StageRec.EndGatherQuantity.AsFloat; end; ANode.Rec.AddDealTotalPrice.AsFloat := ANode.StageRec.EndDealTotalPrice.AsFloat; ANode.Rec.AddQcTotalPrice.AsFloat := ANode.StageRec.EndQcTotalPrice.AsFloat; ANode.Rec.AddPcTotalPrice.AsFloat := ANode.StageRec.EndPcTotalPrice.AsFloat; ANode.Rec.AddGatherTotalPrice.AsFloat := ANode.StageRec.EndGatherTotalPrice.AsFloat; ANode.Rec.PM_AddTotalPrice.AsFloat := ANode.StageRec.PM_PreTotalPrice.AsFloat + ANode.StageRec.PM_TotalPrice.AsFloat; CalcAddCompleteRate(ANode); end else begin if not ANode.HasChildren then begin ANode.Rec.AddDealQuantity.Clear; ANode.Rec.AddQcQuantity.Clear; ANode.Rec.AddQcBGLCode.Clear; ANode.Rec.AddQcBGLNum.Clear; ANode.Rec.AddPcQuantity.Clear; ANode.Rec.AddPcBGLCode.Clear; ANode.Rec.AddPcBGLNum.Clear; ANode.Rec.AddGatherQuantity.Clear; end; ANode.Rec.AddDealTotalPrice.Clear; ANode.Rec.AddQcTotalPrice.Clear; ANode.Rec.AddPcTotalPrice.Clear; ANode.Rec.AddGatherTotalPrice.Clear; ANode.Rec.AddCompleteRate.Clear; ANode.Rec.PM_AddTotalPrice.Clear; end; end; procedure TBillsMeasureData.UpdateGather(ABillsID: Integer; ADiffer: Double); var stnNode: TBillsIDTreeNode; begin stnNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(ABillsID)); if not Assigned(stnNode) then Exit; with stnNode.Rec do AddDifferValue(AddGatherTotalPrice, ADiffer); UpdateGather(stnNode.ParentID, ADiffer); end; procedure TBillsMeasureData.FreeTreeNodeStageRec; var i: Integer; vNode: TMeasureBillsIDTreeNode; begin for i := 0 to BillsMeasureTree.Count - 1 do begin vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]); vNode.StageRec := nil; end; end; function TBillsMeasureData.FindNodeWithZJJL(ANode: TsdIDTreeNode): TsdIDTreeNode; function CheckNodeHasZJJL(ANode: TsdIDTreeNode): Boolean; begin Result := Assigned(TProjectData(FProjectData).PhaseData.ZJJLData.FindZJJLRecord(ANode.ID)); end; function FindChildWithZJJL(ANode: TsdIDTreeNode): TsdIDTreeNode; var iChild: Integer; vChild: TsdIDTreeNode; begin Result := nil; for iChild := 0 to ANode.ChildCount - 1 do begin vChild := ANode.ChildNodes[iChild]; if CheckNodeHasZJJL(vChild) then Result := vChild else if vChild.HasChildren then Result := FindChildWithZJJL(vChild); if Assigned(Result) then Break; end; end; function FindParentWithZJJL(ANode: TsdIDTreeNode): TsdIDTreeNode; var vParent: TsdIDTreeNode; begin Result := nil; vParent := ANode.Parent; while Assigned(vParent) and not Assigned(Result) do begin if CheckNodeHasZJJL(vParent) then Result := vParent; vParent := vParent.Parent; end; end; begin if not CheckNodeHasZJJL(ANode) then begin Result := FindChildWithZJJL(ANode); if not Assigned(Result) then Result := FindParentWithZJJL(ANode); end else Result := ANode; end; procedure TBillsMeasureData.sdvBillsMeasureBeforeValueChange( 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 vNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(AValue.Owner.ValueByName('ID').AsInteger)); if SameText(AValue.FieldName, 'IsGatherZJJL') and NewValue 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; end; function TBillsMeasureData.CheckNodeGatherCalc( ANode: TMeasureBillsIDTreeNode): Boolean; var fLeafSumDeal, fLeafSumQc, fLeafSumGather: Double; i, iCount: Integer; vChild: TMeasureBillsIDTreeNode; begin if Assigned(ANode.StageRec) then begin fLeafSumDeal := 0; fLeafSumQc := 0; fLeafSumGather := 0; iCount := ANode.PosterityCount; i := 0; vChild := TMeasureBillsIDTreeNode(ANode.NextNode); while i < iCount do begin if not vChild.HasChildren and Assigned(vChild.StageRec) then begin fLeafSumDeal := fLeafSumDeal + vChild.StageRec.DealTotalPrice.AsFloat; fLeafSumQc := fLeafSumQc + vChild.StageRec.QcTotalPrice.AsFloat; fLeafSumGather := fLeafSumGather + vChild.StageRec.GatherTotalPrice.AsFloat; end; vChild := TMeasureBillsIDTreeNode(vChild.NextNode); Inc(i); end; Result := Decimal.TotalPrice.CheckSameNum(fLeafSumDeal, ANode.StageRec.DealTotalPrice.AsFloat) and Decimal.TotalPrice.CheckSameNum(fLeafSumQc, ANode.StageRec.QcTotalPrice.AsFloat) and Decimal.TotalPrice.CheckSameNum(fLeafSumGather, ANode.StageRec.GatherTotalPrice.AsFloat); end else Result := True; end; function TBillsMeasureData.GetDecimal: TCalcDecimal; begin Result := TProjectData(FProjectData).ProjProperties.DecimalManager.Common; end; procedure TBillsMeasureData.CalcMeasureFilter; var i: Integer; vNode: TMeasureBillsIDTreeNode; begin for i := 0 to BillsMeasureTree.Count - 1 do begin vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]); vNode.Rec.SetBoolValue(vNode.Rec.HisHasMeasure, vNode.Rec.HisHasMeasure.AsBoolean or vNode.Rec.CurHasMeasure.AsBoolean); vNode.Rec.SetBoolValue(vNode.Rec.CurHasMeasure, False); end; end; end.