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