BillsCompileDm.pas 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005
  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.ID = iPriceMarginID then
  511. SetTextErrorHint(sBills_PMHint);
  512. if vNode.HasChildren then
  513. begin
  514. if Text = '' then
  515. Exit
  516. else if (SameText('Quantity', AColumn.FieldName)) or
  517. (SameText('TotalPrice', AColumn.FieldName)) then
  518. SetTextErrorHint('该清单有子计算项,不能直接修改!')
  519. else if (Pos('Price', AColumn.FieldName) > 0) then
  520. SetTextErrorHint('仅最底层清单可输入单价!');
  521. end
  522. else
  523. if (Pos('TotalPrice', AColumn.FieldName) > 0) and
  524. (vNode.Rec.ValueByName('Price').AsFloat <> 0) then
  525. SetTextErrorHint('不可直接输入!如需直接输入金额,请先删除清单单价!');
  526. if not Allow then Exit;
  527. if SameText('Code', AColumn.FieldName) or
  528. SameText('B_Code', AColumn.FieldName) or
  529. SameText('Name', AColumn.FieldName) or
  530. SameText('Units', AColumn.FieldName) or
  531. SameText('Price', AColumn.FieldName) then
  532. if TBillsIDTreeNode(vNode).HasMeasure then
  533. SetTextErrorHint('该清单已经计量,不可修改清单编号');
  534. end;
  535. begin
  536. if not Assigned(AValue) then Exit;
  537. // 修改后数据与原数据相同则不提交
  538. if AValue.AsString = Text then Exit;
  539. CheckLockedData;
  540. CheckNodeWritable;
  541. if not Allow then Exit;
  542. Text := Trim(Text);
  543. if Pos('=', Text) = 1 then
  544. Text := Copy(Text, 2, Length(Text) - 1);
  545. DoCurChanged;
  546. end;
  547. function TBillsCompileData.GetActive: Boolean;
  548. begin
  549. Result := sdvBillsCompile.Active;
  550. end;
  551. function TBillsCompileData.GetLeafXmjParentID(ABillsID: Integer): Integer;
  552. var
  553. stnNode: TsdIDTreeNode;
  554. begin
  555. stnNode := BillsCompileTree.FindNode(ABillsID);
  556. Result := GetGclBillsParent(stnNode).ID;
  557. end;
  558. procedure TBillsCompileData.sdvBillsCompileAfterOpen(Sender: TObject);
  559. begin
  560. BillsCompileTree.Active := True;
  561. end;
  562. procedure TBillsCompileData.sdvBillsCompileAfterClose(Sender: TObject);
  563. begin
  564. BillsCompileTree.Active := False;
  565. end;
  566. procedure TBillsCompileData.ReorderChildrenCode(ANode: TsdIDTreeNode);
  567. var
  568. iChild: Integer;
  569. sParentCode: string;
  570. stnChild: TsdIDTreeNode;
  571. begin
  572. if not Assigned(ANode) then Exit;
  573. sParentCode := ANode.Rec.ValueByName('Code').AsString;
  574. for iChild := 0 to ANode.ChildCount - 1 do
  575. begin
  576. stnChild := ANode.ChildNodes[iChild];
  577. if stnChild.Rec.ValueByName('Code').AsString <> '' then
  578. stnChild.Rec.ValueByName('Code').AsString := sParentCode + '-' + IntToStr(iChild + 1);
  579. ReorderChildrenCode(stnChild);
  580. end;
  581. end;
  582. procedure TBillsCompileData.sdvBillsCompileAfterAddRecord(
  583. ARecord: TsdDataRecord);
  584. begin
  585. // 解锁前,新增清单为变更清单,解锁后,新增清单为0号台账清单
  586. if TProjectData(FProjectData).ProjProperties.PhaseCount > 0 then
  587. ARecord.ValueByName('IsMeasureAdd').AsBoolean := not TProjectData(FProjectData).CanUnlockInfo;
  588. end;
  589. procedure TBillsCompileData.DoOnAfterDeleteNode(AParent: TsdIDTreeNode);
  590. begin
  591. if Assigned(AParent) and (AParent.ID > 0) then
  592. Calculate(AParent.ID);
  593. end;
  594. procedure TBillsCompileData.Close;
  595. begin
  596. sdvBillsCompile.Close;
  597. end;
  598. procedure TBillsCompileData.SetOnRecChange(const Value: TRecChangeEvent);
  599. begin
  600. FOnRecChange := Value;
  601. end;
  602. procedure TBillsCompileData.sdvBillsCompileCurrentChanged(
  603. ARecord: TsdDataRecord);
  604. begin
  605. if Assigned(FOnRecChange) then
  606. FOnRecChange(ARecord);
  607. end;
  608. procedure TBillsCompileData.ReLockBaseData;
  609. procedure LockNodeBaseData(ANode: TsdIDTreeNode);
  610. begin
  611. if not Assigned(ANode) then Exit;
  612. if ANode.Rec.ValueByName('LockedLevel').AsBoolean then
  613. if not ANode.Rec.ValueByName('LockedInfo').AsBoolean then
  614. ANode.Rec.ValueByName('LockedInfo').AsBoolean := True;
  615. LockNodeBaseData(ANode.FirstChild);
  616. LockNodeBaseData(ANode.NextSibling);
  617. end;
  618. begin
  619. sdvBillsCompile.AfterValueChanged := nil;
  620. try
  621. LockNodeBaseData(FBillsCompileTree.FirstNode);
  622. finally
  623. sdvBillsCompile.AfterValueChanged := sdvBillsCompileAfterValueChanged;
  624. end;
  625. end;
  626. procedure TBillsCompileData.AddBillsFromDealBills(ARec: TsdDataRecord);
  627. var
  628. stnParent, stnNode: TsdIDTreeNode;
  629. begin
  630. if not CanAddGclBills then
  631. raise Exception.Create('当前节点下不可添加工程量清单!');
  632. stnParent := GetGclBillsParent(BillsCompileTree.Selected);
  633. if TBillsIDTreeNode(stnParent).HasLedger or
  634. (not stnParent.HasChildren and TBillsIDTreeNode(stnParent).HasMeasure) then
  635. raise Exception.Create('当前节点不可添加工程量清单!');
  636. stnNode := BillsCompileTree.Add(stnParent.ID, -1);
  637. stnNode.Rec.ValueByName('B_Code').AsString := ARec.ValueByName('B_Code').AsString;
  638. stnNode.Rec.ValueByName('Name').AsString := ARec.ValueByName('Name').AsString;
  639. stnNode.Rec.ValueByName('Units').AsString := ARec.ValueByName('Units').AsString;
  640. stnNode.Rec.ValueByName('Price').AsString := ARec.ValueByName('Price').AsString;
  641. end;
  642. procedure TBillsCompileData.CalculateMis(ABillsID: Integer);
  643. var
  644. vNode: TBillsIDTreeNode;
  645. fTotalPrice: Double;
  646. iChild: Integer;
  647. begin
  648. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  649. if not Assigned(vNode) then Exit;
  650. if vNode.HasChildren then
  651. begin
  652. for iChild := 0 to vNode.ChildCount - 1 do
  653. CalculateMis(vNode.ChildNodes[iChild].ID);
  654. end
  655. else
  656. begin
  657. with vNode.Rec do
  658. begin
  659. fTotalPrice := TotalPriceRoundTo(MisQuantity.AsFloat * Price.AsFloat);
  660. if MisTotalPrice.AsFloat <> fTotalPrice then
  661. begin
  662. UpdateParent(vNode.ParentID, fTotalPrice - MisTotalPrice.AsFloat, 'MisTotalPrice');
  663. MisTotalPrice.AsFloat := fTotalPrice;
  664. Quantity.AsFloat := QuantityRoundTo(
  665. OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
  666. TotalPrice.AsFloat := TotalPriceRoundTo(
  667. OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
  668. end;
  669. end;
  670. end;
  671. if vNode.Rec.DgnQuantity1.AsFloat <> 0 then
  672. vNode.Rec.DgnPrice.AsFloat := PriceRoundTo(
  673. vNode.Rec.TotalPrice.AsFloat/vNode.Rec.DgnQuantity1.AsFloat)
  674. else
  675. vNode.Rec.DgnPrice.AsFloat := 0;
  676. end;
  677. procedure TBillsCompileData.CalculateOrg(ABillsID: Integer);
  678. var
  679. vNode: TBillsIDTreeNode;
  680. fTotalPrice: Double;
  681. iChild: Integer;
  682. begin
  683. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  684. if not Assigned(vNode) then Exit;
  685. if vNode.HasChildren then
  686. begin
  687. for iChild := 0 to vNode.ChildCount - 1 do
  688. CalculateOrg(vNode.ChildNodes[iChild].ID);
  689. end
  690. else
  691. begin
  692. with vNode.Rec do
  693. begin
  694. fTotalPrice := TotalPriceRoundTo(OrgQuantity.AsFloat * Price.AsFloat);
  695. if OrgTotalPrice.AsFloat <> fTotalPrice then
  696. begin
  697. UpdateParent(vNode.ParentID, fTotalPrice - OrgTotalPrice.AsFloat, 'OrgTotalPrice');
  698. OrgTotalPrice.AsFloat := fTotalPrice;
  699. Quantity.AsFloat := QuantityRoundTo(
  700. OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
  701. TotalPrice.AsFloat := TotalPriceRoundTo(
  702. OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
  703. end;
  704. end;
  705. end;
  706. if vNode.Rec.DgnQuantity1.AsFloat <> 0 then
  707. vNode.Rec.DgnPrice.AsFloat := PriceRoundTo(
  708. vNode.Rec.TotalPrice.AsFloat/vNode.Rec.DgnQuantity1.AsFloat)
  709. else
  710. vNode.Rec.DgnPrice.AsFloat := 0;
  711. end;
  712. procedure TBillsCompileData.CalculateOth(ABillsID: Integer);
  713. var
  714. vNode: TBillsIDTreeNode;
  715. fTotalPrice: Double;
  716. iChild: Integer;
  717. begin
  718. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  719. if not Assigned(vNode) then Exit;
  720. if vNode.HasChildren then
  721. begin
  722. for iChild := 0 to vNode.ChildCount - 1 do
  723. CalculateOth(vNode.ChildNodes[iChild].ID);
  724. end
  725. else
  726. begin
  727. with vNode.Rec do
  728. begin
  729. fTotalPrice := TotalPriceRoundTo(OthQuantity.AsFloat * Price.AsFloat);
  730. if OthTotalPrice.AsFloat <> fTotalPrice then
  731. begin
  732. UpdateParent(vNode.ParentID, fTotalPrice - OthTotalPrice.AsFloat, 'OthTotalPrice');
  733. OthTotalPrice.AsFloat := fTotalPrice;
  734. Quantity.AsFloat := QuantityRoundTo(
  735. OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
  736. TotalPrice.AsFloat := TotalPriceRoundTo(
  737. OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat+ OthTotalPrice.AsFloat);
  738. end;
  739. end;
  740. end;
  741. if vNode.Rec.DgnQuantity1.AsFloat <> 0 then
  742. vNode.Rec.DgnPrice.AsFloat := PriceRoundTo(
  743. vNode.Rec.TotalPrice.AsFloat/vNode.Rec.DgnQuantity1.AsFloat)
  744. else
  745. vNode.Rec.DgnPrice.AsFloat := 0;
  746. end;
  747. function TBillsCompileData.GatherChildren(ANode: TsdIDTreeNode;
  748. const AFieldName: string): Double;
  749. var
  750. iChild: Integer;
  751. begin
  752. Result := 0;
  753. if not Assigned(ANode) then Exit;
  754. if ANode.HasChildren and Assigned(ANode.FirstChild) then
  755. begin
  756. Result := 0;
  757. for iChild := 0 to ANode.ChildCount - 1 do
  758. Result := Result + ANode.Rec.ValueByName(AFieldName).AsFloat;
  759. Result := TotalPriceRoundTo(Result);
  760. end
  761. else
  762. if Assigned(ANode.Rec) and Assigned(ANode.Rec.ValueByName(AFieldName)) then
  763. Result := ANode.Rec.ValueByName(AFieldName).AsFloat;
  764. end;
  765. procedure TBillsCompileData.UpdateParent(ABillsID: Integer;
  766. ADifferTotalPrice: Double; const AFieldName: string);
  767. var
  768. vNode: TBillsIDTreeNode;
  769. begin
  770. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  771. if not Assigned(vNode) then Exit;
  772. with vNode.Rec do
  773. begin
  774. ValueByName(AFieldName).AsFloat := TotalPriceRoundTo(
  775. ValueByName(AFieldName).AsFloat + ADifferTotalPrice);
  776. TotalPrice.AsFloat := TotalPriceRoundTo(TotalPrice.AsFloat + ADifferTotalPrice);
  777. if DgnQuantity1.AsFloat <> 0 then
  778. DgnPrice.AsFloat := PriceRoundTo(TotalPrice.AsFloat/DgnQuantity1.AsFloat);
  779. end;
  780. UpdateParent(vNode.ParentID, ADifferTotalPrice, AFieldName);
  781. end;
  782. procedure TBillsCompileData.CalculateTotal(ABillsID: Integer);
  783. begin
  784. CalculateOrg(ABillsID);
  785. CalculateMis(ABillsID);
  786. CalculateOth(ABillsID);
  787. end;
  788. procedure TBillsCompileData.CalculateBills(ANode: TsdIDTreeNode);
  789. var
  790. iChild: Integer;
  791. begin
  792. if not Assigned(ANode) then Exit;
  793. if ANode.HasChildren then
  794. begin
  795. for iChild := 0 to ANode.ChildCount - 1 do
  796. CalculateBills(ANode.ChildNodes[iChild]);
  797. GatherNode(TBillsIDTreeNode(ANode));
  798. end
  799. else
  800. CalculateLeaf(TBillsIDTreeNode(ANode));
  801. end;
  802. procedure TBillsCompileData.CalculateLeaf(ANode: TBillsIDTreeNode);
  803. begin
  804. if not Assigned(ANode) or ANode.HasChildren then Exit;
  805. with ANode.Rec do
  806. begin
  807. // 分项
  808. OrgTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OrgQuantity.AsFloat);
  809. MisTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * MisQuantity.AsFloat);
  810. OthTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OthQuantity.AsFloat);
  811. // 汇总
  812. Quantity.AsFloat := QuantityRoundTo(
  813. OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
  814. TotalPrice.AsFloat := TotalPriceRoundTo(
  815. OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
  816. // 经济指标
  817. if DgnQuantity1.AsFloat <> 0 then
  818. DgnPrice.AsFloat := PriceRoundTo(TotalPrice.AsFloat/DgnQuantity1.AsFloat);
  819. end;
  820. end;
  821. procedure TBillsCompileData.GatherNode(ANode: TBillsIDTreeNode);
  822. var
  823. iChild: Integer;
  824. fOrg, fMis, fOth: Double;
  825. vChild: TBillsIDTreeNode;
  826. begin
  827. fOrg := 0;
  828. fMis := 0;
  829. fOth := 0;
  830. for iChild := 0 to ANode.ChildCount - 1 do
  831. begin
  832. vChild := TBillsIDTreeNode(ANode.ChildNodes[iChild]);
  833. fOrg := fOrg + vChild.Rec.OrgTotalPrice.AsFloat;
  834. fMis := fMis + vChild.Rec.MisTotalPrice.AsFloat;
  835. fOth := fOth + vChild.Rec.OthTotalPrice.AsFloat;
  836. end;
  837. ANode.Rec.OrgTotalPrice.AsFloat := TotalPriceRoundTo(fOrg);
  838. ANode.Rec.MisTotalPrice.AsFloat := TotalPriceRoundTo(fMis);
  839. ANode.Rec.OthTotalPrice.AsFloat := TotalPriceRoundTo(fOth);
  840. ANode.Rec.TotalPrice.AsFloat := TotalPriceRoundTo(fOrg + fMis + fOth);
  841. if ANode.Rec.DgnQuantity1.AsFloat <> 0 then
  842. ANode.Rec.DgnPrice.AsFloat := PriceRoundTo(
  843. ANode.Rec.TotalPrice.AsFloat/ANode.Rec.DgnQuantity1.AsFloat);
  844. end;
  845. procedure TBillsCompileData.Calculate(ABillsID: Integer);
  846. procedure UpdateParent(ANode: TBillsIDTreeNode; ADifferOrg, ADifferMis, ADifferOth: Double);
  847. begin
  848. if not Assigned(ANode) then Exit;
  849. with ANode.Rec do
  850. begin
  851. OrgTotalPrice.AsFloat := TotalPriceRoundTo(OrgTotalPrice.AsFloat + ADifferOrg);
  852. MisTotalPrice.AsFloat := TotalPriceRoundTo(MisTotalPrice.AsFloat + ADifferMis);
  853. OthTotalPrice.AsFloat := TotalPriceRoundTo(OthTotalPrice.AsFloat + ADifferOth);
  854. TotalPrice.AsFloat := TotalPriceRoundTo(
  855. TotalPrice.AsFloat + ADifferOrg + ADifferMis + ADifferOth);
  856. if DgnQuantity1.AsFloat <> 0 then
  857. DgnPrice.AsFloat := PriceRoundTo(TotalPrice.AsFloat/DgnQuantity1.AsFloat);
  858. end;
  859. UpdateParent(TBillsIDTreeNode(ANode.Parent), ADifferOrg, ADifferMis, ADifferOth);
  860. end;
  861. var
  862. vNode: TBillsIDTreeNode;
  863. iChild: Integer;
  864. fOrg, fMis, fOth: Double;
  865. begin
  866. vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
  867. if not Assigned(vNode) then Exit;
  868. fOrg := vNode.Rec.OrgTotalPrice.AsFloat;
  869. fMis := vNode.Rec.MisTotalPrice.AsFloat;
  870. fOth := vNode.Rec.OthTotalPrice.AsFloat;
  871. CalculateBills(vNode);
  872. fOrg := vNode.Rec.OrgTotalPrice.AsFloat - fOrg;
  873. fMis := vNode.Rec.MisTotalPrice.AsFloat - fMis;
  874. fOth := vNode.Rec.OthTotalPrice.AsFloat - fOth;
  875. UpdateParent(TBillsIDTreeNode(vNode.Parent), fOrg, fMis, fOth);
  876. end;
  877. end.