BGLDm.pas 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739
  1. unit BGLDm;
  2. interface
  3. uses
  4. SysUtils, Classes, DB, DBClient, Provider, ADODB, sdIDTree,
  5. sdDB;
  6. type
  7. TBGLSelectInfo = class(TObject)
  8. private
  9. FB_Code: string;
  10. FName: string;
  11. FUnits: string;
  12. FPrice: Double;
  13. FIsOrg: Boolean;
  14. FTotalNum: Double;
  15. FNums: TStrings;
  16. FCodes: TStrings;
  17. procedure SetMergedCode(const Value: string);
  18. procedure SetMergedNum(const Value: string);
  19. function GetCount: Integer;
  20. function GetMergedCode: string;
  21. function GetMergedNum: string;
  22. public
  23. constructor Create(ARec: TsdDataRecord; ATotalNum: Double; AIsOrg: Boolean);
  24. destructor Destroy; override;
  25. procedure Clear;
  26. property MergedCode: string read GetMergedCode write SetMergedCode;
  27. property MergedNum: string read GetMergedNum write SetMergedNum;
  28. property Codes: TStrings read FCodes;
  29. property Nums: TStrings read FNums;
  30. property Count: Integer read GetCount;
  31. property TotalNum: Double read FTotalNum write FTotalNum;
  32. property IsOrg: Boolean read FIsOrg;
  33. property B_Code: string read FB_Code;
  34. property Name: string read FName;
  35. property Units: string read FUnits;
  36. property Price: Double read FPrice;
  37. end;
  38. TBGLData = class(TDataModule)
  39. atBGL: TADOTable;
  40. dspBGL: TDataSetProvider;
  41. cdsBGL: TClientDataSet;
  42. cdsBGLID: TIntegerField;
  43. cdsBGLCode: TWideStringField;
  44. cdsBGLName: TWideStringField;
  45. cdsBGLTotalPrice: TFloatField;
  46. cdsBGLPos_Reason: TMemoField;
  47. cdsBGLDirection: TMemoField;
  48. cdsBGLDrawingCode: TWideStringField;
  49. cdsBGLApprovalCode: TWideStringField;
  50. cdsBGLCreatePhaseID: TIntegerField;
  51. cdsBGLExecutionRate: TFloatField;
  52. cdsBGLBGLType: TWideStringField;
  53. cdsBGLView: TClientDataSet;
  54. cdsBGLViewID: TIntegerField;
  55. cdsBGLViewCode: TWideStringField;
  56. cdsBGLViewName: TWideStringField;
  57. cdsBGLViewTotalPrice: TFloatField;
  58. cdsBGLViewPos_Reason: TMemoField;
  59. cdsBGLViewDirection: TMemoField;
  60. cdsBGLViewDrawingCode: TWideStringField;
  61. cdsBGLViewApprovalCode: TWideStringField;
  62. cdsBGLViewCreatePhaseID: TIntegerField;
  63. cdsBGLViewExecutionRate: TFloatField;
  64. cdsBGLViewBGLType: TWideStringField;
  65. dsBGL: TDataSource;
  66. atBGBills: TADOTable;
  67. dspBGBills: TDataSetProvider;
  68. cdsBGBills: TClientDataSet;
  69. cdsBGBillsID: TIntegerField;
  70. cdsBGBillsBGID: TIntegerField;
  71. cdsBGBillsB_Code: TWideStringField;
  72. cdsBGBillsName: TWideStringField;
  73. cdsBGBillsUnits: TWideStringField;
  74. cdsBGBillsPrice: TFloatField;
  75. cdsBGBillsQuantity: TFloatField;
  76. cdsBGBillsTotalPrice: TFloatField;
  77. cdsBGBillsUsedQuantity: TFloatField;
  78. cdsBGBillsView: TClientDataSet;
  79. cdsBGBillsViewID: TIntegerField;
  80. cdsBGBillsViewBGID: TIntegerField;
  81. cdsBGBillsViewB_Code: TWideStringField;
  82. cdsBGBillsViewName: TWideStringField;
  83. cdsBGBillsViewUnits: TWideStringField;
  84. cdsBGBillsViewPrice: TFloatField;
  85. cdsBGBillsViewQuantity: TFloatField;
  86. cdsBGBillsViewTotalPrice: TFloatField;
  87. cdsBGBillsViewUsedQuantity: TFloatField;
  88. cdsBGLIsCloud: TBooleanField;
  89. cdsBGLWebID: TIntegerField;
  90. procedure cdsBGBillsViewAfterInsert(DataSet: TDataSet);
  91. procedure cdsBGBillsViewAfterPost(DataSet: TDataSet);
  92. procedure cdsBGBillsViewQuantityChange(Sender: TField);
  93. procedure cdsBGBillsViewBeforePost(DataSet: TDataSet);
  94. procedure cdsBGLViewBeforePost(DataSet: TDataSet);
  95. procedure cdsBGLViewBeforeDelete(DataSet: TDataSet);
  96. procedure cdsBGBillsViewBeforeDelete(DataSet: TDataSet);
  97. procedure cdsBGBillsViewAfterDelete(DataSet: TDataSet);
  98. procedure cdsBGLViewNewRecord(DataSet: TDataSet);
  99. procedure cdsBGBillsViewQuantitySetText(Sender: TField;
  100. const Text: String);
  101. procedure cdsBGBillsViewPriceSetText(Sender: TField;
  102. const Text: String);
  103. procedure cdsBGLViewCodeChange(Sender: TField);
  104. private
  105. FProjectData: TObject;
  106. procedure GatherBGLTotalPrice(ABGLID: Integer);
  107. procedure UpdateBGLTotalPrice(ABGLID: Integer; ADiffer: Double);
  108. procedure UpdateBGLExecutionRate(ABGLID: Integer);
  109. procedure ApplyBGL(ABGLInfo: TBGLSelectInfo); overload;
  110. procedure DeleteBGBills(ABGID: Integer);
  111. function CheckSameB_Code(ABGID: Integer; const AB_Code: string): Boolean;
  112. function CheckBGLUsed(ABGID: Integer): Boolean;
  113. function LocateBGL(const ACode: string): Boolean;
  114. function LocateBGBills(ABGID: Integer; const AB_Code: string): Boolean;
  115. public
  116. constructor Create(AProjectData: TObject);
  117. destructor Destroy; override;
  118. procedure Open(AConnection: TADOConnection);
  119. procedure Close;
  120. procedure Save;
  121. function AllBGLTotalPrice: Double;
  122. function AllCloudBGLWebID: string;
  123. procedure LoadCloudBGL(const ABGLs: string);
  124. procedure AddBGL(const sCode: string);
  125. procedure ApplyBGL(AOrgBGL, ANewBGL: TBGLSelectInfo); overload;
  126. procedure BatchWritePos_Reason;
  127. property ProjectData: TObject read FProjectData;
  128. end;
  129. implementation
  130. uses
  131. ZhAPI, Math, ProjectData, BillsDm, Variants, UtilMethods, superobject;
  132. {$R *.dfm}
  133. { TBGLSelectInfo }
  134. procedure TBGLSelectInfo.Clear;
  135. begin
  136. FCodes.Clear;
  137. FNums.Clear;
  138. end;
  139. constructor TBGLSelectInfo.Create(ARec: TsdDataRecord;
  140. ATotalNum: Double; AIsOrg: Boolean);
  141. begin
  142. FB_Code := ARec.ValueByName('B_Code').AsString;
  143. FName := ARec.ValueByName('Name').AsString;
  144. FUnits := ARec.ValueByName('Units').AsString;
  145. FPrice := ARec.ValueByName('Price').AsFloat;
  146. FTotalNum := ATotalNum;
  147. FIsOrg := AIsOrg;
  148. FCodes := TStringList.Create;
  149. FCodes.Delimiter := ';';
  150. FNums := TStringList.Create;
  151. FNums.Delimiter := ';';
  152. end;
  153. destructor TBGLSelectInfo.Destroy;
  154. begin
  155. FNums.Free;
  156. FCodes.Free;
  157. inherited;
  158. end;
  159. function TBGLSelectInfo.GetCount: Integer;
  160. begin
  161. Result := Min(FCodes.Count, FNums.Count);
  162. end;
  163. function TBGLSelectInfo.GetMergedCode: string;
  164. begin
  165. Result := FCodes.DelimitedText;
  166. end;
  167. function TBGLSelectInfo.GetMergedNum: string;
  168. begin
  169. Result := FNums.DelimitedText;
  170. end;
  171. procedure TBGLSelectInfo.SetMergedCode(const Value: string);
  172. begin
  173. if Value <> '' then
  174. FCodes.DelimitedText := Value
  175. else
  176. FCodes.Clear;
  177. end;
  178. procedure TBGLSelectInfo.SetMergedNum(const Value: string);
  179. begin
  180. if Value <> '' then
  181. FNums.DelimitedText := Value
  182. else
  183. FNums.Clear;
  184. end;
  185. { TBGLData }
  186. constructor TBGLData.Create(AProjectData: TObject);
  187. begin
  188. inherited Create(nil);
  189. FProjectData := AProjectData;
  190. end;
  191. destructor TBGLData.Destroy;
  192. begin
  193. inherited;
  194. end;
  195. procedure TBGLData.Open(AConnection: TADOConnection);
  196. begin
  197. atBGL.Connection := AConnection;
  198. cdsBGL.Open;
  199. cdsBGL.AddIndex('idxID', 'ID', []);
  200. cdsBGL.AddIndex('idxCode', 'Code', []);
  201. cdsBGL.IndexName := 'idxID';
  202. cdsBGLView.CloneCursor(cdsBGL, True);
  203. atBGBills.Connection := AConnection;
  204. cdsBGBills.Open;
  205. cdsBGBillsView.CloneCursor(cdsBGBills, True);
  206. cdsBGBills.IndexFieldNames := 'ID';
  207. cdsBGBillsView.MasterSource := dsBGL;
  208. cdsBGBillsView.MasterFields := 'ID';
  209. cdsBGBillsView.IndexFieldNames := 'BGID;ID';
  210. end;
  211. procedure TBGLData.Save;
  212. begin
  213. cdsBGL.ApplyUpdates(0);
  214. cdsBGBills.ApplyUpdates(0);
  215. end;
  216. procedure TBGLData.cdsBGBillsViewAfterInsert(DataSet: TDataSet);
  217. begin
  218. cdsBGBillsViewID.AsInteger := GetNewIDOfIndex(cdsBGBills);
  219. cdsBGBillsViewBGID.AsInteger := cdsBGLViewID.AsInteger;
  220. end;
  221. procedure TBGLData.AddBGL(const sCode: string);
  222. begin
  223. cdsBGLView.DisableControls;
  224. cdsBGLView.Append;
  225. cdsBGLViewCode.AsString := sCode;
  226. cdsBGLView.Post;
  227. cdsBGLView.EnableControls;
  228. end;
  229. procedure TBGLData.cdsBGBillsViewAfterPost(DataSet: TDataSet);
  230. procedure DoB_CodeChange;
  231. var
  232. Rec: TsdDataRecord;
  233. begin
  234. cdsBGBillsViewB_Code.Tag := 0;
  235. cdsBGBillsView.Edit;
  236. with TProjectData(FProjectData).BillsData do
  237. begin
  238. Rec := sddBills.Locate('B_Code', cdsBGBillsViewB_Code.AsString);
  239. if Rec <> nil then
  240. begin
  241. cdsBGBillsViewName.AsString := Rec.ValueByName('Name').AsString;
  242. cdsBGBillsViewUnits.AsString := Rec.ValueByName('Units').AsString;
  243. cdsBGBillsViewPrice.AsString := Rec.ValueByName('Price').AsString;
  244. end;
  245. end;
  246. cdsBGBillsView.Post;
  247. end;
  248. procedure ClearChangeTag;
  249. begin
  250. cdsBGBillsViewB_Code.Tag := 0;
  251. cdsBGBillsViewName.Tag := 0;
  252. cdsBGBillsViewUnits.Tag := 0;
  253. cdsBGBillsViewPrice.Tag := 0;
  254. cdsBGBillsViewQuantity.Tag := 0;
  255. end;
  256. var
  257. fTotalPrice, Differ: Double;
  258. begin
  259. if (cdsBGBillsViewB_Code.Tag = 1) then
  260. DoB_CodeChange;
  261. if (cdsBGBillsViewPrice.Tag = 1) or
  262. (cdsBGBillsViewQuantity.Tag = 1) then
  263. begin
  264. cdsBGBillsViewPrice.Tag := 0;
  265. cdsBGBillsViewQuantity.Tag := 0;
  266. fTotalPrice := TotalPriceRoundTo(cdsBGBillsViewPrice.AsFloat * cdsBGBillsViewQuantity.AsFloat);
  267. UpdateBGLTotalPrice(cdsBGBillsViewBGID.AsInteger, fTotalPrice - cdsBGBillsViewTotalPrice.AsFloat);
  268. UpdateBGLExecutionRate(cdsBGBillsViewBGID.AsInteger);
  269. cdsBGBillsView.Edit;
  270. cdsBGBillsViewTotalPrice.AsFloat := fTotalPrice;
  271. cdsBGBillsView.Post;
  272. end;
  273. ClearChangeTag;
  274. end;
  275. procedure TBGLData.cdsBGBillsViewQuantityChange(Sender: TField);
  276. begin
  277. Sender.Tag := 1;
  278. end;
  279. procedure TBGLData.GatherBGLTotalPrice(ABGLID: Integer);
  280. var
  281. fGather: Double;
  282. begin
  283. cdsBGBills.Filter := 'BGID = ' + IntToStr(ABGLID);
  284. cdsBGBills.Filtered := True;
  285. try
  286. fGather := 0;
  287. cdsBGBills.First;
  288. while not cdsBGBills.Eof do
  289. begin
  290. fGather := fGather + cdsBGBillsTotalPrice.AsFloat;
  291. cdsBGBills.Next;
  292. end;
  293. if cdsBGL.FindKey([ABGLID]) then
  294. begin
  295. cdsBGL.Edit;
  296. cdsBGLTotalPrice.AsFloat := fGather;
  297. cdsBGL.Post;
  298. end;
  299. finally
  300. cdsBGBills.Filtered := False;
  301. end;
  302. end;
  303. procedure TBGLData.UpdateBGLTotalPrice(ABGLID: Integer; ADiffer: Double);
  304. begin
  305. if cdsBGL.FindKey([ABGLID]) then
  306. begin
  307. cdsBGL.Edit;
  308. cdsBGLTotalPrice.AsFloat := cdsBGLTotalPrice.AsFloat + ADiffer;
  309. cdsBGL.Post;
  310. end;
  311. end;
  312. procedure TBGLData.ApplyBGL(AOrgBGL, ANewBGL: TBGLSelectInfo);
  313. begin
  314. ApplyBGL(AOrgBGL);
  315. ApplyBGL(ANewBGL);
  316. end;
  317. procedure TBGLData.ApplyBGL(ABGLInfo: TBGLSelectInfo);
  318. var
  319. I: Integer;
  320. fNum: Double;
  321. begin
  322. for I := 0 to ABGLInfo.Count - 1 do
  323. if LocateBGL(ABGLInfo.Codes[I]) and
  324. LocateBGBills(cdsBGLID.AsInteger, ABGLInfo.B_Code) then
  325. begin
  326. cdsBGBills.Edit;
  327. fNum := QuantityRoundTo(StrToFloatDef(ABGLInfo.Nums[I], 0));
  328. if ABGLInfo.IsOrg then
  329. cdsBGBillsUsedQuantity.AsFloat := QuantityRoundTo(cdsBGBillsUsedQuantity.AsFloat - fNum)
  330. else
  331. cdsBGBillsUsedQuantity.AsFloat := QuantityRoundTo(cdsBGBillsUsedQuantity.AsFloat + fNum);
  332. cdsBGBills.Post;
  333. UpdateBGLExecutionRate(cdsBGBillsBGID.AsInteger);
  334. end;
  335. end;
  336. procedure TBGLData.cdsBGBillsViewBeforePost(DataSet: TDataSet);
  337. procedure DisplayErrorMessage(const AHint: string);
  338. begin
  339. cdsBGBillsViewB_Code.Tag := 0;
  340. cdsBGBillsViewName.Tag := 0;
  341. cdsBGBillsViewUnits.Tag := 0;
  342. cdsBGBillsViewPrice.Tag := 0;
  343. cdsBGBillsViewQuantity.Tag := 0;
  344. ErrorMessage(AHint);
  345. Abort;
  346. end;
  347. begin
  348. if (cdsBGBillsViewB_Code.Tag = 1) or
  349. (cdsBGBillsViewName.Tag = 1) or
  350. (cdsBGBillsViewUnits.Tag = 1) or
  351. (cdsBGBillsViewPrice.Tag = 1) then
  352. begin
  353. if cdsBGBillsViewUsedQuantity.AsFloat <> 0 then
  354. DisplayErrorMessage('变更令已被应用至清单,不可修改!');
  355. end;
  356. if (cdsBGBillsViewQuantity.Tag = 1) then
  357. begin
  358. if (cdsBGBillsViewUsedQuantity.AsFloat <> 0) and
  359. (cdsBGBillsViewQuantity.AsFloat < cdsBGBillsViewUsedQuantity.AsFloat) then
  360. DisplayErrorMessage('变更清单的清单数量应大于已变更数量!');
  361. end;
  362. if cdsBGBillsViewB_Code.Tag = 1 then
  363. if CheckSameB_Code(cdsBGBillsViewBGID.AsInteger, cdsBGBillsViewB_Code.AsString) then
  364. begin
  365. DisplayErrorMessage('不允许存在同编号变更清单!');
  366. end;
  367. end;
  368. procedure TBGLData.cdsBGLViewBeforePost(DataSet: TDataSet);
  369. var
  370. iIncrement: Integer;
  371. sNewCode: string;
  372. begin
  373. // 变更令号不可为空
  374. if cdsBGLViewCode.AsString = '' then
  375. begin
  376. cdsBGLViewCode.Tag := 0;
  377. if cdsBGL.FindKey([cdsBGLViewID.AsInteger]) then
  378. if cdsBGLCode.AsString <> '' then
  379. WarningMessage('变更令号不允许为空,如需删除,请点击右键进行删除。');
  380. DataSet.Cancel;
  381. Abort;
  382. end;
  383. if cdsBGLViewCode.Tag = 1 then
  384. begin
  385. cdsBGLViewCode.Tag := 0;
  386. if CheckBGLUsed(cdsBGLViewID.AsInteger) then
  387. begin
  388. ErrorMessage('当前变更令下变更清单已被应用到清单,不可修改!');
  389. Abort;
  390. end;
  391. sNewCode := cdsBGLViewCode.AsString;
  392. if Pos(';', sNewCode) > 0 then
  393. begin
  394. ErrorMessage('变更令号不可输入'';'',请使用其他符号代替!');
  395. Abort;
  396. end;
  397. // 相同变更令号应递增[1],[2]...
  398. iIncrement := 1;
  399. while LocateBGL(sNewCode) and (cdsBGLID.AsInteger <> cdsBGLViewID.AsInteger) do
  400. begin
  401. sNewCode := Format('%s[%d]', [cdsBGLViewCode.AsString, iIncrement]);
  402. Inc(iIncrement);
  403. end;
  404. if cdsBGLViewCode.AsString <> sNewCode then
  405. begin
  406. cdsBGLViewCode.AsString := sNewCode;
  407. cdsBGLViewCode.Tag := 0;
  408. end;
  409. end;
  410. end;
  411. procedure TBGLData.DeleteBGBills(ABGID: Integer);
  412. begin
  413. cdsBGBills.Filter := 'BGID = ' + IntToStr(ABGID);
  414. cdsBGBills.Filtered := True;
  415. try
  416. cdsBGBills.First;
  417. while not cdsBGBills.Eof do
  418. cdsBGBills.Delete;
  419. finally
  420. cdsBGBills.Filtered := False;
  421. end;
  422. end;
  423. procedure TBGLData.cdsBGLViewBeforeDelete(DataSet: TDataSet);
  424. begin
  425. if CheckBGLUsed(cdsBGLViewID.AsInteger) then
  426. raise Exception.Create('变更令下变更清单已被应用到清单,不可删除!');
  427. DeleteBGBills(cdsBGLViewID.AsInteger);
  428. end;
  429. function TBGLData.CheckSameB_Code(ABGID: Integer;
  430. const AB_Code: string): Boolean;
  431. begin
  432. Result := False;
  433. cdsBGBills.Filter := 'BGID = ' + IntToStr(ABGID);
  434. cdsBGBills.Filtered := True;
  435. try
  436. cdsBGBills.First;
  437. while (not cdsBGBills.Eof) and (not Result) do
  438. begin
  439. Result := Result or SameText(cdsBGBillsB_Code.AsString, AB_Code);
  440. cdsBGBills.Next;
  441. end;
  442. finally
  443. cdsBGBills.Filtered := False;
  444. end;
  445. end;
  446. procedure TBGLData.cdsBGBillsViewBeforeDelete(DataSet: TDataSet);
  447. begin
  448. if cdsBGBillsViewUsedQuantity.AsFloat <> 0 then
  449. raise Exception.Create('变更清单已被应用至清单,不可删除!');
  450. end;
  451. function TBGLData.CheckBGLUsed(ABGID: Integer): Boolean;
  452. begin
  453. Result := False;
  454. cdsBGBills.Filter := 'BGID = ' + IntToStr(ABGID);
  455. cdsBGBills.Filtered := True;
  456. try
  457. cdsBGBills.First;
  458. while (not cdsBGBills.Eof) and (not Result) do
  459. begin
  460. Result := Result or (cdsBGBillsUsedQuantity.AsFloat <> 0);
  461. cdsBGBills.Next;
  462. end;
  463. finally
  464. cdsBGBills.Filtered := False;
  465. end;
  466. end;
  467. procedure TBGLData.cdsBGBillsViewAfterDelete(DataSet: TDataSet);
  468. begin
  469. GatherBGLTotalPrice(cdsBGLViewID.AsInteger);
  470. UpdateBGLExecutionRate(cdsBGLViewID.AsInteger);
  471. end;
  472. procedure TBGLData.BatchWritePos_Reason;
  473. begin
  474. cdsBGL.First;
  475. while not cdsBGL.Eof do
  476. begin
  477. cdsBGL.Edit;
  478. cdsBGLPos_Reason.AsString := cdsBGLName.AsString;
  479. cdsBGL.Post;
  480. cdsBGL.Next;
  481. end;
  482. end;
  483. procedure TBGLData.cdsBGLViewNewRecord(DataSet: TDataSet);
  484. begin
  485. cdsBGLViewID.AsInteger := GetNewIDOfIndex(cdsBGL);
  486. cdsBGLViewCreatePhaseID.AsInteger := TProjectData(FProjectData).PhaseIndex;
  487. end;
  488. procedure TBGLData.UpdateBGLExecutionRate(ABGLID: Integer);
  489. function GetBGLExecutionTotalPrice: Double;
  490. var
  491. cdsTemp: TClientDataSet;
  492. begin
  493. Result := 0;
  494. cdsTemp := TClientDataSet.Create(nil);
  495. try
  496. cdsTemp.CloneCursor(cdsBGBills, True);
  497. cdsTemp.Filter := Format('BGID = %d', [ABGLID]);
  498. cdsTemp.Filtered := True;
  499. cdsTemp.First;
  500. while not cdsTemp.Eof do
  501. begin
  502. Result := Result + TotalPriceRoundTo(
  503. cdsTemp.FieldByName('UsedQuantity').AsFloat * cdsTemp.FieldByName('Price').AsFloat);
  504. cdsTemp.Next;
  505. end;
  506. finally
  507. cdsTemp.Free;
  508. end;
  509. end;
  510. begin
  511. if cdsBGL.FindKey([ABGLID]) then
  512. begin
  513. cdsBGL.Edit;
  514. if cdsBGLTotalPrice.AsFloat <> 0 then
  515. cdsBGLExecutionRate.AsFloat := AdvRoundTo(GetBGLExecutionTotalPrice/cdsBGLTotalPrice.AsFloat*100)
  516. else
  517. cdsBGLExecutionRate.AsFloat := 0;
  518. cdsBGL.Post;
  519. end;
  520. end;
  521. function TBGLData.AllBGLTotalPrice: Double;
  522. begin
  523. Result := 0;
  524. cdsBGL.First;
  525. while not cdsBGL.Eof do
  526. begin
  527. Result := Result + cdsBGLTotalPrice.AsFloat;
  528. cdsBGL.Next;
  529. end;
  530. end;
  531. procedure TBGLData.cdsBGBillsViewQuantitySetText(Sender: TField;
  532. const Text: String);
  533. begin
  534. Sender.AsFloat := QuantityRoundTo(StrToFloatDef(Text, 0));
  535. end;
  536. procedure TBGLData.cdsBGBillsViewPriceSetText(Sender: TField;
  537. const Text: String);
  538. begin
  539. Sender.AsFloat := PriceRoundTo(StrToFloatDef(Text, 0));
  540. end;
  541. procedure TBGLData.cdsBGLViewCodeChange(Sender: TField);
  542. begin
  543. Sender.Tag := 1;
  544. end;
  545. procedure TBGLData.Close;
  546. begin
  547. cdsBGL.IndexName := '';
  548. cdsBGL.Close;
  549. cdsBGBills.Close;
  550. end;
  551. function TBGLData.LocateBGL(const ACode: string): Boolean;
  552. begin
  553. cdsBGL.IndexName := 'idxCode';
  554. try
  555. Result := cdsBGL.FindKey([ACode]);
  556. finally
  557. cdsBGL.IndexName := 'idxID';
  558. end;
  559. end;
  560. function TBGLData.LocateBGBills(ABGID: Integer;
  561. const AB_Code: string): Boolean;
  562. begin
  563. Result := False;
  564. cdsBGBills.First;
  565. while (not cdsBGBills.Eof) do
  566. begin
  567. if (cdsBGBillsBGID.AsInteger = ABGID) and
  568. SameText(cdsBGBillsB_Code.AsString, AB_Code) then
  569. begin
  570. Result := True;
  571. Break;
  572. end;
  573. cdsBGBills.Next;
  574. end;
  575. end;
  576. function TBGLData.AllCloudBGLWebID: string;
  577. begin
  578. Result := '';
  579. cdsBGL.First;
  580. while not cdsBGL.Eof do
  581. begin
  582. if cdsBGLIsCloud.AsBoolean then
  583. begin
  584. if Result = '' then
  585. Result := IntToStr(cdsBGLWebID.AsInteger)
  586. else
  587. Result := Result + ',' + IntToStr(cdsBGLWebID.AsInteger);
  588. end;
  589. cdsBGL.Next;
  590. end;
  591. end;
  592. procedure TBGLData.LoadCloudBGL(const ABGLs: string);
  593. procedure AddCloudBGLBills(ABGLID: Integer; ABGBills: ISuperObject);
  594. var
  595. i, iNewID: Integer;
  596. vJ: ISuperObject;
  597. begin
  598. for i := 0 to ABGBills.AsArray.Length - 1 do
  599. begin
  600. iNewID := GetNewIDOfIndex(cdsBGBills);
  601. vJ := ABGBills.AsArray.O[i];
  602. cdsBGBills.Append;
  603. cdsBGBillsID.AsInteger := iNewID;
  604. cdsBGBillsBGID.AsInteger := ABGLID;
  605. cdsBGBillsB_Code.AsString := vJ.S['lnum'];
  606. cdsBGBillsName.AsString := vJ.S['lname'];
  607. cdsBGBillsUnits.AsString := vJ.S['unit'];
  608. cdsBGBillsPrice.AsFloat := vJ.D['unitprice'];
  609. cdsBGBillsQuantity.AsFloat := vJ.D['samount'];
  610. cdsBGBillsTotalPrice.AsFloat := TotalPriceRoundTo(cdsBGBillsPrice.AsFloat * cdsBGBillsQuantity.AsFloat);
  611. cdsBGBills.Post;
  612. UpdateBGLTotalPrice(ABGLID, cdsBGBillsTotalPrice.AsFloat);
  613. end;
  614. end;
  615. procedure AddCloudBGL(ABGL: ISuperObject);
  616. var
  617. iNewID, iCreatePhaseID: Integer;
  618. vBGBills: ISuperObject;
  619. begin
  620. iNewID := GetNewIDOfIndex(cdsBGL);
  621. iCreatePhaseID := TProjectData(FProjectData).PhaseIndex;
  622. cdsBGL.Append;
  623. cdsBGLID.AsInteger := iNewID;
  624. cdsBGLCode.AsString := ABGL.S['pnum'];
  625. cdsBGLName.AsString := ABGL.S['pname'];
  626. cdsBGLPos_Reason.AsString := ABGL.S['description'];
  627. cdsBGLDirection.AsString := ABGL.S['basis'];
  628. cdsBGLDrawingCode.AsString := ABGL.S['cnum'];
  629. cdsBGLApprovalCode.AsString := '';
  630. cdsBGLCreatePhaseID.AsInteger := iCreatePhaseID;
  631. cdsBGLBGLType.AsString := ABGL.S['changeNature'];
  632. cdsBGLIsCloud.AsBoolean := True;
  633. cdsBGLWebID.AsInteger := ABGL.I['cid'];
  634. cdsBGL.Post;
  635. AddCloudBGLBills(iNewID, ABGL.O['changeBills']);
  636. end;
  637. var
  638. vJ: ISuperObject;
  639. i: Integer;
  640. begin
  641. vJ := SO(ABGLs);
  642. try
  643. if not Assigned(vJ.AsArray) then Exit;
  644. for i := 0 to vJ.AsArray.Length - 1 do
  645. AddCloudBGL(vJ.AsArray.O[i]);
  646. finally
  647. vJ := nil;
  648. end;
  649. end;
  650. end.