BillsCompileDm.pas 42 KB

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