12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010 |
- unit BillsMeasureDm;
- interface
- uses
- BillsDm, BillsTree, FormulaCalc, sdIDTree, StageDm,
- SysUtils, Classes, sdDB, DB;
- type
- 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);
- 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);
- public
- constructor Create(AProjectData: TObject);
- destructor Destroy; override;
- procedure Open;
- procedure Close;
- procedure ReConnectTree;
- procedure CalculateAll;
- procedure ResetPhaseStageLink;
- procedure ResetTreeNodeStageRec;
- procedure ExpandNodeTo(ALevel: Integer);
- procedure ExpandXmjNode;
- procedure ExpandCurPhase;
- function GatherRelaBGL(ANode: TsdIDTreeNode): string;
- // 计算 修改各期原报审核数据时,需对累计数据做增量
- 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 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;
- {$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
- 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
- vNode: TBillsIDTreeNode;
- begin
- vNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(AValue.Owner.ValueByName('ID').AsInteger));
- if TProjectData(FProjectData).PhaseData.Active then
- begin
- if AValue.FieldName = 'Price' then
- StageData.ReCalculate(AValue.Owner.ValueByName('ID').AsInteger);
- if AValue.FieldName = 'NewPrice' then
- StageData.ReCalculate(AValue.Owner.ValueByName('ID').AsInteger);
- 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;
- 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 := 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);
- 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;
- 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;
- end.
|