BGLDm.pas 20 KB

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