BGLDm.pas 21 KB

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