ProjectGLDm.pas 24 KB

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