ProjectGLDm.pas 26 KB

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