ProjectGLDm.pas 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637
  1. unit ProjectGLDm;
  2. interface
  3. uses
  4. SysUtils, Classes, sdDB, sdProvider, ADODB, mDataRecord, CalcDecimal;
  5. type
  6. TProjectGLData = class(TDataModule)
  7. sdpProjectGL: TsdADOProvider;
  8. sddProjectGL: TsdDataSet;
  9. sdvProjectGL: TsdDataView;
  10. procedure sddProjectGLAfterAddRecord(ARecord: TsdDataRecord);
  11. procedure sddProjectGLAfterValueChanged(AValue: TsdValue);
  12. procedure sdvProjectGLGetText(var Text: String; ARecord: TsdDataRecord;
  13. AValue: TsdValue; AColumn: TsdViewColumn; DisplayText: Boolean);
  14. procedure sddProjectGLGetRecordClass(var ARecordClass: TsdRecordClass);
  15. procedure sdvProjectGLSetText(var Text: String; ARecord: TsdDataRecord;
  16. AValue: TsdValue; AColumn: TsdViewColumn; var Allow: Boolean);
  17. procedure sddProjectGLBeforeDeleteRecord(ARecord: TsdDataRecord;
  18. var Allow: Boolean);
  19. private
  20. FProjectData: TObject;
  21. FTempGLs: TList;
  22. function CheckSameCode(ACode: Integer): Boolean;
  23. function CheckApplied(AGLID: Integer): Boolean;
  24. procedure LoadDetailGLs(AGLID: Integer);
  25. procedure CalculateDeltaPrice(ARec: TProjectGLRecord);
  26. procedure CalculatePrice;
  27. procedure CalculatePM_Quantity(ARec: TProjectGLRecord);
  28. procedure CalculatePM_TotalPrice(ARec: TProjectGLRecord);
  29. procedure CalculatePriceMargin;
  30. procedure CalculateRelaBills(ARec: TProjectGLRecord);
  31. procedure CalculatePALRela(ARec: TProjectGLRecord);
  32. procedure CalculatePALRelas;
  33. procedure ExecuteSql(const ASql: string);
  34. procedure SaveGLPrice;
  35. procedure SavePM_CurData;
  36. procedure BeforeBatchOperation;
  37. procedure AfterBatchOperation;
  38. function GetValidDeltaPrice(AID: Integer): Double;
  39. function GetPM_TotalPrice: Double;
  40. function GetActive: Boolean;
  41. function GetDecimal: TCalcDecimal;
  42. public
  43. constructor Create(AProjectData: TObject);
  44. destructor Destroy; override;
  45. procedure Open(AConnection: TADOConnection);
  46. procedure Save;
  47. procedure LoadCurPhaseInfoPrice;
  48. procedure LoadStagePM_CalcData;
  49. procedure CalculateAll;
  50. procedure CalculateGL_PM(AGLID: Integer);
  51. procedure CalculateGLs_PM(ADetailGLs: TList);
  52. property ProjectData: TObject read FProjectData write FProjectData;
  53. property Active: Boolean read GetActive;
  54. property ValidDeltaPrice[AID: Integer]: Double read GetValidDeltaPrice;
  55. property PM_TotalPrice: Double read GetPM_TotalPrice;
  56. property Decimal: TCalcDecimal read GetDecimal;
  57. end;
  58. implementation
  59. uses
  60. ProjectData, UtilMethods, DB, Variants, PhaseData, DetailGLDm,
  61. BillsMeasureDm, BillsTree, sdIDTree, PhasePayDm, DateUtils, ZhAPI;
  62. {$R *.dfm}
  63. { TProjectGLData }
  64. function TProjectGLData.CheckSameCode(ACode: Integer): Boolean;
  65. var
  66. Rec: TsdDataRecord;
  67. begin
  68. Rec := sddProjectGL.FindKey('idxCode', ACode);
  69. Result := Assigned(Rec);
  70. end;
  71. constructor TProjectGLData.Create(AProjectData: TObject);
  72. begin
  73. inherited Create(nil);
  74. FProjectData := AProjectData;
  75. FTempGLs := TList.Create;
  76. end;
  77. destructor TProjectGLData.Destroy;
  78. begin
  79. FTempGLs.Free;
  80. inherited;
  81. end;
  82. procedure TProjectGLData.LoadCurPhaseInfoPrice;
  83. const
  84. sSelectSql = 'Select * From GLPrice Where PhaseID = %d';
  85. var
  86. sSql: string;
  87. vQuery: TADOQuery;
  88. procedure LoadInfoPrice;
  89. var
  90. iRec: Integer;
  91. Rec: TProjectGLRecord;
  92. begin
  93. for iRec := 0 to sddProjectGL.RecordCount - 1 do
  94. begin
  95. Rec := TProjectGLRecord(sddProjectGL.Records[iRec]);
  96. if vQuery.Active and vQuery.Locate('GLID', Rec.ValueByName('ID').AsInteger, []) then
  97. begin
  98. Rec.InfoPrice.AsFloat := vQuery.FieldByName('InfoPrice').AsFloat;
  99. Rec.InfoDate.AsString := vQuery.FieldByName('InfoDate').AsString;
  100. Rec.DeltaPrice.AsFloat := vQuery.FieldByName('DeltaPrice').AsFloat;
  101. Rec.ValidDeltaPrice.AsFloat := vQuery.FieldByName('ValidDeltaPrice').AsFloat;
  102. Rec.UsedQuantity.AsFloat := vQuery.FieldByName('UsedQuantity').AsFloat;
  103. Rec.UsedTotalPrice.AsFloat := vQuery.FieldByName('UsedTotalPrice').AsFloat;
  104. end
  105. else
  106. begin
  107. Rec.InfoPrice.AsFloat := 0;
  108. Rec.InfoDate.AsString := '';
  109. Rec.DeltaPrice.AsFloat := 0;
  110. Rec.ValidDeltaPrice.AsFloat := 0;
  111. Rec.UsedQuantity.AsFloat := 0;
  112. Rec.UsedTotalPrice.AsFloat := 0;
  113. end;
  114. end;
  115. end;
  116. begin
  117. BeforeBatchOperation;
  118. vQuery := TADOQuery.Create(nil);
  119. try
  120. vQuery.Connection := sdpProjectGL.Connection;
  121. sSql := Format(sSelectSql, [TProjectData(FProjectData).PhaseIndex]);
  122. vQuery.SQL.Clear;
  123. vQuery.SQL.Add(sSql);
  124. vQuery.Open;
  125. LoadInfoPrice;
  126. finally
  127. vQuery.Free;
  128. AfterBatchOperation;
  129. end;
  130. end;
  131. procedure TProjectGLData.Open(AConnection: TADOConnection);
  132. begin
  133. sdpProjectGL.Connection := AConnection;
  134. sddProjectGL.Open;
  135. if not Assigned(sddProjectGL.IndexList.FindByName('idxID')) then
  136. sddProjectGL.AddIndex('idxID', 'ID');
  137. if not Assigned(sddProjectGL.IndexList.FindByName('idxCode')) then
  138. sddProjectGL.AddIndex('idxCode', 'Code');
  139. sdvProjectGL.Open;
  140. sdvProjectGL.IndexName := 'idxCode';
  141. LoadCurPhaseInfoPrice;
  142. LoadStagePM_CalcData;
  143. end;
  144. procedure TProjectGLData.Save;
  145. begin
  146. sddProjectGL.Save;
  147. if not TProjectData(FProjectData).PriceMarginReadOnly then
  148. SaveGLPrice;
  149. if not TProjectData(FProjectData).StageDataReadOnly then
  150. SavePM_CurData;
  151. end;
  152. procedure TProjectGLData.SaveGLPrice;
  153. const
  154. sDeleteSql = 'Delete From GLPrice Where PhaseID = %d';
  155. sInsertSql = 'Insert Into GLPrice'+
  156. ' Select ID As GLID, %d As PhaseID, InfoPrice, InfoDate, DeltaPrice, ValidDeltaPrice, UsedQuantity, UsedTotalPrice' +
  157. ' From ProjectGL';
  158. sUpdateSql = 'Update GLPrice As G, ProjectGL As P'+
  159. ' Set G.PM_PreQuantity = P.PM_PreQuantity, G.PM_PreTotalPrice = P.PM_PreTotalPrice,'+
  160. ' G.PrePAL_UsedQuantity = P.PrePAL_UsedQuantity, G.PrePAL_UsedTotalPrice = P.PrePAL_UsedTotalPrice,' +
  161. ' G.PrePAL_DeltaPrice = P.PrePAL_DeltaPrice, G.PrePAL_Total = P.PrePAL_Total'+
  162. ' Where (G.PhaseID = %d) and (G.GLID = P.ID)';
  163. var
  164. iPhaseID: Integer;
  165. sSql: String;
  166. begin
  167. iPhaseID := TProjectData(FProjectData).ProjProperties.PhaseCount;
  168. sSql := Format(sDeleteSql, [iPhaseID]);
  169. ExecuteSql(sSql);
  170. sSql := Format(sInsertSql, [iPhaseID]);
  171. ExecuteSql(sSql);
  172. sSql := Format(sUpdateSql, [iPhaseID]);
  173. ExecuteSql(sSql);
  174. end;
  175. procedure TProjectGLData.sddProjectGLAfterAddRecord(
  176. ARecord: TsdDataRecord);
  177. begin
  178. ARecord.ValueByName('ID').AsInteger := GetsdDataSetNewID(sddProjectGL, 'idxID');
  179. ARecord.ValueByName('CreatePhaseID').AsInteger := TProjectData(FProjectData).ProjProperties.PhaseCount;
  180. end;
  181. procedure TProjectGLData.sddProjectGLAfterValueChanged(AValue: TsdValue);
  182. begin
  183. if SameText(AValue.FieldName, 'BasePrice') or
  184. SameText(AValue.FieldName, 'RiskRange') or
  185. SameText(AValue.FieldName, 'InfoPrice') then
  186. begin
  187. CalculateDeltaPrice(TProjectGLRecord(AValue.Owner));
  188. CalculatePM_Quantity(TProjectGLRecord(AValue.Owner));
  189. CalculatePM_TotalPrice(TProjectGLRecord(AValue.Owner));
  190. CalculatePALRela(TProjectGLRecord(AValue.Owner));
  191. //CalculateRelaBills(TProjectGLRecord(AValue.Owner));
  192. TProjectData(FProjectData).PriceMarginBillsData.RefreshAllDetailBills;
  193. end;
  194. if SameText(AValue.FieldName, 'UsedQuantity') then
  195. begin
  196. CalculatePALRela(TProjectGLRecord(AValue.Owner));
  197. end;
  198. end;
  199. procedure TProjectGLData.CalculateDeltaPrice(ARec: TProjectGLRecord);
  200. var
  201. C0, Ci, r, DeltaC, RiskC, ValidDeltaC: Double;
  202. begin
  203. C0 := ARec.BasePrice.AsFloat;
  204. Ci := ARec.InfoPrice.AsFloat;
  205. r := ARec.RiskRange.AsFloat;
  206. DeltaC := Ci - C0;
  207. RiskC := C0 * r / 100;
  208. if (DeltaC > 0) and (DeltaC - RiskC > 0) then
  209. ValidDeltaC := DeltaC - RiskC
  210. else if (DeltaC < 0) and (DeltaC + RiskC < 0) then
  211. ValidDeltaC := DeltaC + RiskC
  212. else
  213. ValidDeltaC := 0;
  214. if DeltaC <> ARec.DeltaPrice.AsFloat then
  215. ARec.DeltaPrice.AsFloat := Decimal.Price.RoundTo(DeltaC);
  216. if ValidDeltaC <> ARec.ValidDeltaPrice.AsFloat then
  217. ARec.ValidDeltaPrice.AsFloat := Decimal.Price.RoundTo(ValidDeltaC);
  218. end;
  219. procedure TProjectGLData.sdvProjectGLGetText(var Text: String;
  220. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  221. DisplayText: Boolean);
  222. procedure GetDisplayText;
  223. begin
  224. if ((Pos('Price', AColumn.FieldName) > 0) or
  225. (Pos('Quantity', AColumn.FieldName) > 0) or
  226. (Pos('PAL', AColumn.FieldName) = 1) or
  227. SameText('RiskRange', AColumn.FieldName)) then
  228. begin
  229. if AValue.AsFloat = 0 then
  230. Text := ''
  231. else
  232. Text := FormatFloat('0.###', Decimal.Price.RoundTo(AValue.AsFloat));
  233. end;
  234. end;
  235. begin
  236. if DisplayText then
  237. GetDisplayText;
  238. end;
  239. procedure TProjectGLData.CalculateAll;
  240. begin
  241. CalculatePrice;
  242. CalculatePriceMargin;
  243. end;
  244. procedure TProjectGLData.ExecuteSql(const ASql: string);
  245. var
  246. vQuery: TADOQuery;
  247. begin
  248. vQuery := TADOQuery.Create(nil);
  249. try
  250. vQuery.Connection := sdpProjectGL.Connection;
  251. vQuery.SQL.Add(ASql);
  252. vQuery.ExecSQL;
  253. finally
  254. vQuery.Free;
  255. end;
  256. end;
  257. function TProjectGLData.GetValidDeltaPrice(AID: Integer): Double;
  258. var
  259. Rec: TProjectGLRecord;
  260. begin
  261. Rec := TProjectGLRecord(sddProjectGL.FindKey('idxID', AID));
  262. if Assigned(Rec) then
  263. Result := Rec.ValidDeltaPrice.AsFloat
  264. else
  265. Result := 0;
  266. end;
  267. procedure TProjectGLData.CalculatePrice;
  268. var
  269. iRec: Integer;
  270. begin
  271. if TProjectData(FProjectData).PriceMarginReadOnly then Exit;
  272. for iRec := 0 to sddProjectGL.RecordCount - 1 do
  273. CalculateDeltaPrice(TProjectGLRecord(sddProjectGL.Records[iRec]));
  274. end;
  275. procedure TProjectGLData.CalculatePriceMargin;
  276. var
  277. iRec: Integer;
  278. Rec: TProjectGLRecord;
  279. begin
  280. if TProjectData(FProjectData).PhaseData.StageDataReadOnly then Exit;
  281. for iRec := 0 to sddProjectGL.RecordCount - 1 do
  282. begin
  283. Rec := TProjectGLRecord(sddProjectGL.Records[iRec]);
  284. CalculatePM_Quantity(Rec);
  285. CalculatePM_TotalPrice(Rec);
  286. end;
  287. end;
  288. procedure TProjectGLData.CalculatePM_Quantity(ARec: TProjectGLRecord);
  289. var
  290. vGLs: TList;
  291. fQuantity: Double;
  292. i: Integer;
  293. GLRec: TsdDataRecord;
  294. BillsNode: TMeasureBillsIDTreeNode;
  295. begin
  296. vGLs := TList.Create;
  297. try
  298. fQuantity := 0;
  299. with TProjectData(FProjectData).DetailGLData do
  300. LoadProjectGL_DetailGLs(ARec.ValueByName('ID').AsInteger, vGLs);
  301. for i := 0 to vGLs.Count - 1 do
  302. begin
  303. GLRec := TsdDataRecord(vGLs.Items[i]);
  304. with TProjectData(FProjectData).BillsMeasureData do
  305. BillsNode := TMeasureBillsIDTreeNode(BillsMeasureTree.FindNode(GLRec.ValueByName('BillsID').AsInteger));
  306. if Assigned(BillsNode.StageRec) then
  307. fQuantity := fQuantity + BillsNode.StageRec.GatherQuantity.AsFloat * GLRec.ValueByName('Quantity').AsFloat;
  308. end;
  309. if fQuantity <> ARec.PM_Quantity.AsFloat then
  310. ARec.PM_Quantity.AsFloat := fQuantity;
  311. finally
  312. vGLs.Free;
  313. end;
  314. end;
  315. procedure TProjectGLData.CalculatePM_TotalPrice(ARec: TProjectGLRecord);
  316. var
  317. fTotalPrice: Double;
  318. begin
  319. fTotalPrice := ARec.ValidDeltaPrice.AsFloat * ARec.PM_Quantity.AsFloat;
  320. if fTotalPrice <> ARec.PM_TotalPrice.AsFloat then
  321. ARec.PM_TotalPrice.AsFloat := fTotalPrice;
  322. end;
  323. procedure TProjectGLData.sddProjectGLGetRecordClass(
  324. var ARecordClass: TsdRecordClass);
  325. begin
  326. ARecordClass := TProjectGLRecord;
  327. end;
  328. function TProjectGLData.GetPM_TotalPrice: Double;
  329. var
  330. i: Integer;
  331. Rec: TProjectGLRecord;
  332. begin
  333. Result := 0;
  334. for i := 0 to sddProjectGL.RecordCount - 1 do
  335. begin
  336. Rec := TProjectGLRecord(sddProjectGL.Records[i]);
  337. Result := Result + Rec.PM_TotalPrice.AsFloat;
  338. end;
  339. end;
  340. procedure TProjectGLData.SavePM_CurData;
  341. const
  342. sUpdateSql = 'Update GLPrice As G, ProjectGL As P'+
  343. ' Set G.PM_Quantity%d = P.PM_Quantity, G.PM_TotalPrice%d = P.PM_TotalPrice,'+
  344. ' G.PAL_UsedQuantity%d = P.PAL_UsedQuantity, G.PAL_UsedTotalPrice%d = P.PAL_UsedTotalPrice,'+
  345. ' G.PAL_DeltaPrice%d = P.PAL_DeltaPrice, G.PAL_Total%d = P.PAL_Total,'+
  346. ' G.PM_Quantity_F = P.PM_Quantity, G.PM_TotalPrice_F = P.PM_TotalPrice,'+
  347. ' G.PAL_UsedQuantity_F = P.PAL_UsedQuantity, G.PAL_UsedTotalPrice_F = P.PAL_UsedTotalPrice,'+
  348. ' G.PAL_DeltaPrice_F = P.PAL_DeltaPrice, G.PAL_Total_F = P.PAL_Total'+
  349. ' Where (G.PhaseID = %d) and (G.GLID = P.ID)';
  350. var
  351. iStageIndex: Integer;
  352. iPhaseCount: Integer;
  353. sSql: string;
  354. begin
  355. iStageIndex := TProjectData(FProjectData).PhaseData.StageIndex;
  356. iPhaseCount := TProjectData(FProjectData).ProjProperties.PhaseCount;
  357. sSql := Format(sUpdateSql, [iStageIndex, iStageIndex, iStageIndex, iStageIndex, iStageIndex, iStageIndex, iPhaseCount]);
  358. ExecuteSql(sSql);
  359. end;
  360. procedure TProjectGLData.CalculateGL_PM(AGLID: Integer);
  361. var
  362. Rec: TProjectGLRecord;
  363. begin
  364. Rec := TProjectGLRecord(sddProjectGL.FindKey('idxID', AGLID));
  365. if not Assigned(Rec) then Exit;
  366. CalculatePM_Quantity(Rec);
  367. CalculatePM_TotalPrice(Rec);
  368. CalculatePALRela(Rec);
  369. end;
  370. procedure TProjectGLData.CalculateGLs_PM(ADetailGLs: TList);
  371. var
  372. i: Integer;
  373. DetailGLRec: TDetailGLRecord;
  374. begin
  375. for i := 0 to ADetailGLs.Count - 1 do
  376. begin
  377. DetailGLRec := TDetailGLRecord(ADetailGLs.Items[i]);
  378. CalculateGL_PM(DetailGLRec.GLID.AsInteger);
  379. end;
  380. end;
  381. procedure TProjectGLData.CalculateRelaBills(ARec: TProjectGLRecord);
  382. var
  383. iGL: Integer;
  384. DetailGLRec: TDetailGLRecord;
  385. begin
  386. LoadDetailGLs(ARec.ID.AsInteger);
  387. for iGL := 0 to FTempGLs.Count - 1 do
  388. begin
  389. DetailGLRec := TDetailGLRecord(FTempGLs.Items[iGL]);
  390. with TProjectData(FProjectData).PhaseData do
  391. StageData.CalculatePriceMargin(DetailGLRec.BillsID.AsInteger);
  392. end;
  393. with TProjectData(FProjectData).PhaseData do
  394. StageData.CalculatePriceMarginNode;
  395. end;
  396. procedure TProjectGLData.LoadDetailGLs(AGLID: Integer);
  397. begin
  398. FTempGLs.Clear;
  399. with TProjectData(FProjectData).DetailGLData do
  400. LoadProjectGL_DetailGLs(AGLID, FTempGLs);
  401. end;
  402. function TProjectGLData.GetActive: Boolean;
  403. begin
  404. Result := sddProjectGL.Active;
  405. end;
  406. procedure TProjectGLData.sdvProjectGLSetText(var Text: String;
  407. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  408. var Allow: Boolean);
  409. var
  410. iPhaseID: Integer;
  411. Rec: TProjectGLRecord;
  412. begin
  413. Rec := TProjectGLRecord(ARecord);
  414. if SameText(AColumn.FieldName, 'Code') or
  415. SameText(AColumn.FieldName, 'Name') or
  416. SameText(AColumn.FieldName, 'Units') or
  417. SameText(AColumn.FieldName, 'Specs') or
  418. SameText(AColumn.FieldName, 'BasePrice') or
  419. SameText(AColumn.FieldName, 'RiskRange') then
  420. begin
  421. iPhaseID := Rec.LockedPhaseID.AsInteger;
  422. if iPhaseID > 0 then
  423. DataSetErrorMessage(Allow, Format('该工料在第%d期已进行调差计算,不可修改基础数据。', [iPhaseID]));
  424. end;
  425. if AValue.DataType in [ftInteger, ftFloat] then
  426. if not CheckNumeric(Text) then
  427. Text := '';
  428. if SameText(AColumn.FieldName, 'Code') then
  429. begin
  430. if StrToIntDef(Text, 0) = 0 then
  431. begin
  432. DataSetErrorMessage(Allow, '编号不可为0或空。');
  433. if Rec.Code.AsString = '' then
  434. sddProjectGL.Remove(ARecord);
  435. end
  436. else if CheckSameCode(StrToInt(Text)) then
  437. begin
  438. DataSetErrorMessage(Allow, '编号不可重复。');
  439. if Rec.Code.AsString = '' then
  440. sddProjectGL.Remove(AValue.Owner);
  441. end
  442. else if CheckApplied(Rec.ID.AsInteger) then
  443. DataSetErrorMessage(Allow, '工料已被应用,不可修改编号。');
  444. end
  445. else
  446. begin
  447. if (Rec.Code.AsString = '') then
  448. begin
  449. DataSetErrorMessage(Allow, '编号不可为空,请先填写编号,再填写其他信息。');
  450. sddProjectGL.Remove(AValue.Owner);
  451. end;
  452. end;
  453. end;
  454. procedure TProjectGLData.LoadStagePM_CalcData;
  455. const
  456. sSelectSql = 'Select GLID, PhaseID, PM_PreQuantity, PM_PreTotalPrice,'+
  457. ' PrePAL_UsedQuantity, PrePAL_UsedTotalPrice, PrePAL_DeltaPrice, PrePAL_Total,' +
  458. ' PM_Quantity%d As PM_Quantity, PM_TotalPrice%d As PM_TotalPrice,'+
  459. ' PAL_UsedQuantity%d As PAL_UsedQuantity, PAL_UsedTotalPrice%d As PAL_UsedTotalPrice,' +
  460. ' PAL_DeltaPrice%d As PAL_DeltaPrice, PAL_Total%d As PAL_Total' +
  461. ' From GLPrice Where PhaseID = %d';
  462. var
  463. sSql: string;
  464. vQuery: TADOQuery;
  465. procedure LoadPM_Calc;
  466. var
  467. iRec: Integer;
  468. Rec: TProjectGLRecord;
  469. begin
  470. for iRec := 0 to sddProjectGL.RecordCount - 1 do
  471. begin
  472. Rec := TProjectGLRecord(sddProjectGL.Records[iRec]);
  473. if vQuery.Active and vQuery.Locate('GLID', Rec.ValueByName('ID').AsInteger, []) then
  474. begin
  475. Rec.PM_Quantity.AsFloat := vQuery.FieldByName('PM_Quantity').AsFloat;
  476. Rec.PM_TotalPrice.AsFloat := vQuery.FieldByName('PM_TotalPrice').AsFloat;
  477. Rec.PAL_UsedQuantity.AsFloat := vQuery.FieldByName('PAL_UsedQuantity').AsFloat;
  478. Rec.PAL_UsedTotalPrice.AsFloat := vQuery.FieldByName('PAL_UsedTotalPrice').AsFloat;
  479. Rec.PAL_DeltaPrice.AsFloat := vQuery.FieldByName('PAL_DeltaPrice').AsFloat;
  480. Rec.PAL_Total.AsFloat := vQuery.FieldByName('PAL_Total').AsFloat;
  481. end
  482. else
  483. begin
  484. Rec.PM_Quantity.AsFloat := 0;
  485. Rec.PM_TotalPrice.AsFloat := 0;
  486. Rec.PAL_UsedQuantity.AsFloat := 0;
  487. Rec.PAL_UsedTotalPrice.AsFloat := 0;
  488. Rec.PAL_DeltaPrice.AsFloat := 0;
  489. Rec.PAL_Total.AsFloat := 0;
  490. end;
  491. end;
  492. end;
  493. begin
  494. BeforeBatchOperation;
  495. vQuery := TADOQuery.Create(nil);
  496. try
  497. vQuery.Connection := sdpProjectGL.Connection;
  498. with TProjectData(FProjectData) do
  499. sSql := Format(sSelectSql, [StageIndex, StageIndex, StageIndex, StageIndex, StageIndex, StageIndex, PhaseIndex]);
  500. vQuery.SQL.Clear;
  501. vQuery.SQL.Add(sSql);
  502. vQuery.Open;
  503. LoadPM_Calc;
  504. finally
  505. vQuery.Free;
  506. AfterBatchOperation;
  507. end;
  508. end;
  509. procedure TProjectGLData.AfterBatchOperation;
  510. begin
  511. sddProjectGL.EndUpdate;
  512. sddProjectGL.EnableControls;
  513. sddProjectGL.AfterValueChanged := sddProjectGLAfterValueChanged;
  514. end;
  515. procedure TProjectGLData.BeforeBatchOperation;
  516. begin
  517. sddProjectGL.AfterValueChanged := nil;
  518. sddProjectGL.DisableControls;
  519. sddProjectGL.BeginUpdate;
  520. end;
  521. function TProjectGLData.CheckApplied(AGLID: Integer): Boolean;
  522. begin
  523. LoadDetailGLs(AGLID);
  524. Result := FTempGLs.Count > 0;
  525. end;
  526. procedure TProjectGLData.sddProjectGLBeforeDeleteRecord(
  527. ARecord: TsdDataRecord; var Allow: Boolean);
  528. begin
  529. Allow := not CheckApplied(ARecord.ValueByName('ID').AsInteger);
  530. if not Allow then
  531. ErrorMessage('工料已被应用,不可删除。');
  532. end;
  533. function TProjectGLData.GetDecimal: TCalcDecimal;
  534. begin
  535. Result := TProjectData(FProjectData).ProjProperties.DecimalManager.PriceMargin;
  536. end;
  537. procedure TProjectGLData.CalculatePALRela(ARec: TProjectGLRecord);
  538. begin
  539. ARec.UsedTotalPrice.AsFloat := Decimal.TotalPrice.RoundTo(ARec.UsedQuantity.AsFloat * ARec.InfoPrice.AsFloat);
  540. ARec.PAL_UsedQuantity.AsFloat := Decimal.Quantity.RoundTo(ARec.PM_Quantity.AsFloat - ARec.UsedQuantity.AsFloat);
  541. ARec.PAL_UsedTotalPrice.AsFloat := Decimal.TotalPrice.RoundTo(ARec.PAL_UsedQuantity.AsFloat * ARec.BasePrice.AsFloat);
  542. ARec.PAL_DeltaPrice.AsFloat := Decimal.TotalPrice.RoundTo( - ARec.UsedQuantity.AsFloat * ARec.DeltaPrice.AsFloat);
  543. ARec.PAL_Total.AsFloat := Decimal.TotalPrice.RoundTo(ARec.BasePrice.AsFloat*ARec.PM_Quantity.AsFloat - ARec.InfoPrice.AsFloat*ARec.UsedQuantity.AsFloat);
  544. end;
  545. procedure TProjectGLData.CalculatePALRelas;
  546. var
  547. iRec: Integer;
  548. Rec: TProjectGLRecord;
  549. begin
  550. if TProjectData(FProjectData).PhaseData.StageDataReadOnly then Exit;
  551. for iRec := 0 to sddProjectGL.RecordCount - 1 do
  552. begin
  553. Rec := TProjectGLRecord(sddProjectGL.Records[iRec]);
  554. CalculatePALRela(Rec);
  555. end;
  556. end;
  557. end.