ProjectGLDm.pas 24 KB

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