12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004 |
- unit BillsCompileDm;
- interface
- uses
- BillsDm, StandardBillsFme,
- SysUtils, Classes, sdDB, BillsTree, sdIDTree, DB;
- type
- TBillsCompileData = class(TDataModule)
- sdvBillsCompile: TsdDataView;
- procedure sdvBillsCompileGetText(var Text: String;
- ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
- DisplayText: Boolean);
- procedure sdvBillsCompileAfterValueChanged(AValue: TsdValue);
- procedure sdvBillsCompileBeforeValueChange(AValue: TsdValue;
- const NewValue: Variant; var Allow: Boolean);
- procedure sdvBillsCompileSetText(var Text: String;
- ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
- var Allow: Boolean);
- procedure sdvBillsCompileAfterOpen(Sender: TObject);
- procedure sdvBillsCompileAfterClose(Sender: TObject);
- procedure sdvBillsCompileAfterAddRecord(ARecord: TsdDataRecord);
- procedure sdvBillsCompileCurrentChanged(ARecord: TsdDataRecord);
- private
- FProjectData: TObject;
- FBillsData: TBillsData;
- FBillsCompileTree: TBillsIDTree;
- FBeforeChangeParentID: Integer;
- FOnRecChange: TRecChangeEvent;
- function GatherChildrenOrg(ANode: TsdIDTreeNode): Double;
- procedure UpdateRecordOrg(ABillsID: Integer; ATotalPrice: Double);
- function FindChild(AParentNode, ANode: TsdIDTreeNode): TsdIDTreeNode;
- function InsertChild(AParentNode, ANode: TsdIDTreeNode): TsdIDTreeNode;
- function CompareNodeCode(ANode, ACompareNode: TsdIDTreeNode): Integer;
- function GetNextSiblingID(AParent, ANode: TsdIDTreeNode): Integer;
- function IsSameNode(ANode, ACompareNode: TsdIDTreeNode): Boolean;
- function GetTopParentNode(ANode: TsdIDTreeNode; ALevel: Integer): TsdIDTreeNode;
- procedure AddXmjBillsFromLib(AStdBillsNode: TsdIDTreeNode);
- function CanAddGclBills: Boolean;
- function GetGclBillsParent(AChildNode: TsdIDTreeNode): TsdIDTreeNode;
- procedure AddGclBillsFromLib(AStdBillsNode: TsdIDTreeNode);
- procedure DoOnAfterDeleteNode(AParent: TsdIDTreeNode);
- function GatherChildren(ANode: TsdIDTreeNode; const AFieldName: string): Double;
- procedure UpdateParent(ABillsID: Integer; ADifferTotalPrice: Double; const AFieldName: string);
- // 施工图原设计[增量]
- procedure CalculateOrg(ABillsID: Integer);
- // 设计错漏增减[增量]
- procedure CalculateMis(ABillsID: Integer);
- // 其他错漏增减[增量]
- procedure CalculateOth(ABillsID: Integer);
- procedure CalculateTotal(ABillsID: Integer);
- procedure CalculateLeaf(ANode: TBillsIDTreeNode);
- procedure GatherNode(ANode: TBillsIDTreeNode);
- procedure CalculateBills(ANode: TsdIDTreeNode);
- function GetActive: Boolean;
- procedure SetOnRecChange(const Value: TRecChangeEvent);
- public
- constructor Create(AProjectData: TObject);
- destructor Destroy; override;
- procedure Open;
- procedure Close;
- procedure ReConnectTree;
- procedure AddBillsFromLib(ANode: TsdIDTreeNode; ABillsType: TBillsType);
- procedure AddBillsFromDealBills(ARec: TsdDataRecord);
- procedure Calculate(ABillsID: Integer);
- procedure CalculateAll;
- function GetLeafXmjParentID(ABillsID: Integer): Integer;
- procedure ExpandNodeTo(ALevel: Integer);
- procedure ExpandXmjNode;
- procedure ReorderChildrenCode(ANode: TsdIDTreeNode);
- // 所有解锁的节点全部重新锁定
- procedure ReLockBaseData;
- property ProjectData: TObject read FProjectData;
- property BillsData: TBillsData read FBillsData;
- property BillsCompileTree: TBillsIDTree read FBillsCompileTree;
- property Active: Boolean read GetActive;
- property OnRecChange: TRecChangeEvent read FOnRecChange write SetOnRecChange;
- end;
- implementation
- uses
- ProjectData, Math, ZhAPI, UtilMethods, ConstUnit, mDataRecord;
- {$R *.dfm}
- { TBillsCompileData }
- constructor TBillsCompileData.Create(AProjectData: TObject);
- begin
- inherited Create(nil);
- FProjectData := AProjectData;
- FBillsData := TProjectData(FProjectData).BillsData;
- FBillsCompileTree := TBillsIDTree.Create;
- FBillsCompileTree.KeyFieldName := 'ID';
- FBillsCompileTree.ParentFieldName := 'ParentID';
- FBillsCompileTree.NextSiblingFieldName := 'NextSiblingID';
- FBillsCompileTree.AutoCreateKeyID := True;
- FBillsCompileTree.AutoExpand := True;
- FBillsCompileTree.DataView := sdvBillsCompile;
- FBillsCompileTree.SeedID := Max(FBillsCompileTree.SeedID, 100);
- FBillsCompileTree.DoOnAfterDeleteNode := DoOnAfterDeleteNode;
- end;
- destructor TBillsCompileData.Destroy;
- begin
- FBillsCompileTree.Free;
- inherited;
- end;
- procedure TBillsCompileData.Open;
- begin
- sdvBillsCompile.DataSet := TProjectData(FProjectData).BillsData.sddBills;
- sdvBillsCompile.Open;
- FBillsCompileTree.SeedID := Max(FBillsCompileTree.SeedID, 100);
- end;
- procedure TBillsCompileData.ReConnectTree;
- begin
- FBillsCompileTree.DataView := nil;
- FBillsCompileTree.DataView := sdvBillsCompile;
- end;
- procedure TBillsCompileData.sdvBillsCompileGetText(var Text: String;
- ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
- DisplayText: Boolean);
- var
- fDgnPrice: Double;
- begin
- if AValue.DataType = ftFloat then
- begin
- if Assigned(AValue) and (AValue.AsFloat = 0) then
- Text := '';
- end;
- end;
- procedure TBillsCompileData.ExpandNodeTo(ALevel: Integer);
- begin
- BillsCompileTree.ExpandLevel := ALevel;
- end;
- procedure TBillsCompileData.ExpandXmjNode;
- var
- iIndex: Integer;
- stnNode: TBillsIDTreeNode;
- begin
- for iIndex := 0 to BillsCompileTree.Count - 1 do
- begin
- stnNode := TBillsIDTreeNode(BillsCompileTree.Items[iIndex]);
- if (stnNode.ParentID <> -1) then
- stnNode.Parent.Expanded := stnNode.Rec.B_Code.AsString = '';
- end;
- end;
- procedure TBillsCompileData.sdvBillsCompileAfterValueChanged(
- AValue: TsdValue);
- procedure ResetChildrenLockedInfo(ANode: TsdIDTreeNode; ALockedInfo: Boolean);
- var
- iChild: Integer;
- begin
- if not Assigned(ANode) then Exit;
- if ANode.Rec.ValueByName('LockedLevel').AsBoolean then
- ANode.Rec.ValueByName('LockedInfo').AsBoolean := ALockedInfo;
- if ANode.HasChildren then
- for iChild := 0 to ANode.ChildCount - 1 do
- ResetChildrenLockedInfo(ANode.ChildNodes[iChild], ALockedInfo);
- end;
- var
- stnNode: TsdIDTreeNode;
- begin
- if SameText(AValue.FieldName, 'OrgQuantity') then
- CalculateOrg(AValue.Owner.ValueByName('ID').AsInteger)
- else if SameText(AValue.FieldName, 'MisQuantity') then
- CalculateMis(AValue.Owner.ValueByName('ID').AsInteger)
- else if SameText(AValue.FieldName, 'OthQuantity') then
- CalculateOth(AValue.Owner.ValueByName('ID').AsInteger)
- else if SameText(AValue.FieldName, 'Price') or
- SameText(AValue.FieldName, 'DgnQuantity1') then
- CalculateTotal(AValue.Owner.ValueByName('ID').AsInteger);
- if (AValue.FieldName = 'ParentID') then
- begin
- Calculate(FBeforeChangeParentID);
- Calculate(AValue.AsInteger);
- end;
- if (AValue.FieldName = 'LockedInfo') then
- begin
- stnNode := BillsCompileTree.FindNode(AValue.Owner.ValueByName('ID').AsInteger);
- ResetChildrenLockedInfo(stnNode, AValue.AsBoolean);
- end;
- end;
- function TBillsCompileData.GatherChildrenOrg(ANode: TsdIDTreeNode): Double;
- var
- iChild: Integer;
- begin
- if ANode = nil then Exit;
- if ANode.HasChildren and Assigned(ANode.FirstChild) then
- begin
- Result := 0;
- for iChild := 0 to ANode.ChildCount - 1 do
- Result := Result + GatherChildrenOrg(ANode.ChildNodes[iChild]);
- Result := TotalPriceRoundTo(Result);
- end
- else
- if Assigned(ANode.Rec) and Assigned(ANode.Rec.ValueByName('TotalPrice')) then
- Result := ANode.Rec.ValueByName('TotalPrice').AsFloat
- else
- Result := 0;
- end;
- procedure TBillsCompileData.UpdateRecordOrg(ABillsID: Integer;
- ATotalPrice: Double);
- var
- stnNode: TsdIDTreeNode;
- begin
- stnNode := BillsCompileTree.FindNode(ABillsID);
- if not Assigned(stnNode) then Exit;
- with stnNode.Rec do
- begin
- ValueByName('TotalPrice').AsFloat := TotalPriceRoundTo(
- ValueByName('TotalPrice').AsFloat + ATotalPrice);
- if ValueByName('DgnQuantity1').AsFloat <> 0 then
- ValueByName('DgnPrice').AsFloat := PriceRoundTo(
- ValueByName('TotalPrice').AsFloat/ValueByName('DgnQuantity1').AsFloat);
- end;
- UpdateRecordOrg(stnNode.ParentID, ATotalPrice);
- end;
- procedure TBillsCompileData.sdvBillsCompileBeforeValueChange(
- AValue: TsdValue; const NewValue: Variant; var Allow: Boolean);
- begin
- // 清单编号和项目节编号不可同时存在
- if SameText(AValue.FieldName, 'Code') then
- begin
- if AValue.Owner.ValueByName('B_Code').AsString <> '' then
- DataSetErrorMessage(Allow, '已存在清单编号,不可输入项目节编号!');
- end
- else if SameText(AValue.FieldName, 'B_Code') then
- begin
- if AValue.Owner.ValueByName('Code').AsString <> '' then
- DataSetErrorMessage(Allow, '已存在项目节编号,不可输入清单编号!');
- end
- //
- else if SameText(AValue.FieldName, 'Price') then
- begin
- if AValue.Owner.ValueByName('AddGatherTotalPrice').AsFloat <> 0 then
- DataSetErrorMessage(Allow, '该清单已经开始计量,不可修改单价!');
- end
- // 变更清单不可修改0号台账数据
- else if SameText(AValue.FieldName, 'OrgQuantity') or
- SameText(AValue.FieldName, 'MisQuantity') or
- SameText(AValue.FieldName, 'OthQuantity') then
- begin
- if AValue.Owner.ValueByName('IsMeasureAdd').AsBoolean then
- DataSetErrorMessage(Allow, '变更清单不可填写0号台账数量与金额');
- end;
- if not Allow then Exit;
- if SameText(AValue.FieldName, 'ParentID') then
- FBeforeChangeParentID := AValue.AsInteger;
- end;
- procedure TBillsCompileData.CalculateAll;
- procedure RecursiveCalc(ANode: TsdIDTreeNode);
- begin
- if not Assigned(ANode) then Exit;
- if ANode.HasChildren then
- begin
- RecursiveCalc(ANode.FirstChild);
- GatherNode(TBillsIDTreeNode(ANode));
- end
- else
- CalculateLeaf(TBillsIDTreeNode(ANode));
- RecursiveCalc(ANode.NextSibling);
- end;
- procedure BeginCalc;
- begin
- sdvBillsCompile.BeforeValueChange := nil;
- sdvBillsCompile.AfterValueChanged := nil;
- end;
- procedure EndCalc;
- begin
- sdvBillsCompile.BeforeValueChange := sdvBillsCompileBeforeValueChange;
- sdvBillsCompile.AfterValueChanged := sdvBillsCompileAfterValueChanged;
- end;
- begin
- BeginCalc;
- try
- RecursiveCalc(BillsCompileTree.FirstNode);
- finally
- EndCalc;
- end;
- end;
- procedure TBillsCompileData.AddBillsFromLib(ANode: TsdIDTreeNode;
- ABillsType: TBillsType);
- begin
- if not Assigned(ANode) then Exit;
- if ABillsType = btXm then
- AddXmjBillsFromLib(ANode)
- else if ABillsType = btGcl then
- AddGclBillsFromLib(ANode);
- end;
- procedure TBillsCompileData.AddGclBillsFromLib(
- AStdBillsNode: TsdIDTreeNode);
- var
- stnParent, stnStdNode: TsdIDTreeNode;
- iLevel: Integer;
- begin
- if not CanAddGclBills then
- raise Exception.Create('当前节点下不可添加工程量清单!');
- stnParent := GetGclBillsParent(BillsCompileTree.Selected);
- if TBillsIDTreeNode(stnParent).HasLedger or
- (not stnParent.HasChildren and TBillsIDTreeNode(stnParent).HasMeasure) then
- raise Exception.Create('当前节点不可添加工程量清单!');
- stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level);
- for iLevel := 1 to AStdBillsNode.Level + 1 do
- begin
- if stnStdNode.Rec.ValueByName('B_Code').AsString <> '' then
- if FindChild(stnParent, stnStdNode) <> nil then
- stnParent := FindChild(stnParent, stnStdNode)
- else
- stnParent := InsertChild(stnParent, stnStdNode);
- stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level - iLevel);
- end;
- end;
- procedure TBillsCompileData.AddXmjBillsFromLib(
- AStdBillsNode: TsdIDTreeNode);
- var
- stnStdNode, stnCurNode: TsdIDTreeNode;
- iLevel: Integer;
- begin
- stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level);
- stnCurNode := nil;
- for iLevel := 1 to AStdBillsNode.Level + 1 do
- begin
- if FindChild(stnCurNode, stnStdNode) <> nil then
- stnCurNode := FindChild(stnCurNode, stnStdNode)
- else
- begin
- if TBillsIDTreeNode(stnCurNode).HasLedger or
- (not stnCurNode.HasChildren and TBillsIDTreeNode(stnCurNode).HasMeasure) then
- raise Exception.Create('不可添加该项目节数据!')
- else
- stnCurNode := InsertChild(stnCurNode, stnStdNode);
- end;
- stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level - iLevel);
- end;
- end;
- function TBillsCompileData.CanAddGclBills: Boolean;
- function CheckChildrenHasXmj(ANode: TsdIDTreeNode): Boolean;
- var
- stnCurNode: TsdIDTreeNode;
- begin
- Result := False;
- if not ANode.HasChildren then Exit;
- stnCurNode := ANode.FirstChild;
- while not Result and Assigned(stnCurNode) do
- begin
- Result := Result or (stnCurNode.Rec.ValueByName('Code').AsString <> '');
- if stnCurNode.HasChildren then
- Result := Result or CheckChildrenHasXmj(stnCurNode);
- stnCurNode := stnCurNode.NextSibling;
- end;
- end;
- function CheckParentIsXmj(ANode: TsdIDTreeNode): Boolean;
- begin
- Result := False;
- if not Assigned(ANode) then Exit;
- Result := ANode.Rec.ValueByName('Code').AsString <> '';
- if not Result then
- Result := Result or CheckParentIsXmj(ANode.Parent);
- end;
- begin
- Result := False;
- if not Assigned(BillsCompileTree.Selected) then Exit;
- Result := CheckParentIsXmj(BillsCompileTree.Selected)
- and not CheckChildrenHasXmj(BillsCompileTree.Selected);
- end;
- function TBillsCompileData.CompareNodeCode(ANode,
- ACompareNode: TsdIDTreeNode): Integer;
- begin
- if ANode.Rec.ValueByName('Code').AsString <> '' then
- Result := CompareCode(ANode.Rec.ValueByName('Code').AsString,
- ACompareNode.Rec.ValueByName('Code').AsString)
- else if ANode.Rec.ValueByName('B_Code').AsString <> '' then
- Result := CompareCode(ANode.Rec.ValueByName('B_Code').AsString,
- ACompareNode.Rec.ValueByName('B_Code').AsString);
- end;
- function TBillsCompileData.GetGclBillsParent(
- AChildNode: TsdIDTreeNode): TsdIDTreeNode;
- begin
- if AChildNode.Rec.ValueByName('B_Code').AsString <> '' then
- Result := GetGclBillsParent(AChildNode.Parent)
- else
- Result := AChildNode;
- end;
- function TBillsCompileData.GetNextSiblingID(AParent,
- ANode: TsdIDTreeNode): Integer;
- var
- stnCurNode: TsdIDTreeNode;
- begin
- Result := -1;
- if Assigned(AParent) then
- stnCurNode := AParent.FirstChild
- else
- stnCurNode := BillsCompileTree.FirstNode;
- if not Assigned(stnCurNode) then Exit;
- while Assigned(stnCurNode) do
- begin
- if CompareNodeCode(stnCurNode, ANode) >= 0 then
- begin
- Result := stnCurNode.ID;
- Exit;
- end;
- stnCurNode := stnCurNode.NextSibling;
- end;
- end;
- function TBillsCompileData.GetTopParentNode(ANode: TsdIDTreeNode;
- ALevel: Integer): TsdIDTreeNode;
- begin
- Result := ANode;
- while Assigned(Result.Parent) and (Result.Level + ALevel > ANode.Level) do
- Result := Result.Parent;
- end;
- function TBillsCompileData.IsSameNode(ANode,
- ACompareNode: TsdIDTreeNode): Boolean;
- begin
- Result := (ANode.Rec.ValueByName('Code').AsString = ACompareNode.Rec.ValueByName('Code').AsString)
- and (ANode.Rec.ValueByName('B_Code').AsString = ACompareNode.Rec.ValueByName('B_Code').AsString)
- and (ANode.Rec.ValueByName('Name').AsString = ACompareNode.Rec.ValueByName('Name').AsString);
- end;
- function TBillsCompileData.FindChild(AParentNode,
- ANode: TsdIDTreeNode): TsdIDTreeNode;
- function FindSibling(AFirstNode, ANode: TsdIDTreeNode): TsdIDTreeNode;
- var
- stnCurNode: TsdIDTreeNode;
- begin
- Result := nil;
- stnCurNode := AFirstNode;
- while Assigned(stnCurNode) and not Assigned(Result) do
- begin
- if IsSameNode(ANode, stnCurNode) then
- Result := stnCurNode;
- stnCurNode := stnCurNode.NextSibling;
- end;
- end;
- begin
- if not Assigned(AParentNode) then
- Result := FindSibling(BillsCompileTree.FirstNode, ANode)
- else
- Result := FindSibling(AParentNode.FirstChild, ANode);
- end;
- function TBillsCompileData.InsertChild(AParentNode,
- ANode: TsdIDTreeNode): TsdIDTreeNode;
- var
- iNextSiblingID: Integer;
- begin
- iNextSiblingID := GetNextSiblingID(AParentNode, ANode);
- if Assigned(AParentNode) then
- Result := BillsCompileTree.Add(AParentNode.ID, iNextSiblingID)
- else
- Result := BillsCompileTree.Add(-1, iNextSiblingID);
- Result.Rec.ValueByName('Code').AsString := ANode.Rec.ValueByName('Code').AsString;
- Result.Rec.ValueByName('B_Code').AsString := ANode.Rec.ValueByName('B_Code').AsString;
- Result.Rec.ValueByName('Name').AsString := ANode.Rec.ValueByName('Name').AsString;
- Result.Rec.ValueByName('Units').AsString := ANode.Rec.ValueByName('Unit').AsString;
- end;
- procedure TBillsCompileData.sdvBillsCompileSetText(var Text: String;
- ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
- var Allow: Boolean);
- procedure SetTextErrorHint(const AHint: string);
- begin
- ErrorMessage(AHint);
- Allow := False;
- end;
- procedure SetQuantity;
- begin
- // 0号台账改为三项合计后,不记录输入的功能,但允许公式计算
- if CheckStringNull(Text) or CheckNumeric(Text) then
- Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)))
- else
- Text := FloatToStr(QuantityRoundTo(EvaluateExprs(Text)));
- end;
- procedure SetDgnQuantity;
- begin
- Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)));
- end;
- procedure SetPrice;
- begin
- Text := FloatToStr(PriceRoundTo(StrToFloatDef(Text, 0)));
- end;
- procedure DoCurChanged;
- begin
- if SameText(AColumn.FieldName, 'OrgQuantity') or
- SameText(AColumn.FieldName, 'MisQuantity') or
- SameText(AColumn.FieldName, 'OthQuantity') then
- SetQuantity
- else if Pos('DgnQuantity', AColumn.FieldName) = 1 then
- SetDgnQuantity
- else if SameText(AColumn.FieldName, 'Price') then
- SetPrice;
- end;
- procedure CheckLockedData;
- begin
- if SameText(AColumn.FieldName, 'Code') or
- SameText(AColumn.FieldName, 'B_Code') or
- SameText(AColumn.FieldName, 'Name') or
- SameText(AColumn.FieldName, 'Units') or
- SameText(AColumn.FieldName, 'Price') or
- SameText(AColumn.FieldName, 'OrgQuantity') or
- SameText(AColumn.FieldName, 'OrgTotalPrice') or
- SameText(AColumn.FieldName, 'MisQuantity') or
- SameText(AColumn.FieldName, 'MisTotalPrice') or
- SameText(AColumn.FieldName, 'OthQuantity') or
- SameText(AColumn.FieldName, 'OthTotalPrice') or
- SameText(AColumn.FieldName, 'DrawingCode')then
- if ARecord.ValueByName('LockedInfo').AsBoolean then
- SetTextErrorHint('清单信息已被锁定,不允许修改编号、名称、单位、清单单价、0号台账数量与金额、图号!');
- end;
- procedure CheckNodeWritable;
- var
- vNode: TsdIDTreeNode;
- iCreatePhase: Integer;
- begin
- if not Allow then Exit;
- vNode := BillsCompileTree.FindNode(ARecord.ValueByName('ID').AsInteger);
- iCreatePhase := vNode.Rec.ValueByName('CreatePhaseID').AsInteger;
- if vNode.ID = iPriceMarginID then
- SetTextErrorHint(sBills_PMHint);
- if vNode.HasChildren then
- begin
- if Text = '' then
- Exit
- else if (SameText('Quantity', AColumn.FieldName)) or
- (SameText('TotalPrice', AColumn.FieldName)) then
- SetTextErrorHint('该清单有子计算项,不能直接修改!')
- else if (Pos('Price', AColumn.FieldName) > 0) then
- SetTextErrorHint('仅最底层清单可输入单价!');
- end
- else
- if (Pos('TotalPrice', AColumn.FieldName) > 0) and
- (vNode.Rec.ValueByName('Price').AsFloat <> 0) then
- SetTextErrorHint('不可直接输入!如需直接输入金额,请先删除清单单价!');
- if not Allow then Exit;
- if SameText('Code', AColumn.FieldName) or
- SameText('B_Code', AColumn.FieldName) or
- SameText('Name', AColumn.FieldName) or
- SameText('Units', AColumn.FieldName) or
- SameText('Price', AColumn.FieldName) then
- if TBillsIDTreeNode(vNode).HasMeasure then
- SetTextErrorHint('该清单已经计量,不可修改清单编号');
- end;
- begin
- if not Assigned(AValue) then Exit;
- // 修改后数据与原数据相同则不提交
- if AValue.AsString = Text then Exit;
- CheckLockedData;
- CheckNodeWritable;
- if not Allow then Exit;
- Text := Trim(Text);
- if Pos('=', Text) = 1 then
- Text := Copy(Text, 2, Length(Text) - 1);
- DoCurChanged;
- end;
- function TBillsCompileData.GetActive: Boolean;
- begin
- Result := sdvBillsCompile.Active;
- end;
- function TBillsCompileData.GetLeafXmjParentID(ABillsID: Integer): Integer;
- var
- stnNode: TsdIDTreeNode;
- begin
- stnNode := BillsCompileTree.FindNode(ABillsID);
- Result := GetGclBillsParent(stnNode).ID;
- end;
- procedure TBillsCompileData.sdvBillsCompileAfterOpen(Sender: TObject);
- begin
- BillsCompileTree.Active := True;
- end;
- procedure TBillsCompileData.sdvBillsCompileAfterClose(Sender: TObject);
- begin
- BillsCompileTree.Active := False;
- end;
- procedure TBillsCompileData.ReorderChildrenCode(ANode: TsdIDTreeNode);
- var
- iChild: Integer;
- sParentCode: string;
- stnChild: TsdIDTreeNode;
- begin
- if not Assigned(ANode) then Exit;
- sParentCode := ANode.Rec.ValueByName('Code').AsString;
- for iChild := 0 to ANode.ChildCount - 1 do
- begin
- stnChild := ANode.ChildNodes[iChild];
- if stnChild.Rec.ValueByName('Code').AsString <> '' then
- stnChild.Rec.ValueByName('Code').AsString := sParentCode + '-' + IntToStr(iChild + 1);
- ReorderChildrenCode(stnChild);
- end;
- end;
- procedure TBillsCompileData.sdvBillsCompileAfterAddRecord(
- ARecord: TsdDataRecord);
- begin
- // 解锁前,新增清单为变更清单,解锁后,新增清单为0号台账清单
- if TProjectData(FProjectData).ProjProperties.PhaseCount > 0 then
- ARecord.ValueByName('IsMeasureAdd').AsBoolean := not TProjectData(FProjectData).CanUnlockInfo;
- end;
- procedure TBillsCompileData.DoOnAfterDeleteNode(AParent: TsdIDTreeNode);
- begin
- if Assigned(AParent) and (AParent.ID > 0) then
- Calculate(AParent.ID);
- end;
- procedure TBillsCompileData.Close;
- begin
- sdvBillsCompile.Close;
- end;
- procedure TBillsCompileData.SetOnRecChange(const Value: TRecChangeEvent);
- begin
- FOnRecChange := Value;
- end;
- procedure TBillsCompileData.sdvBillsCompileCurrentChanged(
- ARecord: TsdDataRecord);
- begin
- if Assigned(FOnRecChange) then
- FOnRecChange(ARecord);
- end;
- procedure TBillsCompileData.ReLockBaseData;
- procedure LockNodeBaseData(ANode: TsdIDTreeNode);
- begin
- if not Assigned(ANode) then Exit;
- if ANode.Rec.ValueByName('LockedLevel').AsBoolean then
- if not ANode.Rec.ValueByName('LockedInfo').AsBoolean then
- ANode.Rec.ValueByName('LockedInfo').AsBoolean := True;
- LockNodeBaseData(ANode.FirstChild);
- LockNodeBaseData(ANode.NextSibling);
- end;
- begin
- sdvBillsCompile.AfterValueChanged := nil;
- try
- LockNodeBaseData(FBillsCompileTree.FirstNode);
- finally
- sdvBillsCompile.AfterValueChanged := sdvBillsCompileAfterValueChanged;
- end;
- end;
- procedure TBillsCompileData.AddBillsFromDealBills(ARec: TsdDataRecord);
- var
- stnParent, stnNode: TsdIDTreeNode;
- begin
- if not CanAddGclBills then
- raise Exception.Create('当前节点下不可添加工程量清单!');
- stnParent := GetGclBillsParent(BillsCompileTree.Selected);
- if TBillsIDTreeNode(stnParent).HasLedger or
- (not stnParent.HasChildren and TBillsIDTreeNode(stnParent).HasMeasure) then
- raise Exception.Create('当前节点不可添加工程量清单!');
- stnNode := BillsCompileTree.Add(stnParent.ID, -1);
- stnNode.Rec.ValueByName('B_Code').AsString := ARec.ValueByName('B_Code').AsString;
- stnNode.Rec.ValueByName('Name').AsString := ARec.ValueByName('Name').AsString;
- stnNode.Rec.ValueByName('Units').AsString := ARec.ValueByName('Units').AsString;
- stnNode.Rec.ValueByName('Price').AsString := ARec.ValueByName('Price').AsString;
- end;
- procedure TBillsCompileData.CalculateMis(ABillsID: Integer);
- var
- vNode: TBillsIDTreeNode;
- fTotalPrice: Double;
- iChild: Integer;
- begin
- vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
- if not Assigned(vNode) then Exit;
- if vNode.HasChildren then
- begin
- for iChild := 0 to vNode.ChildCount - 1 do
- CalculateMis(vNode.ChildNodes[iChild].ID);
- end
- else
- begin
- with vNode.Rec do
- begin
- fTotalPrice := TotalPriceRoundTo(MisQuantity.AsFloat * Price.AsFloat);
- if MisTotalPrice.AsFloat <> fTotalPrice then
- begin
- UpdateParent(vNode.ParentID, fTotalPrice - MisTotalPrice.AsFloat, 'MisTotalPrice');
- MisTotalPrice.AsFloat := fTotalPrice;
- Quantity.AsFloat := QuantityRoundTo(
- OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
- TotalPrice.AsFloat := TotalPriceRoundTo(
- OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
- end;
- end;
- end;
- if vNode.Rec.DgnQuantity1.AsFloat <> 0 then
- vNode.Rec.DgnPrice.AsFloat := PriceRoundTo(
- vNode.Rec.TotalPrice.AsFloat/vNode.Rec.DgnQuantity1.AsFloat)
- else
- vNode.Rec.DgnPrice.AsFloat := 0;
- end;
- procedure TBillsCompileData.CalculateOrg(ABillsID: Integer);
- var
- vNode: TBillsIDTreeNode;
- fTotalPrice: Double;
- iChild: Integer;
- begin
- vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
- if not Assigned(vNode) then Exit;
- if vNode.HasChildren then
- begin
- for iChild := 0 to vNode.ChildCount - 1 do
- CalculateOrg(vNode.ChildNodes[iChild].ID);
- end
- else
- begin
- with vNode.Rec do
- begin
- fTotalPrice := TotalPriceRoundTo(OrgQuantity.AsFloat * Price.AsFloat);
- if OrgTotalPrice.AsFloat <> fTotalPrice then
- begin
- UpdateParent(vNode.ParentID, fTotalPrice - OrgTotalPrice.AsFloat, 'OrgTotalPrice');
- OrgTotalPrice.AsFloat := fTotalPrice;
- Quantity.AsFloat := QuantityRoundTo(
- OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
- TotalPrice.AsFloat := TotalPriceRoundTo(
- OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
- end;
- end;
- end;
- if vNode.Rec.DgnQuantity1.AsFloat <> 0 then
- vNode.Rec.DgnPrice.AsFloat := PriceRoundTo(
- vNode.Rec.TotalPrice.AsFloat/vNode.Rec.DgnQuantity1.AsFloat)
- else
- vNode.Rec.DgnPrice.AsFloat := 0;
- end;
- procedure TBillsCompileData.CalculateOth(ABillsID: Integer);
- var
- vNode: TBillsIDTreeNode;
- fTotalPrice: Double;
- iChild: Integer;
- begin
- vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
- if not Assigned(vNode) then Exit;
- if vNode.HasChildren then
- begin
- for iChild := 0 to vNode.ChildCount - 1 do
- CalculateOth(vNode.ChildNodes[iChild].ID);
- end
- else
- begin
- with vNode.Rec do
- begin
- fTotalPrice := TotalPriceRoundTo(OthQuantity.AsFloat * Price.AsFloat);
- if OthTotalPrice.AsFloat <> fTotalPrice then
- begin
- UpdateParent(vNode.ParentID, fTotalPrice - OthTotalPrice.AsFloat, 'OthTotalPrice');
- OthTotalPrice.AsFloat := fTotalPrice;
- Quantity.AsFloat := QuantityRoundTo(
- OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
- TotalPrice.AsFloat := TotalPriceRoundTo(
- OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat+ OthTotalPrice.AsFloat);
- end;
- end;
- end;
- if vNode.Rec.DgnQuantity1.AsFloat <> 0 then
- vNode.Rec.DgnPrice.AsFloat := PriceRoundTo(
- vNode.Rec.TotalPrice.AsFloat/vNode.Rec.DgnQuantity1.AsFloat)
- else
- vNode.Rec.DgnPrice.AsFloat := 0;
- end;
- function TBillsCompileData.GatherChildren(ANode: TsdIDTreeNode;
- const AFieldName: string): Double;
- var
- iChild: Integer;
- begin
- Result := 0;
- if not Assigned(ANode) then Exit;
- if ANode.HasChildren and Assigned(ANode.FirstChild) then
- begin
- Result := 0;
- for iChild := 0 to ANode.ChildCount - 1 do
- Result := Result + ANode.Rec.ValueByName(AFieldName).AsFloat;
- Result := TotalPriceRoundTo(Result);
- end
- else
- if Assigned(ANode.Rec) and Assigned(ANode.Rec.ValueByName(AFieldName)) then
- Result := ANode.Rec.ValueByName(AFieldName).AsFloat;
- end;
- procedure TBillsCompileData.UpdateParent(ABillsID: Integer;
- ADifferTotalPrice: Double; const AFieldName: string);
- var
- vNode: TBillsIDTreeNode;
- begin
- vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
- if not Assigned(vNode) then Exit;
- with vNode.Rec do
- begin
- ValueByName(AFieldName).AsFloat := TotalPriceRoundTo(
- ValueByName(AFieldName).AsFloat + ADifferTotalPrice);
- TotalPrice.AsFloat := TotalPriceRoundTo(TotalPrice.AsFloat + ADifferTotalPrice);
- if DgnQuantity1.AsFloat <> 0 then
- DgnPrice.AsFloat := PriceRoundTo(TotalPrice.AsFloat/DgnQuantity1.AsFloat);
- end;
- UpdateParent(vNode.ParentID, ADifferTotalPrice, AFieldName);
- end;
- procedure TBillsCompileData.CalculateTotal(ABillsID: Integer);
- begin
- CalculateOrg(ABillsID);
- CalculateMis(ABillsID);
- CalculateOth(ABillsID);
- end;
- procedure TBillsCompileData.CalculateBills(ANode: TsdIDTreeNode);
- var
- iChild: Integer;
- begin
- if not Assigned(ANode) then Exit;
- if ANode.HasChildren then
- begin
- for iChild := 0 to ANode.ChildCount - 1 do
- CalculateBills(ANode.ChildNodes[iChild]);
- GatherNode(TBillsIDTreeNode(ANode));
- end
- else
- CalculateLeaf(TBillsIDTreeNode(ANode));
- end;
- procedure TBillsCompileData.CalculateLeaf(ANode: TBillsIDTreeNode);
- begin
- if not Assigned(ANode) or ANode.HasChildren then Exit;
- with ANode.Rec do
- begin
- // 分项
- OrgTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OrgQuantity.AsFloat);
- MisTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * MisQuantity.AsFloat);
- OthTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OthQuantity.AsFloat);
- // 汇总
- Quantity.AsFloat := QuantityRoundTo(
- OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
- TotalPrice.AsFloat := TotalPriceRoundTo(
- OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
- // 经济指标
- if DgnQuantity1.AsFloat <> 0 then
- DgnPrice.AsFloat := PriceRoundTo(TotalPrice.AsFloat/DgnQuantity1.AsFloat);
- end;
- end;
- procedure TBillsCompileData.GatherNode(ANode: TBillsIDTreeNode);
- var
- iChild: Integer;
- fOrg, fMis, fOth: Double;
- vChild: TBillsIDTreeNode;
- begin
- fOrg := 0;
- fMis := 0;
- fOth := 0;
- for iChild := 0 to ANode.ChildCount - 1 do
- begin
- vChild := TBillsIDTreeNode(ANode.ChildNodes[iChild]);
- fOrg := fOrg + vChild.Rec.OrgTotalPrice.AsFloat;
- fMis := fMis + vChild.Rec.MisTotalPrice.AsFloat;
- fOth := fOth + vChild.Rec.OthTotalPrice.AsFloat;
- end;
- ANode.Rec.OrgTotalPrice.AsFloat := TotalPriceRoundTo(fOrg);
- ANode.Rec.MisTotalPrice.AsFloat := TotalPriceRoundTo(fMis);
- ANode.Rec.OthTotalPrice.AsFloat := TotalPriceRoundTo(fOth);
- ANode.Rec.TotalPrice.AsFloat := TotalPriceRoundTo(fOrg + fMis + fOth);
- if ANode.Rec.DgnQuantity1.AsFloat <> 0 then
- ANode.Rec.DgnPrice.AsFloat := PriceRoundTo(
- ANode.Rec.TotalPrice.AsFloat/ANode.Rec.DgnQuantity1.AsFloat);
- end;
- procedure TBillsCompileData.Calculate(ABillsID: Integer);
- procedure UpdateParent(ANode: TBillsIDTreeNode; ADifferOrg, ADifferMis, ADifferOth: Double);
- begin
- if not Assigned(ANode) then Exit;
- with ANode.Rec do
- begin
- OrgTotalPrice.AsFloat := TotalPriceRoundTo(OrgTotalPrice.AsFloat + ADifferOrg);
- MisTotalPrice.AsFloat := TotalPriceRoundTo(MisTotalPrice.AsFloat + ADifferMis);
- OthTotalPrice.AsFloat := TotalPriceRoundTo(OthTotalPrice.AsFloat + ADifferOth);
- TotalPrice.AsFloat := TotalPriceRoundTo(
- TotalPrice.AsFloat + ADifferOrg + ADifferMis + ADifferOth);
- if DgnQuantity1.AsFloat <> 0 then
- DgnPrice.AsFloat := PriceRoundTo(TotalPrice.AsFloat/DgnQuantity1.AsFloat);
- end;
- UpdateParent(TBillsIDTreeNode(ANode.Parent), ADifferOrg, ADifferMis, ADifferOth);
- end;
- var
- vNode: TBillsIDTreeNode;
- iChild: Integer;
- fOrg, fMis, fOth: Double;
- begin
- vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
- if not Assigned(vNode) then Exit;
- fOrg := vNode.Rec.OrgTotalPrice.AsFloat;
- fMis := vNode.Rec.MisTotalPrice.AsFloat;
- fOth := vNode.Rec.OthTotalPrice.AsFloat;
- CalculateBills(vNode);
- fOrg := vNode.Rec.OrgTotalPrice.AsFloat - fOrg;
- fMis := vNode.Rec.MisTotalPrice.AsFloat - fMis;
- fOth := vNode.Rec.OthTotalPrice.AsFloat - fOth;
- UpdateParent(TBillsIDTreeNode(vNode.Parent), fOrg, fMis, fOth);
- end;
- end.
|