BGLDm.pas 21 KB

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