BillsCompileDm.pas 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002
  1. unit BillsCompileDm;
  2. interface
  3. uses
  4. BillsDm, StandardBillsFme,
  5. SysUtils, Classes, sdDB, BillsTree, sdIDTree;
  6. type
  7. TBillsCompileData = class(TDataModule)
  8. sdvBillsCompile: TsdDataView;
  9. procedure sdvBillsCompileGetText(var Text: String;
  10. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  11. DisplayText: Boolean);
  12. procedure sdvBillsCompileAfterValueChanged(AValue: TsdValue);
  13. procedure sdvBillsCompileBeforeValueChange(AValue: TsdValue;
  14. const NewValue: Variant; var Allow: Boolean);
  15. procedure sdvBillsCompileSetText(var Text: String;
  16. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  17. var Allow: Boolean);
  18. procedure sdvBillsCompileAfterOpen(Sender: TObject);
  19. procedure sdvBillsCompileAfterClose(Sender: TObject);
  20. procedure sdvBillsCompileAfterAddRecord(ARecord: TsdDataRecord);
  21. procedure sdvBillsCompileCurrentChanged(ARecord: TsdDataRecord);
  22. private
  23. FProjectData: TObject;
  24. FBillsData: TBillsData;
  25. FBillsCompileTree: TBillsIDTree;
  26. FBeforeChangeParentID: Integer;
  27. FOnRecChange: TRecChangeEvent;
  28. function GatherChildrenOrg(ANode: TsdIDTreeNode): Double;
  29. procedure UpdateRecordOrg(ABillsID: Integer; ATotalPrice: Double);
  30. function FindChild(AParentNode, ANode: TsdIDTreeNode): TsdIDTreeNode;
  31. function InsertChild(AParentNode, ANode: TsdIDTreeNode): TsdIDTreeNode;
  32. function CompareNodeCode(ANode, ACompareNode: TsdIDTreeNode): Integer;
  33. function GetNextSiblingID(AParent, ANode: TsdIDTreeNode): Integer;
  34. function IsSameNode(ANode, ACompareNode: TsdIDTreeNode): Boolean;
  35. function GetTopParentNode(ANode: TsdIDTreeNode; ALevel: Integer): TsdIDTreeNode;
  36. procedure AddXmjBillsFromLib(AStdBillsNode: TsdIDTreeNode);
  37. function CanAddGclBills: Boolean;
  38. function GetGclBillsParent(AChildNode: TsdIDTreeNode): TsdIDTreeNode;
  39. procedure AddGclBillsFromLib(AStdBillsNode: TsdIDTreeNode);
  40. procedure DoOnAfterDeleteNode(AParent: TsdIDTreeNode);
  41. function GatherChildren(ANode: TsdIDTreeNode; const AFieldName: string): Double;
  42. procedure UpdateParent(ABillsID: Integer; ADifferTotalPrice: Double; const AFieldName: string);
  43. // 施工图原设计[增量]
  44. procedure CalculateOrg(ABillsID: Integer);
  45. // 设计错漏增减[增量]
  46. procedure CalculateMis(ABillsID: Integer);
  47. // 其他错漏增减[增量]
  48. procedure CalculateOth(ABillsID: Integer);
  49. procedure CalculateTotal(ABillsID: Integer);
  50. procedure CalculateLeaf(ANode: TBillsIDTreeNode);
  51. procedure GatherNode(ANode: TBillsIDTreeNode);
  52. procedure CalculateBills(ANode: TsdIDTreeNode);
  53. function GetActive: Boolean;
  54. procedure SetOnRecChange(const Value: TRecChangeEvent);
  55. public
  56. constructor Create(AProjectData: TObject);
  57. destructor Destroy; override;
  58. procedure Open;
  59. procedure Close;
  60. procedure ReConnectTree;
  61. procedure AddBillsFromLib(ANode: TsdIDTreeNode; ABillsType: TBillsType);
  62. procedure AddBillsFromDealBills(ARec: TsdDataRecord);
  63. procedure Calculate(ABillsID: Integer);
  64. procedure CalculateAll;
  65. function GetLeafXmjParentID(ABillsID: Integer): Integer;
  66. procedure ExpandNodeTo(ALevel: Integer);
  67. procedure ExpandXmjNode;
  68. procedure ReorderChildrenCode(ANode: TsdIDTreeNode);
  69. // 所有解锁的节点全部重新锁定
  70. procedure ReLockBaseData;
  71. property ProjectData: TObject read FProjectData;
  72. property BillsData: TBillsData read FBillsData;
  73. property BillsCompileTree: TBillsIDTree read FBillsCompileTree;
  74. property Active: Boolean read GetActive;
  75. property OnRecChange: TRecChangeEvent read FOnRecChange write SetOnRecChange;
  76. end;
  77. implementation
  78. uses
  79. ProjectData, Math, ZhAPI, UtilMethods, ConstUnit, mDataRecord;
  80. {$R *.dfm}
  81. { TBillsCompileData }
  82. constructor TBillsCompileData.Create(AProjectData: TObject);
  83. begin
  84. inherited Create(nil);
  85. FProjectData := AProjectData;
  86. FBillsData := TProjectData(FProjectData).BillsData;
  87. FBillsCompileTree := TBillsIDTree.Create;
  88. FBillsCompileTree.KeyFieldName := 'ID';
  89. FBillsCompileTree.ParentFieldName := 'ParentID';
  90. FBillsCompileTree.NextSiblingFieldName := 'NextSiblingID';
  91. FBillsCompileTree.AutoCreateKeyID := True;
  92. FBillsCompileTree.AutoExpand := True;
  93. FBillsCompileTree.DataView := sdvBillsCompile;
  94. FBillsCompileTree.SeedID := Max(FBillsCompileTree.SeedID, 100);
  95. FBillsCompileTree.DoOnAfterDeleteNode := DoOnAfterDeleteNode;
  96. end;
  97. destructor TBillsCompileData.Destroy;
  98. begin
  99. FBillsCompileTree.Free;
  100. inherited;
  101. end;
  102. procedure TBillsCompileData.Open;
  103. begin
  104. sdvBillsCompile.DataSet := TProjectData(FProjectData).BillsData.sddBills;
  105. sdvBillsCompile.Open;
  106. FBillsCompileTree.SeedID := Max(FBillsCompileTree.SeedID, 100);
  107. end;
  108. procedure TBillsCompileData.ReConnectTree;
  109. begin
  110. FBillsCompileTree.DataView := nil;
  111. FBillsCompileTree.DataView := sdvBillsCompile;
  112. end;
  113. procedure TBillsCompileData.sdvBillsCompileGetText(var Text: String;
  114. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  115. DisplayText: Boolean);
  116. var
  117. fDgnPrice: Double;
  118. begin
  119. if (Pos('Price', AColumn.FieldName) > 0) or
  120. (Pos('Quantity', AColumn.FieldName) > 0) then
  121. begin
  122. if Assigned(AValue) and (AValue.AsFloat = 0) then
  123. Text := '';
  124. end;
  125. end;
  126. procedure TBillsCompileData.ExpandNodeTo(ALevel: Integer);
  127. begin
  128. BillsCompileTree.ExpandLevel := ALevel;
  129. end;
  130. procedure TBillsCompileData.ExpandXmjNode;
  131. var
  132. iIndex: Integer;
  133. stnNode: TsdIDTreeNode;
  134. begin
  135. for iIndex := 0 to BillsCompileTree.Count - 1 do
  136. begin
  137. stnNode := BillsCompileTree.Items[iIndex];
  138. if (stnNode.ParentID <> -1) then
  139. stnNode.Parent.Expanded := stnNode.Rec.ValueByName('B_Code').AsString = '';
  140. end;
  141. end;
  142. procedure TBillsCompileData.sdvBillsCompileAfterValueChanged(
  143. AValue: TsdValue);
  144. procedure ResetChildrenLockedInfo(ANode: TsdIDTreeNode; ALockedInfo: Boolean);
  145. var
  146. iChild: Integer;
  147. begin
  148. if not Assigned(ANode) then Exit;
  149. if ANode.Rec.ValueByName('LockedLevel').AsBoolean then
  150. ANode.Rec.ValueByName('LockedInfo').AsBoolean := ALockedInfo;
  151. if ANode.HasChildren then
  152. for iChild := 0 to ANode.ChildCount - 1 do
  153. ResetChildrenLockedInfo(ANode.ChildNodes[iChild], ALockedInfo);
  154. end;
  155. var
  156. stnNode: TsdIDTreeNode;
  157. begin
  158. if SameText(AValue.FieldName, 'OrgQuantity') then
  159. CalculateOrg(AValue.Owner.ValueByName('ID').AsInteger)
  160. else if SameText(AValue.FieldName, 'MisQuantity') then
  161. CalculateMis(AValue.Owner.ValueByName('ID').AsInteger)
  162. else if SameText(AValue.FieldName, 'OthQuantity') then
  163. CalculateOth(AValue.Owner.ValueByName('ID').AsInteger)
  164. else if SameText(AValue.FieldName, 'Price') or
  165. SameText(AValue.FieldName, 'DgnQuantity1') then
  166. CalculateTotal(AValue.Owner.ValueByName('ID').AsInteger);
  167. if (AValue.FieldName = 'ParentID') then
  168. begin
  169. Calculate(FBeforeChangeParentID);
  170. Calculate(AValue.AsInteger);
  171. end;
  172. if (AValue.FieldName = 'LockedInfo') then
  173. begin
  174. stnNode := BillsCompileTree.FindNode(AValue.Owner.ValueByName('ID').AsInteger);
  175. ResetChildrenLockedInfo(stnNode, AValue.AsBoolean);
  176. end;
  177. end;
  178. function TBillsCompileData.GatherChildrenOrg(ANode: TsdIDTreeNode): Double;
  179. var
  180. iChild: Integer;
  181. begin
  182. if ANode = nil then Exit;
  183. if ANode.HasChildren and Assigned(ANode.FirstChild) then
  184. begin
  185. Result := 0;
  186. for iChild := 0 to ANode.ChildCount - 1 do
  187. Result := Result + GatherChildrenOrg(ANode.ChildNodes[iChild]);
  188. Result := TotalPriceRoundTo(Result);
  189. end
  190. else
  191. if Assigned(ANode.Rec) and Assigned(ANode.Rec.ValueByName('TotalPrice')) then
  192. Result := ANode.Rec.ValueByName('TotalPrice').AsFloat
  193. else
  194. Result := 0;
  195. end;
  196. procedure TBillsCompileData.UpdateRecordOrg(ABillsID: Integer;
  197. ATotalPrice: Double);
  198. var
  199. stnNode: TsdIDTreeNode;
  200. begin
  201. stnNode := BillsCompileTree.FindNode(ABillsID);
  202. if not Assigned(stnNode) then Exit;
  203. with stnNode.Rec do
  204. begin
  205. ValueByName('TotalPrice').AsFloat := TotalPriceRoundTo(
  206. ValueByName('TotalPrice').AsFloat + ATotalPrice);
  207. if ValueByName('DgnQuantity1').AsFloat <> 0 then
  208. ValueByName('DgnPrice').AsFloat := PriceRoundTo(
  209. ValueByName('TotalPrice').AsFloat/ValueByName('DgnQuantity1').AsFloat);
  210. end;
  211. UpdateRecordOrg(stnNode.ParentID, ATotalPrice);
  212. end;
  213. procedure TBillsCompileData.sdvBillsCompileBeforeValueChange(
  214. AValue: TsdValue; const NewValue: Variant; var Allow: Boolean);
  215. begin
  216. // 清单编号和项目节编号不可同时存在
  217. if SameText(AValue.FieldName, 'Code') then
  218. begin
  219. if AValue.Owner.ValueByName('B_Code').AsString <> '' then
  220. DataSetErrorMessage(Allow, '已存在清单编号,不可输入项目节编号!');
  221. end
  222. else if SameText(AValue.FieldName, 'B_Code') then
  223. begin
  224. if AValue.Owner.ValueByName('Code').AsString <> '' then
  225. DataSetErrorMessage(Allow, '已存在项目节编号,不可输入清单编号!');
  226. end
  227. //
  228. else if SameText(AValue.FieldName, 'Price') then
  229. begin
  230. if AValue.Owner.ValueByName('AddGatherTotalPrice').AsFloat <> 0 then
  231. DataSetErrorMessage(Allow, '该清单已经开始计量,不可修改单价!');
  232. end
  233. // 变更清单不可修改0号台账数据
  234. else if SameText(AValue.FieldName, 'OrgQuantity') or
  235. SameText(AValue.FieldName, 'MisQuantity') or
  236. SameText(AValue.FieldName, 'OthQuantity') then
  237. begin
  238. if AValue.Owner.ValueByName('IsMeasureAdd').AsBoolean then
  239. DataSetErrorMessage(Allow, '变更清单不可填写0号台账数量与金额');
  240. end;
  241. if not Allow then Exit;
  242. if SameText(AValue.FieldName, 'ParentID') then
  243. FBeforeChangeParentID := AValue.AsInteger;
  244. end;
  245. procedure TBillsCompileData.CalculateAll;
  246. procedure RecursiveCalc(ANode: TsdIDTreeNode);
  247. begin
  248. if not Assigned(ANode) then Exit;
  249. if ANode.HasChildren then
  250. begin
  251. RecursiveCalc(ANode.FirstChild);
  252. GatherNode(TBillsIDTreeNode(ANode));
  253. end
  254. else
  255. CalculateLeaf(TBillsIDTreeNode(ANode));
  256. RecursiveCalc(ANode.NextSibling);
  257. end;
  258. procedure BeginCalc;
  259. begin
  260. sdvBillsCompile.BeforeValueChange := nil;
  261. sdvBillsCompile.AfterValueChanged := nil;
  262. end;
  263. procedure EndCalc;
  264. begin
  265. sdvBillsCompile.BeforeValueChange := sdvBillsCompileBeforeValueChange;
  266. sdvBillsCompile.AfterValueChanged := sdvBillsCompileAfterValueChanged;
  267. end;
  268. begin
  269. BeginCalc;
  270. try
  271. RecursiveCalc(BillsCompileTree.FirstNode);
  272. finally
  273. EndCalc;
  274. end;
  275. end;
  276. procedure TBillsCompileData.AddBillsFromLib(ANode: TsdIDTreeNode;
  277. ABillsType: TBillsType);
  278. begin
  279. if not Assigned(ANode) then Exit;
  280. if ABillsType = btXm then
  281. AddXmjBillsFromLib(ANode)
  282. else if ABillsType = btGcl then
  283. AddGclBillsFromLib(ANode);
  284. end;
  285. procedure TBillsCompileData.AddGclBillsFromLib(
  286. AStdBillsNode: TsdIDTreeNode);
  287. var
  288. stnParent, stnStdNode: TsdIDTreeNode;
  289. iLevel: Integer;
  290. begin
  291. if not CanAddGclBills then
  292. raise Exception.Create('当前节点下不可添加工程量清单!');
  293. stnParent := GetGclBillsParent(BillsCompileTree.Selected);
  294. if TBillsIDTreeNode(stnParent).HasLedger or
  295. (not stnParent.HasChildren and TBillsIDTreeNode(stnParent).HasMeasure) then
  296. raise Exception.Create('当前节点不可添加工程量清单!');
  297. stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level);
  298. for iLevel := 1 to AStdBillsNode.Level + 1 do
  299. begin
  300. if stnStdNode.Rec.ValueByName('B_Code').AsString <> '' then
  301. if FindChild(stnParent, stnStdNode) <> nil then
  302. stnParent := FindChild(stnParent, stnStdNode)
  303. else
  304. stnParent := InsertChild(stnParent, stnStdNode);
  305. stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level - iLevel);
  306. end;
  307. end;
  308. procedure TBillsCompileData.AddXmjBillsFromLib(
  309. AStdBillsNode: TsdIDTreeNode);
  310. var
  311. stnStdNode, stnCurNode: TsdIDTreeNode;
  312. iLevel: Integer;
  313. begin
  314. stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level);
  315. stnCurNode := nil;
  316. for iLevel := 1 to AStdBillsNode.Level + 1 do
  317. begin
  318. if FindChild(stnCurNode, stnStdNode) <> nil then
  319. stnCurNode := FindChild(stnCurNode, stnStdNode)
  320. else
  321. begin
  322. if TBillsIDTreeNode(stnCurNode).HasLedger or
  323. (not stnCurNode.HasChildren and TBillsIDTreeNode(stnCurNode).HasMeasure) then
  324. raise Exception.Create('不可添加该项目节数据!')
  325. else
  326. stnCurNode := InsertChild(stnCurNode, stnStdNode);
  327. end;
  328. stnStdNode := GetTopParentNode(AStdBillsNode, AStdBillsNode.Level - iLevel);
  329. end;
  330. end;
  331. function TBillsCompileData.CanAddGclBills: Boolean;
  332. function CheckChildrenHasXmj(ANode: TsdIDTreeNode): Boolean;
  333. var
  334. stnCurNode: TsdIDTreeNode;
  335. begin
  336. Result := False;
  337. if not ANode.HasChildren then Exit;
  338. stnCurNode := ANode.FirstChild;
  339. while not Result and Assigned(stnCurNode) do
  340. begin
  341. Result := Result or (stnCurNode.Rec.ValueByName('Code').AsString <> '');
  342. if stnCurNode.HasChildren then
  343. Result := Result or CheckChildrenHasXmj(stnCurNode);
  344. stnCurNode := stnCurNode.NextSibling;
  345. end;
  346. end;
  347. function CheckParentIsXmj(ANode: TsdIDTreeNode): Boolean;
  348. begin
  349. Result := False;
  350. if not Assigned(ANode) then Exit;
  351. Result := ANode.Rec.ValueByName('Code').AsString <> '';
  352. if not Result then
  353. Result := Result or CheckParentIsXmj(ANode.Parent);
  354. end;
  355. begin
  356. Result := False;
  357. if not Assigned(BillsCompileTree.Selected) then Exit;
  358. Result := CheckParentIsXmj(BillsCompileTree.Selected)
  359. and not CheckChildrenHasXmj(BillsCompileTree.Selected);
  360. end;
  361. function TBillsCompileData.CompareNodeCode(ANode,
  362. ACompareNode: TsdIDTreeNode): Integer;
  363. begin
  364. if ANode.Rec.ValueByName('Code').AsString <> '' then
  365. Result := CompareCode(ANode.Rec.ValueByName('Code').AsString,
  366. ACompareNode.Rec.ValueByName('Code').AsString)
  367. else if ANode.Rec.ValueByName('B_Code').AsString <> '' then
  368. Result := CompareCode(ANode.Rec.ValueByName('B_Code').AsString,
  369. ACompareNode.Rec.ValueByName('B_Code').AsString);
  370. end;
  371. function TBillsCompileData.GetGclBillsParent(
  372. AChildNode: TsdIDTreeNode): TsdIDTreeNode;
  373. begin
  374. if AChildNode.Rec.ValueByName('B_Code').AsString <> '' then
  375. Result := GetGclBillsParent(AChildNode.Parent)
  376. else
  377. Result := AChildNode;
  378. end;
  379. function TBillsCompileData.GetNextSiblingID(AParent,
  380. ANode: TsdIDTreeNode): Integer;
  381. var
  382. stnCurNode: TsdIDTreeNode;
  383. begin
  384. Result := -1;
  385. if Assigned(AParent) then
  386. stnCurNode := AParent.FirstChild
  387. else
  388. stnCurNode := BillsCompileTree.FirstNode;
  389. if not Assigned(stnCurNode) then Exit;
  390. while Assigned(stnCurNode) do
  391. begin
  392. if CompareNodeCode(stnCurNode, ANode) >= 0 then
  393. begin
  394. Result := stnCurNode.ID;
  395. Exit;
  396. end;
  397. stnCurNode := stnCurNode.NextSibling;
  398. end;
  399. end;
  400. function TBillsCompileData.GetTopParentNode(ANode: TsdIDTreeNode;
  401. ALevel: Integer): TsdIDTreeNode;
  402. begin
  403. Result := ANode;
  404. while Assigned(Result.Parent) and (Result.Level + ALevel > ANode.Level) do
  405. Result := Result.Parent;
  406. end;
  407. function TBillsCompileData.IsSameNode(ANode,
  408. ACompareNode: TsdIDTreeNode): Boolean;
  409. begin
  410. Result := (ANode.Rec.ValueByName('Code').AsString = ACompareNode.Rec.ValueByName('Code').AsString)
  411. and (ANode.Rec.ValueByName('B_Code').AsString = ACompareNode.Rec.ValueByName('B_Code').AsString)
  412. and (ANode.Rec.ValueByName('Name').AsString = ACompareNode.Rec.ValueByName('Name').AsString);
  413. end;
  414. function TBillsCompileData.FindChild(AParentNode,
  415. ANode: TsdIDTreeNode): TsdIDTreeNode;
  416. function FindSibling(AFirstNode, ANode: TsdIDTreeNode): TsdIDTreeNode;
  417. var
  418. stnCurNode: TsdIDTreeNode;
  419. begin
  420. Result := nil;
  421. stnCurNode := AFirstNode;
  422. while Assigned(stnCurNode) and not Assigned(Result) do
  423. begin
  424. if IsSameNode(ANode, stnCurNode) then
  425. Result := stnCurNode;
  426. stnCurNode := stnCurNode.NextSibling;
  427. end;
  428. end;
  429. begin
  430. if not Assigned(AParentNode) then
  431. Result := FindSibling(BillsCompileTree.FirstNode, ANode)
  432. else
  433. Result := FindSibling(AParentNode.FirstChild, ANode);
  434. end;
  435. function TBillsCompileData.InsertChild(AParentNode,
  436. ANode: TsdIDTreeNode): TsdIDTreeNode;
  437. var
  438. iNextSiblingID: Integer;
  439. begin
  440. iNextSiblingID := GetNextSiblingID(AParentNode, ANode);
  441. if Assigned(AParentNode) then
  442. Result := BillsCompileTree.Add(AParentNode.ID, iNextSiblingID)
  443. else
  444. Result := BillsCompileTree.Add(-1, iNextSiblingID);
  445. Result.Rec.ValueByName('Code').AsString := ANode.Rec.ValueByName('Code').AsString;
  446. Result.Rec.ValueByName('B_Code').AsString := ANode.Rec.ValueByName('B_Code').AsString;
  447. Result.Rec.ValueByName('Name').AsString := ANode.Rec.ValueByName('Name').AsString;
  448. Result.Rec.ValueByName('Units').AsString := ANode.Rec.ValueByName('Unit').AsString;
  449. end;
  450. procedure TBillsCompileData.sdvBillsCompileSetText(var Text: String;
  451. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  452. var Allow: Boolean);
  453. procedure SetTextErrorHint(const AHint: string);
  454. begin
  455. ErrorMessage(AHint);
  456. Allow := False;
  457. end;
  458. procedure SetQuantity;
  459. begin
  460. // 0号台账改为三项合计后,不记录输入的功能,但允许公式计算
  461. if CheckStringNull(Text) or CheckNumeric(Text) then
  462. Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)))
  463. else
  464. Text := FloatToStr(QuantityRoundTo(EvaluateExprs(Text)));
  465. end;
  466. procedure SetDgnQuantity;
  467. begin
  468. Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)));
  469. end;
  470. procedure SetPrice;
  471. begin
  472. Text := FloatToStr(PriceRoundTo(StrToFloatDef(Text, 0)));
  473. end;
  474. procedure DoCurChanged;
  475. begin
  476. if SameText(AColumn.FieldName, 'OrgQuantity') or
  477. SameText(AColumn.FieldName, 'MisQuantity') or
  478. SameText(AColumn.FieldName, 'OthQuantity') then
  479. SetQuantity
  480. else if Pos('DgnQuantity', AColumn.FieldName) = 1 then
  481. SetDgnQuantity
  482. else if SameText(AColumn.FieldName, 'Price') then
  483. SetPrice;
  484. end;
  485. procedure CheckLockedData;
  486. begin
  487. if SameText(AColumn.FieldName, 'Code') or
  488. SameText(AColumn.FieldName, 'B_Code') or
  489. SameText(AColumn.FieldName, 'Name') or
  490. SameText(AColumn.FieldName, 'Units') or
  491. SameText(AColumn.FieldName, 'Price') or
  492. SameText(AColumn.FieldName, 'OrgQuantity') or
  493. SameText(AColumn.FieldName, 'OrgTotalPrice') or
  494. SameText(AColumn.FieldName, 'MisQuantity') or
  495. SameText(AColumn.FieldName, 'MisTotalPrice') or
  496. SameText(AColumn.FieldName, 'OthQuantity') or
  497. SameText(AColumn.FieldName, 'OthTotalPrice') or
  498. SameText(AColumn.FieldName, 'DrawingCode')then
  499. if ARecord.ValueByName('LockedInfo').AsBoolean then
  500. SetTextErrorHint('清单信息已被锁定,不允许修改编号、名称、单位、清单单价、0号台账数量与金额、图号!');
  501. end;
  502. procedure CheckNodeWritable;
  503. var
  504. vNode: TsdIDTreeNode;
  505. iCreatePhase: Integer;
  506. begin
  507. if not Allow then Exit;
  508. vNode := BillsCompileTree.FindNode(ARecord.ValueByName('ID').AsInteger);
  509. iCreatePhase := vNode.Rec.ValueByName('CreatePhaseID').AsInteger;
  510. if vNode.HasChildren then
  511. begin
  512. if Text = '' then
  513. Exit
  514. else if (SameText('Quantity', AColumn.FieldName)) or
  515. (SameText('TotalPrice', AColumn.FieldName)) then
  516. SetTextErrorHint('该清单有子计算项,不能直接修改!')
  517. else if (Pos('Price', AColumn.FieldName) > 0) then
  518. SetTextErrorHint('仅最底层清单可输入单价!');
  519. end
  520. else
  521. if (Pos('TotalPrice', AColumn.FieldName) > 0) and
  522. (vNode.Rec.ValueByName('Price').AsFloat <> 0) then
  523. SetTextErrorHint('不可直接输入!如需直接输入金额,请先删除清单单价!');
  524. if not Allow then Exit;
  525. if SameText('Code', AColumn.FieldName) or
  526. SameText('B_Code', AColumn.FieldName) or
  527. SameText('Name', AColumn.FieldName) or
  528. SameText('Units', AColumn.FieldName) or
  529. SameText('Price', AColumn.FieldName) then
  530. if TBillsIDTreeNode(vNode).HasMeasure then
  531. SetTextErrorHint('该清单已经计量,不可修改清单编号');
  532. end;
  533. begin
  534. if not Assigned(AValue) then Exit;
  535. // 修改后数据与原数据相同则不提交
  536. if AValue.AsString = Text then Exit;
  537. CheckLockedData;
  538. CheckNodeWritable;
  539. if not Allow then Exit;
  540. Text := Trim(Text);
  541. if Pos('=', Text) = 1 then
  542. Text := Copy(Text, 2, Length(Text) - 1);
  543. DoCurChanged;
  544. end;
  545. function TBillsCompileData.GetActive: Boolean;
  546. begin
  547. Result := sdvBillsCompile.Active;
  548. end;
  549. function TBillsCompileData.GetLeafXmjParentID(ABillsID: Integer): Integer;
  550. var
  551. stnNode: TsdIDTreeNode;
  552. begin
  553. stnNode := BillsCompileTree.FindNode(ABillsID);
  554. Result := GetGclBillsParent(stnNode).ID;
  555. end;
  556. procedure TBillsCompileData.sdvBillsCompileAfterOpen(Sender: TObject);
  557. begin
  558. BillsCompileTree.Active := True;
  559. end;
  560. procedure TBillsCompileData.sdvBillsCompileAfterClose(Sender: TObject);
  561. begin
  562. BillsCompileTree.Active := False;
  563. end;
  564. procedure TBillsCompileData.ReorderChildrenCode(ANode: TsdIDTreeNode);
  565. var
  566. iChild: Integer;
  567. sParentCode: string;
  568. stnChild: TsdIDTreeNode;
  569. begin
  570. if not Assigned(ANode) then Exit;
  571. sParentCode := ANode.Rec.ValueByName('Code').AsString;
  572. for iChild := 0 to ANode.ChildCount - 1 do
  573. begin
  574. stnChild := ANode.ChildNodes[iChild];
  575. if stnChild.Rec.ValueByName('Code').AsString <> '' then
  576. stnChild.Rec.ValueByName('Code').AsString := sParentCode + '-' + IntToStr(iChild + 1);
  577. ReorderChildrenCode(stnChild);
  578. end;
  579. end;
  580. procedure TBillsCompileData.sdvBillsCompileAfterAddRecord(
  581. ARecord: TsdDataRecord);
  582. begin
  583. // 解锁前,新增清单为变更清单,解锁后,新增清单为0号台账清单
  584. if TProjectData(FProjectData).ProjProperties.PhaseCount > 0 then
  585. ARecord.ValueByName('IsMeasureAdd').AsBoolean := not TProjectData(FProjectData).CanUnlockInfo;
  586. end;
  587. procedure TBillsCompileData.DoOnAfterDeleteNode(AParent: TsdIDTreeNode);
  588. begin
  589. if Assigned(AParent) and (AParent.ID > 0) then
  590. Calculate(AParent.ID);
  591. end;
  592. procedure TBillsCompileData.Close;
  593. begin
  594. sdvBillsCompile.Close;
  595. end;
  596. procedure TBillsCompileData.SetOnRecChange(const Value: TRecChangeEvent);
  597. begin
  598. FOnRecChange := Value;
  599. end;
  600. procedure TBillsCompileData.sdvBillsCompileCurrentChanged(
  601. ARecord: TsdDataRecord);
  602. begin
  603. if Assigned(FOnRecChange) then
  604. FOnRecChange(ARecord);
  605. end;
  606. procedure TBillsCompileData.ReLockBaseData;
  607. procedure LockNodeBaseData(ANode: TsdIDTreeNode);
  608. begin
  609. if not Assigned(ANode) then Exit;
  610. if ANode.Rec.ValueByName('LockedLevel').AsBoolean then
  611. if not ANode.Rec.ValueByName('LockedInfo').AsBoolean then
  612. ANode.Rec.ValueByName('LockedInfo').AsBoolean := True;
  613. LockNodeBaseData(ANode.FirstChild);
  614. LockNodeBaseData(ANode.NextSibling);
  615. end;
  616. begin
  617. sdvBillsCompile.AfterValueChanged := nil;
  618. try
  619. LockNodeBaseData(FBillsCompileTree.FirstNode);
  620. finally
  621. sdvBillsCompile.AfterValueChanged := sdvBillsCompileAfterValueChanged;
  622. end;
  623. end;
  624. procedure TBillsCompileData.AddBillsFromDealBills(ARec: TsdDataRecord);
  625. var
  626. stnParent, stnNode: TsdIDTreeNode;
  627. begin
  628. if not CanAddGclBills then
  629. raise Exception.Create('当前节点下不可添加工程量清单!');
  630. stnParent := GetGclBillsParent(BillsCompileTree.Selected);
  631. if TBillsIDTreeNode(stnParent).HasLedger or
  632. (not stnParent.HasChildren and TBillsIDTreeNode(stnParent).HasMeasure) then
  633. raise Exception.Create('当前节点不可添加工程量清单!');
  634. stnNode := BillsCompileTree.Add(stnParent.ID, -1);
  635. stnNode.Rec.ValueByName('B_Code').AsString := ARec.ValueByName('B_Code').AsString;
  636. stnNode.Rec.ValueByName('Name').AsString := ARec.ValueByName('Name').AsString;
  637. stnNode.Rec.ValueByName('Units').AsString := ARec.ValueByName('Units').AsString;
  638. stnNode.Rec.ValueByName('Price').AsString := ARec.ValueByName('Price').AsString;
  639. end;
  640. procedure TBillsCompileData.CalculateMis(ABillsID: Integer);
  641. var
  642. vNode: TBillsIDTreeNode;
  643. fTotalPrice: Double;
  644. iChild: Integer;
  645. begin
  646. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  647. if not Assigned(vNode) then Exit;
  648. if vNode.HasChildren then
  649. begin
  650. for iChild := 0 to vNode.ChildCount - 1 do
  651. CalculateMis(vNode.ChildNodes[iChild].ID);
  652. end
  653. else
  654. begin
  655. with vNode.Rec do
  656. begin
  657. fTotalPrice := TotalPriceRoundTo(MisQuantity.AsFloat * Price.AsFloat);
  658. if MisTotalPrice.AsFloat <> fTotalPrice then
  659. begin
  660. UpdateParent(vNode.ParentID, fTotalPrice - MisTotalPrice.AsFloat, 'MisTotalPrice');
  661. MisTotalPrice.AsFloat := fTotalPrice;
  662. Quantity.AsFloat := QuantityRoundTo(
  663. OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
  664. TotalPrice.AsFloat := TotalPriceRoundTo(
  665. OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
  666. end;
  667. end;
  668. end;
  669. if vNode.Rec.DgnQuantity1.AsFloat <> 0 then
  670. vNode.Rec.DgnPrice.AsFloat := PriceRoundTo(
  671. vNode.Rec.TotalPrice.AsFloat/vNode.Rec.DgnQuantity1.AsFloat)
  672. else
  673. vNode.Rec.DgnPrice.AsFloat := 0;
  674. end;
  675. procedure TBillsCompileData.CalculateOrg(ABillsID: Integer);
  676. var
  677. vNode: TBillsIDTreeNode;
  678. fTotalPrice: Double;
  679. iChild: Integer;
  680. begin
  681. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  682. if not Assigned(vNode) then Exit;
  683. if vNode.HasChildren then
  684. begin
  685. for iChild := 0 to vNode.ChildCount - 1 do
  686. CalculateOrg(vNode.ChildNodes[iChild].ID);
  687. end
  688. else
  689. begin
  690. with vNode.Rec do
  691. begin
  692. fTotalPrice := TotalPriceRoundTo(OrgQuantity.AsFloat * Price.AsFloat);
  693. if OrgTotalPrice.AsFloat <> fTotalPrice then
  694. begin
  695. UpdateParent(vNode.ParentID, fTotalPrice - OrgTotalPrice.AsFloat, 'OrgTotalPrice');
  696. OrgTotalPrice.AsFloat := fTotalPrice;
  697. Quantity.AsFloat := QuantityRoundTo(
  698. OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
  699. TotalPrice.AsFloat := TotalPriceRoundTo(
  700. OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
  701. end;
  702. end;
  703. end;
  704. if vNode.Rec.DgnQuantity1.AsFloat <> 0 then
  705. vNode.Rec.DgnPrice.AsFloat := PriceRoundTo(
  706. vNode.Rec.TotalPrice.AsFloat/vNode.Rec.DgnQuantity1.AsFloat)
  707. else
  708. vNode.Rec.DgnPrice.AsFloat := 0;
  709. end;
  710. procedure TBillsCompileData.CalculateOth(ABillsID: Integer);
  711. var
  712. vNode: TBillsIDTreeNode;
  713. fTotalPrice: Double;
  714. iChild: Integer;
  715. begin
  716. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  717. if not Assigned(vNode) then Exit;
  718. if vNode.HasChildren then
  719. begin
  720. for iChild := 0 to vNode.ChildCount - 1 do
  721. CalculateOth(vNode.ChildNodes[iChild].ID);
  722. end
  723. else
  724. begin
  725. with vNode.Rec do
  726. begin
  727. fTotalPrice := TotalPriceRoundTo(OthQuantity.AsFloat * Price.AsFloat);
  728. if OthTotalPrice.AsFloat <> fTotalPrice then
  729. begin
  730. UpdateParent(vNode.ParentID, fTotalPrice - OthTotalPrice.AsFloat, 'OthTotalPrice');
  731. OthTotalPrice.AsFloat := fTotalPrice;
  732. Quantity.AsFloat := QuantityRoundTo(
  733. OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
  734. TotalPrice.AsFloat := TotalPriceRoundTo(
  735. OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat+ OthTotalPrice.AsFloat);
  736. end;
  737. end;
  738. end;
  739. if vNode.Rec.DgnQuantity1.AsFloat <> 0 then
  740. vNode.Rec.DgnPrice.AsFloat := PriceRoundTo(
  741. vNode.Rec.TotalPrice.AsFloat/vNode.Rec.DgnQuantity1.AsFloat)
  742. else
  743. vNode.Rec.DgnPrice.AsFloat := 0;
  744. end;
  745. function TBillsCompileData.GatherChildren(ANode: TsdIDTreeNode;
  746. const AFieldName: string): Double;
  747. var
  748. iChild: Integer;
  749. begin
  750. Result := 0;
  751. if not Assigned(ANode) then Exit;
  752. if ANode.HasChildren and Assigned(ANode.FirstChild) then
  753. begin
  754. Result := 0;
  755. for iChild := 0 to ANode.ChildCount - 1 do
  756. Result := Result + ANode.Rec.ValueByName(AFieldName).AsFloat;
  757. Result := TotalPriceRoundTo(Result);
  758. end
  759. else
  760. if Assigned(ANode.Rec) and Assigned(ANode.Rec.ValueByName(AFieldName)) then
  761. Result := ANode.Rec.ValueByName(AFieldName).AsFloat;
  762. end;
  763. procedure TBillsCompileData.UpdateParent(ABillsID: Integer;
  764. ADifferTotalPrice: Double; const AFieldName: string);
  765. var
  766. vNode: TBillsIDTreeNode;
  767. begin
  768. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  769. if not Assigned(vNode) then Exit;
  770. with vNode.Rec do
  771. begin
  772. ValueByName(AFieldName).AsFloat := TotalPriceRoundTo(
  773. ValueByName(AFieldName).AsFloat + ADifferTotalPrice);
  774. TotalPrice.AsFloat := TotalPriceRoundTo(TotalPrice.AsFloat + ADifferTotalPrice);
  775. if DgnQuantity1.AsFloat <> 0 then
  776. DgnPrice.AsFloat := PriceRoundTo(TotalPrice.AsFloat/DgnQuantity1.AsFloat);
  777. end;
  778. UpdateParent(vNode.ParentID, ADifferTotalPrice, AFieldName);
  779. end;
  780. procedure TBillsCompileData.CalculateTotal(ABillsID: Integer);
  781. begin
  782. CalculateOrg(ABillsID);
  783. CalculateMis(ABillsID);
  784. CalculateOth(ABillsID);
  785. end;
  786. procedure TBillsCompileData.CalculateBills(ANode: TsdIDTreeNode);
  787. var
  788. iChild: Integer;
  789. begin
  790. if not Assigned(ANode) then Exit;
  791. if ANode.HasChildren then
  792. begin
  793. for iChild := 0 to ANode.ChildCount - 1 do
  794. CalculateBills(ANode.ChildNodes[iChild]);
  795. GatherNode(TBillsIDTreeNode(ANode));
  796. end
  797. else
  798. CalculateLeaf(TBillsIDTreeNode(ANode));
  799. end;
  800. procedure TBillsCompileData.CalculateLeaf(ANode: TBillsIDTreeNode);
  801. begin
  802. if not Assigned(ANode) or ANode.HasChildren then Exit;
  803. with ANode.Rec do
  804. begin
  805. // 分项
  806. OrgTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OrgQuantity.AsFloat);
  807. MisTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * MisQuantity.AsFloat);
  808. OthTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OthQuantity.AsFloat);
  809. // 汇总
  810. Quantity.AsFloat := QuantityRoundTo(
  811. OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
  812. TotalPrice.AsFloat := TotalPriceRoundTo(
  813. OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
  814. // 经济指标
  815. if DgnQuantity1.AsFloat <> 0 then
  816. DgnPrice.AsFloat := PriceRoundTo(TotalPrice.AsFloat/DgnQuantity1.AsFloat);
  817. end;
  818. end;
  819. procedure TBillsCompileData.GatherNode(ANode: TBillsIDTreeNode);
  820. var
  821. iChild: Integer;
  822. fOrg, fMis, fOth: Double;
  823. vChild: TBillsIDTreeNode;
  824. begin
  825. fOrg := 0;
  826. fMis := 0;
  827. fOth := 0;
  828. for iChild := 0 to ANode.ChildCount - 1 do
  829. begin
  830. vChild := TBillsIDTreeNode(ANode.ChildNodes[iChild]);
  831. fOrg := fOrg + vChild.Rec.OrgTotalPrice.AsFloat;
  832. fMis := fMis + vChild.Rec.MisTotalPrice.AsFloat;
  833. fOth := fOth + vChild.Rec.OthTotalPrice.AsFloat;
  834. end;
  835. ANode.Rec.OrgTotalPrice.AsFloat := TotalPriceRoundTo(fOrg);
  836. ANode.Rec.MisTotalPrice.AsFloat := TotalPriceRoundTo(fMis);
  837. ANode.Rec.OthTotalPrice.AsFloat := TotalPriceRoundTo(fOth);
  838. ANode.Rec.TotalPrice.AsFloat := TotalPriceRoundTo(fOrg + fMis + fOth);
  839. if ANode.Rec.DgnQuantity1.AsFloat <> 0 then
  840. ANode.Rec.DgnPrice.AsFloat := PriceRoundTo(
  841. ANode.Rec.TotalPrice.AsFloat/ANode.Rec.DgnQuantity1.AsFloat);
  842. end;
  843. procedure TBillsCompileData.Calculate(ABillsID: Integer);
  844. procedure UpdateParent(ANode: TBillsIDTreeNode; ADifferOrg, ADifferMis, ADifferOth: Double);
  845. begin
  846. if not Assigned(ANode) then Exit;
  847. with ANode.Rec do
  848. begin
  849. OrgTotalPrice.AsFloat := TotalPriceRoundTo(OrgTotalPrice.AsFloat + ADifferOrg);
  850. MisTotalPrice.AsFloat := TotalPriceRoundTo(MisTotalPrice.AsFloat + ADifferMis);
  851. OthTotalPrice.AsFloat := TotalPriceRoundTo(OthTotalPrice.AsFloat + ADifferOth);
  852. TotalPrice.AsFloat := TotalPriceRoundTo(
  853. TotalPrice.AsFloat + ADifferOrg + ADifferMis + ADifferOth);
  854. if DgnQuantity1.AsFloat <> 0 then
  855. DgnPrice.AsFloat := PriceRoundTo(TotalPrice.AsFloat/DgnQuantity1.AsFloat);
  856. end;
  857. UpdateParent(TBillsIDTreeNode(ANode.Parent), ADifferOrg, ADifferMis, ADifferOth);
  858. end;
  859. var
  860. vNode: TBillsIDTreeNode;
  861. iChild: Integer;
  862. fOrg, fMis, fOth: Double;
  863. begin
  864. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  865. if not Assigned(vNode) then Exit;
  866. fOrg := vNode.Rec.OrgTotalPrice.AsFloat;
  867. fMis := vNode.Rec.MisTotalPrice.AsFloat;
  868. fOth := vNode.Rec.OthTotalPrice.AsFloat;
  869. CalculateBills(vNode);
  870. fOrg := vNode.Rec.OrgTotalPrice.AsFloat - fOrg;
  871. fMis := vNode.Rec.MisTotalPrice.AsFloat - fMis;
  872. fOth := vNode.Rec.OthTotalPrice.AsFloat - fOth;
  873. UpdateParent(TBillsIDTreeNode(vNode.Parent), fOrg, fMis, fOth);
  874. end;
  875. end.