BillsCompileDm.pas 42 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338
  1. unit BillsCompileDm;
  2. interface
  3. uses
  4. BillsDm, StandardBillsFme,
  5. SysUtils, Classes, sdDB, BillsTree, sdIDTree, DB;
  6. type
  7. TRefreshGridRowEvent = procedure (ARowIndex: Integer) of object;
  8. TBillsCompileData = class(TDataModule)
  9. sdvBillsCompile: TsdDataView;
  10. procedure sdvBillsCompileGetText(var Text: String;
  11. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  12. DisplayText: Boolean);
  13. procedure sdvBillsCompileAfterValueChanged(AValue: TsdValue);
  14. procedure sdvBillsCompileBeforeValueChange(AValue: TsdValue;
  15. const NewValue: Variant; var Allow: Boolean);
  16. procedure sdvBillsCompileSetText(var Text: String;
  17. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  18. var Allow: Boolean);
  19. procedure sdvBillsCompileAfterOpen(Sender: TObject);
  20. procedure sdvBillsCompileAfterClose(Sender: TObject);
  21. procedure sdvBillsCompileAfterAddRecord(ARecord: TsdDataRecord);
  22. procedure sdvBillsCompileCurrentChanged(ARecord: TsdDataRecord);
  23. private
  24. FProjectData: TObject;
  25. FBillsData: TBillsData;
  26. FBillsCompileTree: TCompileBillsIDTree;
  27. FOnRecChange: TRecChangeEvent;
  28. FRefreshRow: TRefreshGridRowEvent;
  29. function GatherChildrenOrg(ANode: TsdIDTreeNode): Double;
  30. procedure UpdateRecordOrg(ABillsID: Integer; ATotalPrice: Double);
  31. function FindChild(AParentNode, ANode: TsdIDTreeNode): TsdIDTreeNode;
  32. function InsertChild(AParentNode, ANode: TsdIDTreeNode): TsdIDTreeNode;
  33. function CompareNodeCode(ANode, ACompareNode: TsdIDTreeNode): Integer;
  34. function GetNextSiblingID(AParent, ANode: TsdIDTreeNode): Integer;
  35. function IsSameNode(ANode, ACompareNode: TsdIDTreeNode): Boolean;
  36. function GetTopParentNode(ANode: TsdIDTreeNode; ALevel: Integer): TsdIDTreeNode;
  37. procedure AddXmjBillsFromLib(AStdBillsNode: TsdIDTreeNode);
  38. function CanAddGclBills: Boolean;
  39. function GetGclBillsParent(AChildNode: TsdIDTreeNode): TsdIDTreeNode;
  40. procedure AddGclBillsFromLib(AStdBillsNode: TsdIDTreeNode);
  41. procedure DoOnAfterDeleteNode(AParent: TsdIDTreeNode);
  42. function GatherChildren(ANode: TsdIDTreeNode; const AFieldName: string): Double;
  43. procedure UpdateParent(ABillsID: Integer; ADifferTotalPrice: Double; const AFieldName: string);
  44. // 经济指标[与其他节点无关]
  45. procedure CalculateDesignPrice(ANode: TBillsIDTreeNode);
  46. // 施工图原设计[增量]
  47. procedure CalculateOrg(ABillsID: Integer);
  48. // 设计错漏增减[增量]
  49. procedure CalculateMis(ABillsID: Integer);
  50. // 其他错漏增减[增量]
  51. procedure CalculateOth(ABillsID: Integer);
  52. procedure CalculateTotal(ABillsID: Integer);
  53. procedure CalculateLeaf(ANode: TBillsIDTreeNode);
  54. procedure GatherNode(ANode: TBillsIDTreeNode);
  55. procedure CalculateBills(ANode: TsdIDTreeNode);
  56. function GetActive: Boolean;
  57. procedure SetOnRecChange(const Value: TRecChangeEvent);
  58. public
  59. constructor Create(AProjectData: TObject);
  60. destructor Destroy; override;
  61. procedure Open;
  62. procedure Close;
  63. procedure ReConnectTree;
  64. procedure AddBillsFromLib(ANode: TsdIDTreeNode; ABillsType: TBillsType);
  65. procedure AddBillsFromDealBills(ARec: TsdDataRecord);
  66. procedure Calculate(ABillsID: Integer);
  67. procedure CalculateAll;
  68. function GetLeafXmjParentID(ABillsID: Integer): Integer;
  69. procedure ExpandNodeTo(ALevel: Integer);
  70. procedure ExpandXmjNode;
  71. procedure ExpandPegXmjNode;
  72. procedure ReorderChildrenCode(ANode: TsdIDTreeNode);
  73. procedure RecursiveExportBillsJson(const AFileName: string);
  74. // 所有解锁的节点全部重新锁定
  75. procedure ReLockBaseData;
  76. property ProjectData: TObject read FProjectData;
  77. property BillsData: TBillsData read FBillsData;
  78. property BillsCompileTree: TCompileBillsIDTree read FBillsCompileTree;
  79. property Active: Boolean read GetActive;
  80. property OnRecChange: TRecChangeEvent read FOnRecChange write SetOnRecChange;
  81. property RefreshRow: TRefreshGridRowEvent read FRefreshRow write FRefreshRow;
  82. end;
  83. implementation
  84. uses
  85. ProjectData, Math, ZhAPI, UtilMethods, ConstUnit, mDataRecord, Variants,
  86. ConditionalDefines;
  87. {$R *.dfm}
  88. { TBillsCompileData }
  89. constructor TBillsCompileData.Create(AProjectData: TObject);
  90. begin
  91. inherited Create(nil);
  92. FProjectData := AProjectData;
  93. FBillsData := TProjectData(FProjectData).BillsData;
  94. FBillsCompileTree := TCompileBillsIDTree.Create;
  95. FBillsCompileTree.KeyFieldName := 'ID';
  96. FBillsCompileTree.ParentFieldName := 'ParentID';
  97. FBillsCompileTree.NextSiblingFieldName := 'NextSiblingID';
  98. FBillsCompileTree.AutoCreateKeyID := True;
  99. FBillsCompileTree.AutoExpand := True;
  100. FBillsCompileTree.DataView := sdvBillsCompile;
  101. FBillsCompileTree.SeedID := Max(FBillsCompileTree.SeedID, 100);
  102. FBillsCompileTree.OnReCalcNode := Calculate;
  103. end;
  104. destructor TBillsCompileData.Destroy;
  105. begin
  106. FBillsCompileTree.Free;
  107. inherited;
  108. end;
  109. procedure TBillsCompileData.Open;
  110. begin
  111. sdvBillsCompile.DataSet := TProjectData(FProjectData).BillsData.sddBills;
  112. sdvBillsCompile.Open;
  113. FBillsCompileTree.SeedID := Max(FBillsCompileTree.SeedID, 100);
  114. end;
  115. procedure TBillsCompileData.ReConnectTree;
  116. begin
  117. FBillsCompileTree.DataView := nil;
  118. FBillsCompileTree.DataView := sdvBillsCompile;
  119. end;
  120. procedure TBillsCompileData.sdvBillsCompileGetText(var Text: String;
  121. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  122. DisplayText: Boolean);
  123. procedure GetEditText;
  124. var
  125. sFormula: string;
  126. sFormulaField: string;
  127. begin
  128. sFormula := '';
  129. if ARecord.ValueByName('CalcType').AsInteger = 0 then
  130. begin
  131. if SameText('OrgQuantity', AColumn.FieldName) then
  132. sFormula := ARecord.ValueByName('OrgFormula').AsString
  133. else if SameText('MisQuantity', AColumn.FieldName) then
  134. sFormula := ARecord.ValueByName('MisFormula').AsString
  135. else if SameText('OthQuantity', AColumn.FieldName) then
  136. sFormula := ARecord.ValueByName('OthFormula').AsString;
  137. end
  138. else if ARecord.ValueByName('CalcType').AsInteger = 1 then
  139. begin
  140. if SameText('OrgTotalPrice', AColumn.FieldName) then
  141. sFormula := ARecord.ValueByName('OrgFormula').AsString
  142. else if SameText('MisTotalPrice', AColumn.FieldName) then
  143. sFormula := ARecord.ValueByName('MisFormula').AsString
  144. else if SameText('OthTotalPrice', AColumn.FieldName) then
  145. sFormula := ARecord.ValueByName('OthFormula').AsString;
  146. end;
  147. if sFormula <> '' then
  148. Text := sFormula;
  149. end;
  150. procedure GetDisplayText;
  151. begin
  152. if AValue.DataType = ftFloat then
  153. begin
  154. if not Assigned(AValue) or (AValue.AsFloat = 0) then
  155. Text := '';
  156. end;
  157. end;
  158. begin
  159. if DisplayText then
  160. GetDisplayText
  161. else
  162. GetEditText;
  163. end;
  164. procedure TBillsCompileData.ExpandNodeTo(ALevel: Integer);
  165. begin
  166. BillsCompileTree.ExpandLevel := ALevel;
  167. end;
  168. procedure TBillsCompileData.ExpandXmjNode;
  169. var
  170. iIndex: Integer;
  171. stnNode: TBillsIDTreeNode;
  172. begin
  173. for iIndex := 0 to BillsCompileTree.Count - 1 do
  174. begin
  175. stnNode := TBillsIDTreeNode(BillsCompileTree.Items[iIndex]);
  176. if (stnNode.ParentID <> -1) then
  177. stnNode.Parent.Expanded := stnNode.Rec.B_Code.AsString = '';
  178. end;
  179. end;
  180. procedure TBillsCompileData.sdvBillsCompileAfterValueChanged(
  181. AValue: TsdValue);
  182. procedure ResetChildrenLockedInfo(ANode: TsdIDTreeNode; ALockedInfo: Boolean);
  183. var
  184. iChild: Integer;
  185. begin
  186. if not Assigned(ANode) then Exit;
  187. if ANode.Rec.ValueByName('LockedLevel').AsBoolean then
  188. ANode.Rec.ValueByName('LockedInfo').AsBoolean := ALockedInfo;
  189. if ANode.HasChildren then
  190. for iChild := 0 to ANode.ChildCount - 1 do
  191. ResetChildrenLockedInfo(ANode.ChildNodes[iChild], ALockedInfo);
  192. end;
  193. var
  194. vNode: TBillsIDTreeNode;
  195. begin
  196. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(AValue.Owner.ValueByName('ID').AsInteger));
  197. if SameText(AValue.FieldName, 'OrgQuantity') or
  198. SameText(AValue.FieldName, 'OrgTotalPrice') then
  199. CalculateOrg(AValue.Owner.ValueByName('ID').AsInteger)
  200. else if SameText(AValue.FieldName, 'MisQuantity') or
  201. SameText(AValue.FieldName, 'MisTotalPrice') then
  202. CalculateMis(AValue.Owner.ValueByName('ID').AsInteger)
  203. else if SameText(AValue.FieldName, 'OthQuantity') or
  204. SameText(AValue.FieldName, 'OthTotalPrice') then
  205. CalculateOth(AValue.Owner.ValueByName('ID').AsInteger)
  206. else if SameText(AValue.FieldName, 'Price') then
  207. CalculateTotal(AValue.Owner.ValueByName('ID').AsInteger)
  208. else if SameText(AValue.FieldName, 'DgnQuantity1') then
  209. CalculateDesignPrice(vNode);
  210. if (AValue.FieldName = 'LockedInfo') then
  211. ResetChildrenLockedInfo(vNode, AValue.AsBoolean);
  212. if (AValue.FieldName = 'B_Code') then
  213. begin
  214. AValue.Owner.ValueByName('DgnQuantity1').Clear;
  215. AValue.Owner.ValueByName('DgnQuantity2').Clear;
  216. AValue.Owner.ValueByName('DgnPrice').Clear;
  217. end;
  218. if (AValue.FieldName = 'IsGatherZJJL') then
  219. BillsData.SyncSetOthersGatherZJJL(vNode, BillsCompileTree);
  220. end;
  221. function TBillsCompileData.GatherChildrenOrg(ANode: TsdIDTreeNode): Double;
  222. var
  223. iChild: Integer;
  224. begin
  225. if ANode = nil then Exit;
  226. if ANode.HasChildren and Assigned(ANode.FirstChild) then
  227. begin
  228. Result := 0;
  229. for iChild := 0 to ANode.ChildCount - 1 do
  230. Result := Result + GatherChildrenOrg(ANode.ChildNodes[iChild]);
  231. Result := TotalPriceRoundTo(Result);
  232. end
  233. else
  234. if Assigned(ANode.Rec) and Assigned(ANode.Rec.ValueByName('TotalPrice')) then
  235. Result := ANode.Rec.ValueByName('TotalPrice').AsFloat
  236. else
  237. Result := 0;
  238. end;
  239. procedure TBillsCompileData.UpdateRecordOrg(ABillsID: Integer;
  240. ATotalPrice: Double);
  241. var
  242. stnNode: TsdIDTreeNode;
  243. begin
  244. stnNode := BillsCompileTree.FindNode(ABillsID);
  245. if not Assigned(stnNode) then Exit;
  246. with stnNode.Rec do
  247. begin
  248. ValueByName('TotalPrice').AsFloat := TotalPriceRoundTo(
  249. ValueByName('TotalPrice').AsFloat + ATotalPrice);
  250. if ValueByName('DgnQuantity1').AsFloat <> 0 then
  251. ValueByName('DgnPrice').AsFloat := PriceRoundTo(
  252. ValueByName('TotalPrice').AsFloat/ValueByName('DgnQuantity1').AsFloat);
  253. end;
  254. UpdateRecordOrg(stnNode.ParentID, ATotalPrice);
  255. end;
  256. procedure TBillsCompileData.sdvBillsCompileBeforeValueChange(
  257. AValue: TsdValue; const NewValue: Variant; var Allow: Boolean);
  258. function CheckParentExist(ANode: TBillsIDTreeNode): Boolean;
  259. var
  260. vParent: TBillsIDTreeNode;
  261. begin
  262. Result := False;
  263. vParent := TBillsIDTreeNode(ANode.Parent);
  264. while Assigned(vParent) and not Result do
  265. begin
  266. if vParent.Rec.IsGatherZJJL.AsBoolean then
  267. Result := True;
  268. vParent := TBillsIDTreeNode(vParent.Parent);
  269. end;
  270. end;
  271. procedure CancelParentCheck(ANode: TBillsIDTreeNode);
  272. var
  273. vParent: TBillsIDTreeNode;
  274. begin
  275. vParent := TBillsIDTreeNode(ANode.Parent);
  276. while Assigned(vParent) do
  277. begin
  278. if vParent.Rec.IsGatherZJJL.AsBoolean then
  279. vParent.Rec.IsGatherZJJL.AsBoolean := False;
  280. vParent := TBillsIDTreeNode(vParent.Parent);
  281. end;
  282. end;
  283. function CheckChildrenExist(ANode: TBillsIDTreeNode): Boolean;
  284. var
  285. iChild: Integer;
  286. vChild: TBillsIDTreeNode;
  287. begin
  288. Result := False;
  289. for iChild := 0 to ANode.ChildCount - 1 do
  290. begin
  291. vChild := TBillsIDTreeNode(ANode.ChildNodes[iChild]);
  292. if vChild.Rec.IsGatherZJJL.AsBoolean or CheckChildrenExist(vChild) then
  293. begin
  294. Result := True;
  295. Break;
  296. end;
  297. end;
  298. end;
  299. procedure CancelChildrenCheck(ANode: TBillsIDTreeNode);
  300. var
  301. iChild: Integer;
  302. vChild: TBillsIDTreeNode;
  303. begin
  304. for iChild := 0 to ANode.ChildCount - 1 do
  305. begin
  306. vChild := TBillsIDTreeNode(ANode.ChildNodes[iChild]);
  307. if vChild.Rec.IsGatherZJJL.AsBoolean then
  308. vChild.Rec.IsGatherZJJL.AsBoolean := False
  309. else
  310. CancelChildrenCheck(vChild);
  311. end;
  312. end;
  313. var
  314. vNode: TBillsIDTreeNode;
  315. begin
  316. if SameText(AValue.FieldName, 'OrgQuantity') or
  317. SameText(AValue.FieldName, 'MisQuantity') or
  318. SameText(AValue.FieldName, 'OthQuantity') or
  319. SameText(AValue.FieldName, 'OrgTotalPrice') or
  320. SameText(AValue.FieldName, 'MisTotalPrice') or
  321. SameText(AValue.FieldName, 'OthTotalPrice') or
  322. SameText(AValue.FieldName, 'Price') then
  323. begin
  324. TBillsRecord(AValue.Owner).CacheOrgTP := AValue.Owner.ValueByName('OrgTotalPrice').AsFloat;
  325. TBillsRecord(AValue.Owner).CacheMisTP := AValue.Owner.ValueByName('MisTotalPrice').AsFloat;
  326. TBillsRecord(AValue.Owner).CacheOthTP := AValue.Owner.ValueByName('OthTotalPrice').AsFloat;
  327. end
  328. else if SameText(AValue.FieldName, 'IsGatherZJJL') then
  329. begin
  330. Allow := (TProjectData(FProjectData).ProjProperties.PhaseCount = 0) or TProjectData(FProjectData).CanUnlockInfo;
  331. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(AValue.Owner.ValueByName('ID').AsInteger));
  332. if Allow then
  333. begin
  334. if CheckParentExist(vNode) then
  335. begin
  336. if QuestMessage('父项已勾选,继续将取消父项勾选。') then
  337. CancelParentCheck(vNode)
  338. else
  339. Allow := False;
  340. end
  341. else if CheckChildrenExist(vNode) then
  342. begin
  343. if QuestMessage('子项已勾选,继续将取消子项勾选。') then
  344. CancelChildrenCheck(vNode)
  345. else
  346. Allow := False;
  347. end;
  348. end
  349. else
  350. WarningMessage('开始计量后,计量汇总列不可编辑,如需修改,请先解锁。');
  351. if not Allow and Assigned(FRefreshRow) then
  352. RefreshRow(vNode.MajorIndex);
  353. end;
  354. end;
  355. procedure TBillsCompileData.CalculateAll;
  356. procedure RecursiveCalc(ANode: TsdIDTreeNode);
  357. begin
  358. if not Assigned(ANode) then Exit;
  359. if ANode.HasChildren then
  360. begin
  361. RecursiveCalc(ANode.FirstChild);
  362. GatherNode(TBillsIDTreeNode(ANode));
  363. end
  364. else
  365. CalculateLeaf(TBillsIDTreeNode(ANode));
  366. RecursiveCalc(ANode.NextSibling);
  367. end;
  368. procedure BeginCalc;
  369. begin
  370. sdvBillsCompile.BeforeValueChange := nil;
  371. sdvBillsCompile.AfterValueChanged := nil;
  372. end;
  373. procedure EndCalc;
  374. begin
  375. sdvBillsCompile.BeforeValueChange := sdvBillsCompileBeforeValueChange;
  376. sdvBillsCompile.AfterValueChanged := sdvBillsCompileAfterValueChanged;
  377. end;
  378. begin
  379. BeginCalc;
  380. try
  381. RecursiveCalc(BillsCompileTree.FirstNode);
  382. finally
  383. EndCalc;
  384. end;
  385. end;
  386. procedure TBillsCompileData.AddBillsFromLib(ANode: TsdIDTreeNode;
  387. ABillsType: TBillsType);
  388. begin
  389. if not Assigned(ANode) then Exit;
  390. if ABillsType = btXm then
  391. AddXmjBillsFromLib(ANode)
  392. else if ABillsType = btGcl then
  393. AddGclBillsFromLib(ANode);
  394. end;
  395. procedure TBillsCompileData.AddGclBillsFromLib(
  396. AStdBillsNode: TsdIDTreeNode);
  397. var
  398. stnParent, stnStdNode: TsdIDTreeNode;
  399. iLevel: Integer;
  400. begin
  401. if not CanAddGclBills then
  402. raise Exception.Create('当前节点下不可添加工程量清单!');
  403. stnParent := GetGclBillsParent(BillsCompileTree.Selected);
  404. if TBillsIDTreeNode(stnParent).HasLedger or
  405. (not stnParent.HasChildren and TBillsIDTreeNode(stnParent).HasMeasure) then
  406. raise Exception.Create('当前节点不可添加工程量清单!');
  407. stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level);
  408. for iLevel := 1 to AStdBillsNode.Level + 1 do
  409. begin
  410. if stnStdNode.Rec.ValueByName('B_Code').AsString <> '' then
  411. if FindChild(stnParent, stnStdNode) <> nil then
  412. stnParent := FindChild(stnParent, stnStdNode)
  413. else
  414. stnParent := InsertChild(stnParent, stnStdNode);
  415. stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level - iLevel);
  416. end;
  417. end;
  418. procedure TBillsCompileData.AddXmjBillsFromLib(
  419. AStdBillsNode: TsdIDTreeNode);
  420. var
  421. stnStdNode, stnCurNode: TsdIDTreeNode;
  422. iLevel: Integer;
  423. begin
  424. stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level);
  425. stnCurNode := nil;
  426. for iLevel := 1 to AStdBillsNode.Level + 1 do
  427. begin
  428. if FindChild(stnCurNode, stnStdNode) <> nil then
  429. stnCurNode := FindChild(stnCurNode, stnStdNode)
  430. else if Assigned(stnCurNode) then
  431. begin
  432. if TBillsIDTreeNode(stnCurNode).HasLedger or
  433. (not stnCurNode.HasChildren and TBillsIDTreeNode(stnCurNode).HasMeasure) then
  434. raise Exception.Create('不可添加该项目节数据!')
  435. else
  436. stnCurNode := InsertChild(stnCurNode, stnStdNode);
  437. end
  438. else
  439. Break;
  440. stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level - iLevel);
  441. end;
  442. end;
  443. function TBillsCompileData.CanAddGclBills: Boolean;
  444. function CheckChildrenHasXmj(ANode: TsdIDTreeNode): Boolean;
  445. var
  446. stnCurNode: TsdIDTreeNode;
  447. begin
  448. Result := False;
  449. if not ANode.HasChildren then Exit;
  450. stnCurNode := ANode.FirstChild;
  451. while not Result and Assigned(stnCurNode) do
  452. begin
  453. Result := Result or (stnCurNode.Rec.ValueByName('Code').AsString <> '');
  454. if stnCurNode.HasChildren then
  455. Result := Result or CheckChildrenHasXmj(stnCurNode);
  456. stnCurNode := stnCurNode.NextSibling;
  457. end;
  458. end;
  459. function CheckParentIsXmj(ANode: TsdIDTreeNode): Boolean;
  460. begin
  461. Result := False;
  462. if not Assigned(ANode) then Exit;
  463. Result := ANode.Rec.ValueByName('Code').AsString <> '';
  464. if not Result then
  465. Result := Result or CheckParentIsXmj(ANode.Parent);
  466. end;
  467. begin
  468. Result := False;
  469. if not Assigned(BillsCompileTree.Selected) then Exit;
  470. Result := CheckParentIsXmj(BillsCompileTree.Selected)
  471. and not CheckChildrenHasXmj(BillsCompileTree.Selected);
  472. end;
  473. function TBillsCompileData.CompareNodeCode(ANode,
  474. ACompareNode: TsdIDTreeNode): Integer;
  475. begin
  476. if ANode.Rec.ValueByName('Code').AsString <> '' then
  477. Result := CompareCode(ANode.Rec.ValueByName('Code').AsString,
  478. ACompareNode.Rec.ValueByName('Code').AsString)
  479. else if ANode.Rec.ValueByName('B_Code').AsString <> '' then
  480. Result := CompareCode(ANode.Rec.ValueByName('B_Code').AsString,
  481. ACompareNode.Rec.ValueByName('B_Code').AsString);
  482. end;
  483. function TBillsCompileData.GetGclBillsParent(
  484. AChildNode: TsdIDTreeNode): TsdIDTreeNode;
  485. begin
  486. if AChildNode.Rec.ValueByName('B_Code').AsString <> '' then
  487. Result := GetGclBillsParent(AChildNode.Parent)
  488. else
  489. Result := AChildNode;
  490. end;
  491. function TBillsCompileData.GetNextSiblingID(AParent,
  492. ANode: TsdIDTreeNode): Integer;
  493. var
  494. stnCurNode: TsdIDTreeNode;
  495. begin
  496. Result := -1;
  497. if Assigned(AParent) then
  498. stnCurNode := AParent.FirstChild
  499. else
  500. stnCurNode := BillsCompileTree.FirstNode;
  501. if not Assigned(stnCurNode) then Exit;
  502. while Assigned(stnCurNode) do
  503. begin
  504. if CompareNodeCode(stnCurNode, ANode) >= 0 then
  505. begin
  506. Result := stnCurNode.ID;
  507. Exit;
  508. end;
  509. stnCurNode := stnCurNode.NextSibling;
  510. end;
  511. end;
  512. function TBillsCompileData.GetTopParentNode(ANode: TsdIDTreeNode;
  513. ALevel: Integer): TsdIDTreeNode;
  514. begin
  515. Result := ANode;
  516. while Assigned(Result.Parent) and (Result.Level + ALevel > ANode.Level) do
  517. Result := Result.Parent;
  518. end;
  519. function TBillsCompileData.IsSameNode(ANode,
  520. ACompareNode: TsdIDTreeNode): Boolean;
  521. begin
  522. if ANode.Rec.ValueByName('StaticID').AsInteger > 0 then
  523. Result := (ANode.Rec.ValueByName('StaticID').AsInteger = ACompareNode.Rec.ValueByName('ID').AsInteger)
  524. else
  525. Result := (ANode.Rec.ValueByName('Code').AsString = ACompareNode.Rec.ValueByName('Code').AsString)
  526. and (ANode.Rec.ValueByName('B_Code').AsString = ACompareNode.Rec.ValueByName('B_Code').AsString)
  527. and (ANode.Rec.ValueByName('Name').AsString = ACompareNode.Rec.ValueByName('Name').AsString);
  528. end;
  529. function TBillsCompileData.FindChild(AParentNode,
  530. ANode: TsdIDTreeNode): TsdIDTreeNode;
  531. function FindSibling(AFirstNode, ANode: TsdIDTreeNode): TsdIDTreeNode;
  532. var
  533. stnCurNode: TsdIDTreeNode;
  534. begin
  535. Result := nil;
  536. stnCurNode := AFirstNode;
  537. while Assigned(stnCurNode) and not Assigned(Result) do
  538. begin
  539. if IsSameNode(ANode, stnCurNode) then
  540. Result := stnCurNode;
  541. stnCurNode := stnCurNode.NextSibling;
  542. end;
  543. end;
  544. begin
  545. if not Assigned(AParentNode) then
  546. Result := FindSibling(BillsCompileTree.FirstNode, ANode)
  547. else
  548. Result := FindSibling(AParentNode.FirstChild, ANode);
  549. end;
  550. function TBillsCompileData.InsertChild(AParentNode,
  551. ANode: TsdIDTreeNode): TsdIDTreeNode;
  552. var
  553. iID, iNextSiblingID: Integer;
  554. begin
  555. iNextSiblingID := GetNextSiblingID(AParentNode, ANode);
  556. iID := ANode.Rec.ValueByName('StaticID').AsInteger;
  557. if Assigned(AParentNode) then
  558. Result := BillsCompileTree.AddNode(AParentNode.ID, iNextSiblingID, iID)
  559. else
  560. Result := BillsCompileTree.AddNode(-1, iNextSiblingID, iID);
  561. Result.Rec.ValueByName('Code').AsString := ANode.Rec.ValueByName('Code').AsString;
  562. Result.Rec.ValueByName('B_Code').AsString := ANode.Rec.ValueByName('B_Code').AsString;
  563. Result.Rec.ValueByName('Name').AsString := ANode.Rec.ValueByName('Name').AsString;
  564. Result.Rec.ValueByName('Units').AsString := ANode.Rec.ValueByName('Unit').AsString;
  565. end;
  566. procedure TBillsCompileData.sdvBillsCompileSetText(var Text: String;
  567. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  568. var Allow: Boolean);
  569. procedure SetTextErrorHint(const AHint: string);
  570. begin
  571. ErrorMessage(AHint);
  572. Allow := False;
  573. end;
  574. procedure SetQuantity(const AFieldName: string);
  575. var
  576. sPre: string;
  577. begin
  578. sPre := StringReplace(AFieldName, 'Quantity', '', [rfIgnoreCase, rfReplaceAll]);
  579. if CheckStringNull(Text) or CheckNumeric(Text) then
  580. begin
  581. ARecord.ValueByName(sPre + 'Formula').AsString := '';
  582. Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)));
  583. end
  584. else
  585. begin
  586. ARecord.ValueByName(sPre + 'Formula').AsString := Text;
  587. Text := FloatToStr(QuantityRoundTo(EvaluateExprs(Text)));
  588. end;
  589. ARecord.ValueByName('CalcType').AsInteger := 0;
  590. end;
  591. procedure SetTotalPrice(const AFieldName: string);
  592. var
  593. sPre: string;
  594. begin
  595. sPre := StringReplace(AFieldName, 'TotalPrice', '', [rfIgnoreCase, rfReplaceAll]);
  596. if CheckStringNull(Text) or CheckNumeric(Text) then
  597. begin
  598. ARecord.ValueByName(sPre + 'Formula').AsString := '';
  599. Text := FloatToStr(TotalPriceRoundTo(StrToFloatDef(Text, 0)));
  600. end
  601. else
  602. begin
  603. ARecord.ValueByName(sPre + 'Formula').AsString := Text;
  604. Text := FloatToStr(TotalPriceRoundTo(EvaluateExprs(Text)));
  605. end;
  606. ARecord.ValueByName('CalcType').AsInteger := 1;
  607. end;
  608. procedure SetDgnQuantity;
  609. begin
  610. Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)));
  611. end;
  612. procedure SetPrice;
  613. begin
  614. Text := FloatToStr(PriceRoundTo(StrToFloatDef(Text, 0)));
  615. ARecord.ValueByName('CalcType').AsInteger := 0;
  616. end;
  617. procedure DoCurChanged(ANode: TBillsIDTreeNode);
  618. begin
  619. if SameText(AColumn.FieldName, 'OrgQuantity') or
  620. SameText(AColumn.FieldName, 'MisQuantity') or
  621. SameText(AColumn.FieldName, 'OthQuantity')then
  622. SetQuantity(AColumn.FieldName)
  623. else if SameText(AColumn.FieldName, 'OrgTotalPrice') or
  624. SameText(AColumn.FieldName, 'MisTotalPrice') or
  625. SameText(AColumn.FieldName, 'OthTotalPrice') then
  626. SetTotalPrice(AColumn.FieldName)
  627. else if Pos('DgnQuantity', AColumn.FieldName) = 1 then
  628. SetDgnQuantity
  629. else if SameText(AColumn.FieldName, 'Price') then
  630. SetPrice
  631. else if SameText(AColumn.FieldName, 'Code') then
  632. BillsCompileTree.RecodeChildrenCode(ANode, AValue.AsString, Text)
  633. else if SameText(AColumn.FieldName, 'B_Code') then
  634. BillsCompileTree.RecodeChildrenB_Code(ANode, AValue.AsString, Text);
  635. end;
  636. procedure CheckLockedData;
  637. begin
  638. if SameText(AColumn.FieldName, 'Code') or
  639. SameText(AColumn.FieldName, 'B_Code') or
  640. SameText(AColumn.FieldName, 'Name') or
  641. SameText(AColumn.FieldName, 'Units') or
  642. SameText(AColumn.FieldName, 'Price') or
  643. SameText(AColumn.FieldName, 'OrgQuantity') or
  644. SameText(AColumn.FieldName, 'OrgTotalPrice') or
  645. SameText(AColumn.FieldName, 'MisQuantity') or
  646. SameText(AColumn.FieldName, 'MisTotalPrice') or
  647. SameText(AColumn.FieldName, 'OthQuantity') or
  648. SameText(AColumn.FieldName, 'OthTotalPrice') or
  649. SameText(AColumn.FieldName, 'DrawingCode')then
  650. if ARecord.ValueByName('LockedInfo').AsBoolean then
  651. SetTextErrorHint('清单信息已被锁定,不允许修改编号、名称、单位、清单单价、0号台账数量与金额、图号!');
  652. end;
  653. procedure CheckNodeWritable(ANode: TBillsIDTreeNode);
  654. var
  655. iCreatePhase: Integer;
  656. begin
  657. if not Allow then Exit;
  658. iCreatePhase := ANode.Rec.ValueByName('CreatePhaseID').AsInteger;
  659. if ANode.ID = iPriceMarginID then
  660. SetTextErrorHint(sBills_PMHint);
  661. if ANode.HasChildren then
  662. begin
  663. if Text = '' then
  664. Exit
  665. else if ((Pos('Quantity', AColumn.FieldName) > 0) and (Pos('Dgn', AColumn.FieldName) <=0)) or
  666. (Pos('TotalPrice', AColumn.FieldName) > 0) then
  667. SetTextErrorHint('该清单有子计算项,不能直接修改!')
  668. else if (Pos('Price', AColumn.FieldName) > 0) then
  669. SetTextErrorHint('仅最底层清单可输入单价!');
  670. if not Allow then Exit;
  671. end
  672. else
  673. begin
  674. if SameText('OrgTotalPrice', AColumn.FieldName) or
  675. SameText('MisTotalPrice', AColumn.FieldName) or
  676. SameText('OthTotalPrice', AColumn.FieldName) then
  677. begin
  678. if not ANode.TotalPriceEnable then
  679. SetTextErrorHint('该清单不可直接输入金额,如需直接输入金额,请先清空所有数量、单价!');
  680. end;
  681. if not Allow then Exit;
  682. if SameText('Price', AColumn.FieldName) or
  683. SameText('OrgQuantity', AColumn.FieldName) or
  684. SameText('MisQuantity', AColumn.FieldName) or
  685. SameText('OthQuantity', AColumn.FieldName) then
  686. begin
  687. if not ANode.CountPriceEnable then
  688. SetTextErrorHint('该清单不可输入数量单价,如需使用数量×单价计算,请先清空所有直接输入的金额!');
  689. end;
  690. if not Allow then Exit;
  691. end;
  692. // 清单编号和项目节编号不可同时存在
  693. if SameText(AValue.FieldName, 'Code') then
  694. begin
  695. if AValue.Owner.ValueByName('B_Code').AsString <> '' then
  696. SetTextErrorHint('已存在清单编号,不可输入项目节编号!');
  697. end
  698. else if SameText(AValue.FieldName, 'B_Code') then
  699. begin
  700. if AValue.Owner.ValueByName('Code').AsString <> '' then
  701. SetTextErrorHint('已存在项目节编号,不可输入清单编号!');
  702. end
  703. //
  704. else if SameText(AValue.FieldName, 'Price') then
  705. begin
  706. if AValue.Owner.ValueByName('AddGatherTotalPrice').AsFloat <> 0 then
  707. SetTextErrorHint('该清单已经开始计量,不可修改单价!');
  708. end
  709. // 变更清单不可修改0号台账数据
  710. else if SameText(AValue.FieldName, 'OrgQuantity') or
  711. SameText(AValue.FieldName, 'OrgTotalPrice') or
  712. SameText(AValue.FieldName, 'MisQuantity') or
  713. SameText(AValue.FieldName, 'MisTotalPrice') or
  714. SameText(AValue.FieldName, 'OthQuantity') or
  715. SameText(AValue.FieldName, 'OthTotalPrice') then
  716. begin
  717. if AValue.Owner.ValueByName('IsMeasureAdd').AsBoolean then
  718. SetTextErrorHint('变更清单不可填写0号台账数量与金额');
  719. end;
  720. if not Allow then Exit;
  721. if SameText('Code', AColumn.FieldName) or
  722. SameText('B_Code', AColumn.FieldName) or
  723. SameText('Name', AColumn.FieldName) or
  724. SameText('Units', AColumn.FieldName) or
  725. SameText('Price', AColumn.FieldName) then
  726. if TBillsIDTreeNode(ANode).HasMeasure then
  727. SetTextErrorHint('该清单已经计量,不可修改清单编号');
  728. end;
  729. function CheckValidData: Boolean;
  730. begin
  731. Result := (AValue.AsString <> Text);
  732. if SameText(AColumn.FieldName, 'OrgQuantity') or
  733. SameText(AColumn.FieldName, 'OrgTotalPrice') or
  734. SameText(AColumn.FieldName, 'MisQuantity') or
  735. SameText(AColumn.FieldName, 'MisTotalPrice') or
  736. SameText(AColumn.FieldName, 'OthQuantity') or
  737. SameText(AColumn.FieldName, 'OthTotalPrice') or
  738. SameText(AColumn.FieldName, 'Price') then
  739. begin
  740. if (AValue.AsFloat = 0) and (Text = '') then
  741. Result := False;
  742. end;
  743. end;
  744. var
  745. vNode: TBillsIDTreeNode;
  746. begin
  747. if not Assigned(AValue) then Exit;
  748. // 修改后数据与原数据相同则不提交
  749. if not CheckValidData then
  750. Allow := False;
  751. if not Allow then Exit;
  752. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ARecord.ValueByName('ID').AsInteger));
  753. CheckLockedData;
  754. if not Allow then Exit;
  755. CheckNodeWritable(vNode);
  756. if not Allow then Exit;
  757. Text := Trim(Text);
  758. if Pos('=', Text) = 1 then
  759. Text := Copy(Text, 2, Length(Text) - 1);
  760. DoCurChanged(vNode);
  761. end;
  762. function TBillsCompileData.GetActive: Boolean;
  763. begin
  764. Result := sdvBillsCompile.Active;
  765. end;
  766. function TBillsCompileData.GetLeafXmjParentID(ABillsID: Integer): Integer;
  767. var
  768. stnNode: TsdIDTreeNode;
  769. begin
  770. stnNode := BillsCompileTree.FindNode(ABillsID);
  771. Result := GetGclBillsParent(stnNode).ID;
  772. end;
  773. procedure TBillsCompileData.sdvBillsCompileAfterOpen(Sender: TObject);
  774. begin
  775. BillsCompileTree.Active := True;
  776. end;
  777. procedure TBillsCompileData.sdvBillsCompileAfterClose(Sender: TObject);
  778. begin
  779. BillsCompileTree.Active := False;
  780. end;
  781. procedure TBillsCompileData.ReorderChildrenCode(ANode: TsdIDTreeNode);
  782. var
  783. iChild: Integer;
  784. sParentCode: string;
  785. stnChild: TsdIDTreeNode;
  786. begin
  787. if not Assigned(ANode) then Exit;
  788. sParentCode := ANode.Rec.ValueByName('Code').AsString;
  789. for iChild := 0 to ANode.ChildCount - 1 do
  790. begin
  791. stnChild := ANode.ChildNodes[iChild];
  792. if stnChild.Rec.ValueByName('Code').AsString <> '' then
  793. stnChild.Rec.ValueByName('Code').AsString := sParentCode + '-' + IntToStr(iChild + 1);
  794. ReorderChildrenCode(stnChild);
  795. end;
  796. end;
  797. procedure TBillsCompileData.sdvBillsCompileAfterAddRecord(
  798. ARecord: TsdDataRecord);
  799. begin
  800. // 解锁前,新增清单为变更清单,解锁后,新增清单为0号台账清单
  801. if TProjectData(FProjectData).ProjProperties.PhaseCount > 0 then
  802. ARecord.ValueByName('IsMeasureAdd').AsBoolean := not TProjectData(FProjectData).CanUnlockInfo;
  803. end;
  804. procedure TBillsCompileData.DoOnAfterDeleteNode(AParent: TsdIDTreeNode);
  805. begin
  806. if Assigned(AParent) and (AParent.ID > 0) then
  807. Calculate(AParent.ID);
  808. end;
  809. procedure TBillsCompileData.Close;
  810. begin
  811. sdvBillsCompile.Close;
  812. end;
  813. procedure TBillsCompileData.SetOnRecChange(const Value: TRecChangeEvent);
  814. begin
  815. FOnRecChange := Value;
  816. end;
  817. procedure TBillsCompileData.sdvBillsCompileCurrentChanged(
  818. ARecord: TsdDataRecord);
  819. begin
  820. if Assigned(FOnRecChange) then
  821. FOnRecChange(ARecord);
  822. end;
  823. procedure TBillsCompileData.ReLockBaseData;
  824. procedure LockNodeBaseData(ANode: TsdIDTreeNode);
  825. begin
  826. if not Assigned(ANode) then Exit;
  827. if ANode.Rec.ValueByName('LockedLevel').AsBoolean then
  828. if not ANode.Rec.ValueByName('LockedInfo').AsBoolean then
  829. ANode.Rec.ValueByName('LockedInfo').AsBoolean := True;
  830. LockNodeBaseData(ANode.FirstChild);
  831. LockNodeBaseData(ANode.NextSibling);
  832. end;
  833. begin
  834. sdvBillsCompile.AfterValueChanged := nil;
  835. try
  836. LockNodeBaseData(FBillsCompileTree.FirstNode);
  837. finally
  838. sdvBillsCompile.AfterValueChanged := sdvBillsCompileAfterValueChanged;
  839. end;
  840. end;
  841. procedure TBillsCompileData.AddBillsFromDealBills(ARec: TsdDataRecord);
  842. var
  843. stnParent, stnNode: TsdIDTreeNode;
  844. begin
  845. if not CanAddGclBills then
  846. raise Exception.Create('当前节点下不可添加工程量清单!');
  847. stnParent := GetGclBillsParent(BillsCompileTree.Selected);
  848. if TBillsIDTreeNode(stnParent).HasLedger or
  849. (not stnParent.HasChildren and TBillsIDTreeNode(stnParent).HasMeasure) then
  850. raise Exception.Create('当前节点不可添加工程量清单!');
  851. stnNode := BillsCompileTree.Add(stnParent.ID, -1);
  852. stnNode.Rec.ValueByName('B_Code').AsString := ARec.ValueByName('B_Code').AsString;
  853. stnNode.Rec.ValueByName('Name').AsString := ARec.ValueByName('Name').AsString;
  854. stnNode.Rec.ValueByName('Units').AsString := ARec.ValueByName('Units').AsString;
  855. stnNode.Rec.ValueByName('Price').AsString := ARec.ValueByName('Price').AsString;
  856. end;
  857. procedure TBillsCompileData.CalculateMis(ABillsID: Integer);
  858. var
  859. vNode: TBillsIDTreeNode;
  860. iChild: Integer;
  861. begin
  862. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  863. if not Assigned(vNode) then Exit;
  864. if vNode.HasChildren then
  865. begin
  866. for iChild := 0 to vNode.ChildCount - 1 do
  867. CalculateMis(vNode.ChildNodes[iChild].ID);
  868. end
  869. else
  870. begin
  871. with vNode.Rec do
  872. begin
  873. // 数量单价模式则计算金额
  874. if CalcType.AsInteger = 0 then
  875. MisTotalPrice.AsFloat := TotalPriceRoundTo(MisQuantity.AsFloat * Price.AsFloat);
  876. SetFloatValue(Quantity, QuantityRoundTo(
  877. OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat));
  878. // 金额与修改前不一样,则向父项增量
  879. if MisTotalPrice.AsFloat <> CacheMisTP then
  880. begin
  881. UpdateParent(vNode.ParentID, MisTotalPrice.AsFloat - CacheMisTP, 'MisTotalPrice');
  882. TotalPrice.AsFloat := TotalPriceRoundTo(
  883. OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
  884. CacheMisTP := MisTotalPrice.AsFloat;
  885. end;
  886. end;
  887. end;
  888. CalculateDesignPrice(vNode);
  889. end;
  890. procedure TBillsCompileData.CalculateOrg(ABillsID: Integer);
  891. var
  892. vNode: TBillsIDTreeNode;
  893. iChild: Integer;
  894. fValue: Double;
  895. begin
  896. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  897. if not Assigned(vNode) then Exit;
  898. if vNode.HasChildren then
  899. begin
  900. for iChild := 0 to vNode.ChildCount - 1 do
  901. CalculateOrg(vNode.ChildNodes[iChild].ID);
  902. end
  903. else
  904. begin
  905. with vNode.Rec do
  906. begin
  907. // 数量单价模式则计算金额
  908. if CalcType.AsInteger = 0 then
  909. OrgTotalPrice.AsFloat := TotalPriceRoundTo(OrgQuantity.AsFloat * Price.AsFloat);
  910. SetFloatValue(Quantity, QuantityRoundTo(
  911. OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat));
  912. // 金额与修改前不一样,则向父项增量
  913. if CacheOrgTP <> OrgTotalPrice.AsFloat then
  914. begin
  915. UpdateParent(vNode.ParentID, OrgTotalPrice.AsFloat - CacheOrgTP, 'OrgTotalPrice');
  916. TotalPrice.AsFloat := TotalPriceRoundTo(
  917. OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
  918. CacheOrgTP := OrgTotalPrice.AsFloat;
  919. end;
  920. end;
  921. end;
  922. CalculateDesignPrice(vNode);
  923. end;
  924. procedure TBillsCompileData.CalculateOth(ABillsID: Integer);
  925. var
  926. vNode: TBillsIDTreeNode;
  927. iChild: Integer;
  928. begin
  929. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  930. if not Assigned(vNode) then Exit;
  931. if vNode.HasChildren then
  932. begin
  933. for iChild := 0 to vNode.ChildCount - 1 do
  934. CalculateOth(vNode.ChildNodes[iChild].ID);
  935. end
  936. else
  937. begin
  938. with vNode.Rec do
  939. begin
  940. // 数量单价模式则计算金额
  941. if CalcType.AsInteger = 0 then
  942. OthTotalPrice.AsFloat := TotalPriceRoundTo(OthQuantity.AsFloat * Price.AsFloat);
  943. SetFloatValue(Quantity, QuantityRoundTo(
  944. OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat));
  945. // 金额与修改前不一样,则向父项增量
  946. if OthTotalPrice.AsFloat <> CacheOthTP then
  947. begin
  948. UpdateParent(vNode.ParentID, OthTotalPrice.AsFloat - CacheOthTP, 'OthTotalPrice');
  949. TotalPrice.AsFloat := TotalPriceRoundTo(
  950. OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat+ OthTotalPrice.AsFloat);
  951. CacheOthTP := OthTotalPrice.AsFloat;
  952. end;
  953. end;
  954. end;
  955. CalculateDesignPrice(vNode);
  956. end;
  957. function TBillsCompileData.GatherChildren(ANode: TsdIDTreeNode;
  958. const AFieldName: string): Double;
  959. var
  960. iChild: Integer;
  961. begin
  962. Result := 0;
  963. if not Assigned(ANode) then Exit;
  964. if ANode.HasChildren and Assigned(ANode.FirstChild) then
  965. begin
  966. Result := 0;
  967. for iChild := 0 to ANode.ChildCount - 1 do
  968. Result := Result + ANode.Rec.ValueByName(AFieldName).AsFloat;
  969. Result := TotalPriceRoundTo(Result);
  970. end
  971. else
  972. if Assigned(ANode.Rec) and Assigned(ANode.Rec.ValueByName(AFieldName)) then
  973. Result := ANode.Rec.ValueByName(AFieldName).AsFloat;
  974. end;
  975. procedure TBillsCompileData.UpdateParent(ABillsID: Integer;
  976. ADifferTotalPrice: Double; const AFieldName: string);
  977. var
  978. vNode: TBillsIDTreeNode;
  979. begin
  980. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  981. if not Assigned(vNode) then Exit;
  982. with vNode.Rec do
  983. begin
  984. ValueByName(AFieldName).AsFloat := TotalPriceRoundTo(
  985. ValueByName(AFieldName).AsFloat + ADifferTotalPrice);
  986. TotalPrice.AsFloat := TotalPriceRoundTo(TotalPrice.AsFloat + ADifferTotalPrice);
  987. end;
  988. CalculateDesignPrice(vNode);
  989. UpdateParent(vNode.ParentID, ADifferTotalPrice, AFieldName);
  990. end;
  991. procedure TBillsCompileData.CalculateTotal(ABillsID: Integer);
  992. begin
  993. CalculateOrg(ABillsID);
  994. CalculateMis(ABillsID);
  995. CalculateOth(ABillsID);
  996. end;
  997. procedure TBillsCompileData.CalculateBills(ANode: TsdIDTreeNode);
  998. var
  999. iChild: Integer;
  1000. begin
  1001. if not Assigned(ANode) then Exit;
  1002. if ANode.HasChildren then
  1003. begin
  1004. for iChild := 0 to ANode.ChildCount - 1 do
  1005. CalculateBills(ANode.ChildNodes[iChild]);
  1006. GatherNode(TBillsIDTreeNode(ANode));
  1007. end
  1008. else
  1009. CalculateLeaf(TBillsIDTreeNode(ANode));
  1010. end;
  1011. procedure TBillsCompileData.CalculateLeaf(ANode: TBillsIDTreeNode);
  1012. begin
  1013. if not Assigned(ANode) or ANode.HasChildren then Exit;
  1014. with ANode.Rec do
  1015. begin
  1016. // 分项
  1017. if CalcType.AsFloat = 0 then
  1018. begin
  1019. OrgTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OrgQuantity.AsFloat);
  1020. MisTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * MisQuantity.AsFloat);
  1021. OthTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OthQuantity.AsFloat);
  1022. end;
  1023. // 汇总
  1024. Quantity.AsFloat := QuantityRoundTo(
  1025. OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
  1026. TotalPrice.AsFloat := TotalPriceRoundTo(
  1027. OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
  1028. end;
  1029. CalculateDesignPrice(ANode);
  1030. end;
  1031. procedure TBillsCompileData.GatherNode(ANode: TBillsIDTreeNode);
  1032. var
  1033. iChild: Integer;
  1034. fOrg, fMis, fOth: Double;
  1035. vChild: TBillsIDTreeNode;
  1036. begin
  1037. fOrg := 0;
  1038. fMis := 0;
  1039. fOth := 0;
  1040. for iChild := 0 to ANode.ChildCount - 1 do
  1041. begin
  1042. vChild := TBillsIDTreeNode(ANode.ChildNodes[iChild]);
  1043. fOrg := fOrg + vChild.Rec.OrgTotalPrice.AsFloat;
  1044. fMis := fMis + vChild.Rec.MisTotalPrice.AsFloat;
  1045. fOth := fOth + vChild.Rec.OthTotalPrice.AsFloat;
  1046. end;
  1047. ANode.Rec.OrgTotalPrice.AsFloat := TotalPriceRoundTo(fOrg);
  1048. ANode.Rec.MisTotalPrice.AsFloat := TotalPriceRoundTo(fMis);
  1049. ANode.Rec.OthTotalPrice.AsFloat := TotalPriceRoundTo(fOth);
  1050. ANode.Rec.TotalPrice.AsFloat := TotalPriceRoundTo(fOrg + fMis + fOth);
  1051. CalculateDesignPrice(ANode);
  1052. end;
  1053. procedure TBillsCompileData.Calculate(ABillsID: Integer);
  1054. procedure UpdateParent(ANode: TBillsIDTreeNode; ADifferOrg, ADifferMis, ADifferOth: Double);
  1055. begin
  1056. if not Assigned(ANode) then Exit;
  1057. with ANode.Rec do
  1058. begin
  1059. OrgTotalPrice.AsFloat := TotalPriceRoundTo(OrgTotalPrice.AsFloat + ADifferOrg);
  1060. MisTotalPrice.AsFloat := TotalPriceRoundTo(MisTotalPrice.AsFloat + ADifferMis);
  1061. OthTotalPrice.AsFloat := TotalPriceRoundTo(OthTotalPrice.AsFloat + ADifferOth);
  1062. TotalPrice.AsFloat := TotalPriceRoundTo(
  1063. TotalPrice.AsFloat + ADifferOrg + ADifferMis + ADifferOth);
  1064. if DgnQuantity1.AsFloat <> 0 then
  1065. DgnPrice.AsFloat := PriceRoundTo(TotalPrice.AsFloat/DgnQuantity1.AsFloat);
  1066. end;
  1067. UpdateParent(TBillsIDTreeNode(ANode.Parent), ADifferOrg, ADifferMis, ADifferOth);
  1068. end;
  1069. var
  1070. vNode: TBillsIDTreeNode;
  1071. iChild: Integer;
  1072. fOrg, fMis, fOth: Double;
  1073. begin
  1074. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  1075. if not Assigned(vNode) then Exit;
  1076. fOrg := vNode.Rec.OrgTotalPrice.AsFloat;
  1077. fMis := vNode.Rec.MisTotalPrice.AsFloat;
  1078. fOth := vNode.Rec.OthTotalPrice.AsFloat;
  1079. CalculateBills(vNode);
  1080. fOrg := vNode.Rec.OrgTotalPrice.AsFloat - fOrg;
  1081. fMis := vNode.Rec.MisTotalPrice.AsFloat - fMis;
  1082. fOth := vNode.Rec.OthTotalPrice.AsFloat - fOth;
  1083. UpdateParent(TBillsIDTreeNode(vNode.Parent), fOrg, fMis, fOth);
  1084. end;
  1085. procedure TBillsCompileData.CalculateDesignPrice(ANode: TBillsIDTreeNode);
  1086. begin
  1087. if QuantityRoundTo(ANode.Rec.DgnQuantity1.AsFloat) <> 0 then
  1088. ANode.Rec.DgnPrice.AsFloat := PriceRoundTo(
  1089. ANode.Rec.TotalPrice.AsFloat/ANode.Rec.DgnQuantity1.AsFloat)
  1090. else
  1091. ANode.Rec.DgnPrice.Clear;
  1092. end;
  1093. procedure TBillsCompileData.ExpandPegXmjNode;
  1094. function HasPegChild(ANode: TBillsIDTreeNode): Boolean;
  1095. var
  1096. NextNode: TBillsIDTreeNode;
  1097. begin
  1098. Result := False;
  1099. NextNode := TBillsIDTreeNode(ANode.NextNode);
  1100. while ((NextNode.MajorIndex - ANode.MajorIndex) <= ANode.PosterityCount) do
  1101. begin
  1102. if CheckPeg(NextNode.Rec.Name.AsString) then
  1103. begin
  1104. Result := True;
  1105. Break;
  1106. end;
  1107. NextNode := TBillsIDTreeNode(NextNode.NextNode);
  1108. end;
  1109. end;
  1110. function HasGclChild(ANode: TBillsIDTreeNode): Boolean;
  1111. var
  1112. vChild: TBillsIDTreeNode;
  1113. begin
  1114. Result := True;
  1115. vChild := TBillsIDTreeNode(ANode.FirstChild);
  1116. while Assigned(vChild) and not Result do
  1117. begin
  1118. if vChild.Rec.B_Code.AsString <> '' then
  1119. Result := False;
  1120. vChild := TBillsIDTreeNode(vChild.NextSibling);
  1121. end;
  1122. end;
  1123. var
  1124. iIndex: Integer;
  1125. vNode: TBillsIDTreeNode;
  1126. begin
  1127. for iIndex := 0 to BillsCompileTree.Count - 1 do
  1128. begin
  1129. vNode := TBillsIDTreeNode(BillsCompileTree.Items[iIndex]);
  1130. if vNode.HasChildren then
  1131. vNode.Expanded := HasPegChild(vNode) or not HasGclChild(vNode);
  1132. end;
  1133. end;
  1134. procedure TBillsCompileData.RecursiveExportBillsJson(
  1135. const AFileName: string);
  1136. var
  1137. sgs: TStrings;
  1138. function GetNodeData(ANode: TBillsIDTreeNode; AOrder: Integer; AFullPath: string): string;
  1139. const
  1140. sBillsJson = '"id": %d, "pid": %d, "order": %d, "full_path": "%s", "level": %d, "is_leaf" : %d, ' +
  1141. '"code": "%s", "b_code": "%s", "name": "%s", "unit": "%s"';
  1142. begin
  1143. Result := Format(sBillsJson, [ANode.Rec.ID.AsInteger, ANode.Rec.ParentID.AsInteger, AOrder, AFullPath, ANode.Level + 1, Integer(not ANode.HasChildren),
  1144. ANode.Rec.Code.AsString, ANode.Rec.B_Code.AsString, ANode.Rec.Name.AsString, ANode.Rec.Units.AsString]);
  1145. end;
  1146. procedure ExportNode(ANode: TsdIDTreeNode; AOrder: Integer; AParentPath: string);
  1147. var
  1148. sNodePath: string;
  1149. begin
  1150. if not Assigned(ANode) then Exit;
  1151. if AParentPath = '' then
  1152. sNodePath := IntToStr(ANode.ID)
  1153. else
  1154. sNodePath := AParentPath + '-' + IntToStr(ANode.ID);
  1155. sgs.Strings[sgs.Count - 1] := sgs.Strings[sgs.Count - 1] + '{';
  1156. sgs.Add(Format(' %s', [AnsiToUtf8(GetNodeData(TBillsIDTreeNode(ANode), AOrder, sNodePath))]));
  1157. sgs.Add('}');
  1158. if Assigned(ANode.NextNode) then
  1159. sgs.Strings[sgs.Count - 1] := sgs.Strings[sgs.Count - 1] + ',';
  1160. ExportNode(ANode.FirstChild, 1, sNodePath);
  1161. ExportNode(ANode.NextSibling, AOrder + 1, AParentPath);
  1162. end;
  1163. begin
  1164. sgs := TStringList.Create;
  1165. try
  1166. sgs.Add('[');
  1167. ExportNode(FBillsCompileTree.FirstNode, 1, '');
  1168. sgs.Strings[sgs.Count - 1] := sgs.Strings[sgs.Count - 1] + ']';
  1169. sgs.SaveToFile(AFileName);
  1170. finally
  1171. sgs.Free;
  1172. end;
  1173. end;
  1174. end.