BillsCompileDm.pas 31 KB

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