1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261 |
- 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.
|