PhasePayDm.pas 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415
  1. unit PhasePayDm;
  2. interface
  3. uses
  4. SysUtils, Classes, sdDB, sdProvider, ADODB, FormulaCalc;
  5. type
  6. TPhasePayData = class(TDataModule)
  7. sdpPhasePay: TsdADOProvider;
  8. sddPhasePay: TsdDataSet;
  9. procedure sddPhasePayBeforeValueChange(AValue: TsdValue;
  10. const NewValue: Variant; var Allow: Boolean);
  11. procedure sddPhasePayAfterValueChanged(AValue: TsdValue);
  12. private
  13. FPhaseData: TObject;
  14. FPayFormula: TPayFormula;
  15. FBeforeChangeTotalPrice: Double;
  16. function CheckMinus(AID: Integer): Boolean;
  17. function GetFormula(AID: Integer): string;
  18. function GetCalcType(AID: Integer): Integer;
  19. function GetPayablePrice(AIndex: Integer): Double;
  20. procedure RepairPhaseRecord;
  21. procedure BeforeBatchOperation;
  22. procedure AfterBatchOperation;
  23. function GetCurPayable: Double;
  24. function GetLastestPhasePay(AType: Integer): Double;
  25. procedure SetFieldValidChar;
  26. public
  27. constructor Create(APhaseData: TObject);
  28. destructor Destroy; override;
  29. procedure Open(AConnection: TADOConnection);
  30. procedure Save;
  31. function AddPayRecord(AID: Integer): TsdDataRecord;
  32. function PayRecord(AID: Integer): TsdDataRecord;
  33. procedure Delete(AID: Integer);
  34. procedure CalculateAll;
  35. procedure Calculate(AID: Integer);
  36. procedure CalculateCurPay;
  37. procedure UpdateDataForNewAudit;
  38. procedure CopyPrePhasePayData;
  39. property PayablePrice[AIndex: Integer]: Double read GetPayablePrice;
  40. // 本期应付
  41. property CurPayable: Double read GetCurPayable;
  42. // AType表示不同类型,取值如下:
  43. // 1: 本期数据 2: 截止本期数据 3: 截止上期数据
  44. property LastestPhasePay[AType: Integer]: Double read GetLastestPhasePay;
  45. end;
  46. implementation
  47. uses
  48. PhaseData, ProjectData, DealPaymentDm, BillsDm, ConstUnit;
  49. {$R *.dfm}
  50. { TPhasePayData }
  51. constructor TPhasePayData.Create(APhaseData: TObject);
  52. begin
  53. inherited Create(nil);
  54. FPhaseData := APhaseData;
  55. FPayFormula := TPayFormula.Create(TPhaseData(FPhaseData).ProjectData);
  56. end;
  57. procedure TPhasePayData.Delete(AID: Integer);
  58. begin
  59. sddPhasePay.Remove(sddPhasePay.FindKey('idxID', AID));
  60. end;
  61. destructor TPhasePayData.Destroy;
  62. begin
  63. FPayFormula.Free;
  64. inherited;
  65. end;
  66. procedure TPhasePayData.UpdateDataForNewAudit;
  67. var
  68. iNewAudit, iIndex: Integer;
  69. Rec: TsdDataRecord;
  70. begin
  71. BeforeBatchOperation;
  72. try
  73. iNewAudit := TPhaseData(FPhaseData).PhaseProperty.AuditCount;
  74. for iIndex := 0 to sddPhasePay.RecordCount - 1 do
  75. begin
  76. Rec := sddPhasePay.Records[iIndex];
  77. Rec.ValueByName('TotalPrice' + IntToStr(iNewAudit)).AsString :=
  78. Rec.ValueByName('TotalPrice' + IntToStr(iNewAudit - 1)).AsString;
  79. Rec.ValueByName('Formula' + IntToStr(iNewAudit)).AsString :=
  80. Rec.ValueByName('Formula' + IntToStr(iNewAudit - 1)).AsString;
  81. Rec.ValueByName('EndTotalPrice' + IntToStr(iNewAudit)).AsString :=
  82. Rec.ValueByName('EndTotalPrice' + IntToStr(iNewAudit - 1)).AsString;
  83. Rec.ValueByName('PreTotalPrice' + IntToStr(iNewAudit)).AsString :=
  84. Rec.ValueByName('PreTotalPrice' + IntToStr(iNewAudit - 1)).AsString;
  85. end;
  86. finally
  87. AfterBatchOperation;
  88. end;
  89. end;
  90. procedure TPhasePayData.Open(AConnection: TADOConnection);
  91. begin
  92. sdpPhasePay.Connection := AConnection;
  93. sddPhasePay.Open;
  94. if not Assigned(sddPhasePay.IndexList.FindByName('idxID')) then
  95. sddPhasePay.AddIndex('idxID', 'ID');
  96. SetFieldValidChar;
  97. // 为适应旧项目处不计算合同支付值所做修改。
  98. if sddPhasePay.RecordCount = 0 then
  99. begin
  100. CopyPrePhasePayData;
  101. CalculateAll;
  102. end;
  103. end;
  104. procedure TPhasePayData.Save;
  105. begin
  106. sddPhasePay.Save;
  107. end;
  108. function TPhasePayData.AddPayRecord(AID: Integer): TsdDataRecord;
  109. begin
  110. Result := sddPhasePay.Add;
  111. Result.ValueByName('ID').AsInteger := AID;
  112. end;
  113. procedure TPhasePayData.sddPhasePayBeforeValueChange(AValue: TsdValue;
  114. const NewValue: Variant; var Allow: Boolean);
  115. begin
  116. if not Assigned(AValue) then Exit;
  117. if Pos('TotalPrice', AValue.FieldName) = 1 then
  118. FBeforeChangeTotalPrice := AValue.AsFloat;
  119. end;
  120. procedure TPhasePayData.sddPhasePayAfterValueChanged(AValue: TsdValue);
  121. begin
  122. if Pos('TotalPrice', AValue.FieldName) = 1 then
  123. begin
  124. AValue.Owner.ValueByName('End' + AValue.FieldName).AsFloat := AValue.AsFloat
  125. + AValue.Owner.ValueByName('Pre' + AValue.FieldName).AsFloat;
  126. with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do
  127. UpdateTotalPrice(AValue.Owner.ValueByName('ID').AsInteger, AValue.AsFloat - FBeforeChangeTotalPrice);
  128. end;
  129. CalculateCurPay;
  130. end;
  131. procedure TPhasePayData.CalculateAll;
  132. var
  133. iIndex: Integer;
  134. begin
  135. if TPhaseData(FPhaseData).StageDataReadOnly then Exit;
  136. RepairPhaseRecord;
  137. for iIndex := 0 to sddPhasePay.RecordCount - 1 do
  138. Calculate(sddPhasePay.Records[iIndex].ValueByName('ID').AsInteger);
  139. CalculateCurPay;
  140. end;
  141. procedure TPhasePayData.Calculate(AID: Integer);
  142. var
  143. Rec: TsdDataRecord;
  144. // 金额列名, 公式列名
  145. sTPField, sFField, sPreField: string;
  146. iID: Integer;
  147. fTotalPrice, fStartedPrice: Double;
  148. begin
  149. Rec := sddPhasePay.FindKey('idxID', AID);
  150. sTPField := 'TotalPrice' + IntToStr(TPhaseData(FPhaseData).StageIndex);
  151. sFField := 'Formula' + IntToStr(TPhaseData(FPhaseData).StageIndex);
  152. sPreField := 'PreTotalPrice' + IntToStr(TPhaseData(FPhaseData).StageIndex);
  153. iID := Rec.ValueByName('ID').AsInteger;
  154. with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do
  155. begin
  156. // 获取起扣金额
  157. fStartedPrice := GetStartedPrice(iID);
  158. if Rec.ValueByName(sFField).AsString <> '' then
  159. begin
  160. // 初次达到起扣金额时,bqwc基数值取值为累计完成计量-起扣金额
  161. if Rec.ValueByName('Pre'+sTPField).AsFloat = 0 then
  162. fTotalPrice := FPayFormula.Calculate(Rec.ValueByName(sFField).AsString, fStartedPrice)
  163. else
  164. fTotalPrice := FPayFormula.Calculate(Rec.ValueByName(sFField).AsString);
  165. end
  166. else
  167. fTotalPrice := 0;
  168. if CheckStartedPrice(iID) then
  169. Rec.ValueByName(sTPField).AsFloat := GetAllowTotalPrice(iID, fTotalPrice, Rec.ValueByName(sPreField).AsFloat)
  170. else
  171. Rec.ValueByName(sTPField).AsFloat := 0;
  172. end;
  173. {if Rec.ValueByName(sFField).AsString <> '' then
  174. begin
  175. with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do
  176. begin
  177. iID := Rec.ValueByName('ID').AsInteger;
  178. // 获取起扣金额
  179. fStartedPrice := GetStartedPrice(iID);
  180. // 初次达到起扣金额时,bqwc基数值取值为累计完成计量-起扣金额
  181. if Rec.ValueByName('Pre'+sTPField).AsFloat = 0 then
  182. fTotalPrice := FPayFormula.Calculate(Rec.ValueByName(sFField).AsString, fStartedPrice)
  183. else
  184. fTotalPrice := FPayFormula.Calculate(Rec.ValueByName(sFField).AsString);
  185. if CheckStartedPrice(iID) then
  186. Rec.ValueByName(sTPField).AsFloat := GetAllowTotalPrice(iID, fTotalPrice, Rec.ValueByName(sPreField).AsFloat)
  187. else
  188. Rec.ValueByName(sTPField).AsFloat := 0;
  189. end;
  190. end;}
  191. // 计算截止数据
  192. Rec.ValueByName('End' + sTPField).AsFloat := Rec.ValueByName(sTPField).AsFloat
  193. + Rec.ValueByName('Pre' + sTPField).AsFloat;
  194. end;
  195. function TPhasePayData.GetPayablePrice(AIndex: Integer): Double;
  196. var
  197. iIndex: Integer;
  198. sTotalPriceField: string;
  199. Rec: TsdDataRecord;
  200. begin
  201. Result := 0;
  202. // 阶段在0--14之间
  203. if (AIndex < 0) or (AIndex > iMaxStageCount-1) then Exit;
  204. sTotalPriceField := 'TotalPrice' + IntToStr(AIndex);
  205. for iIndex := 0 to sddPhasePay.RecordCount - 1 do
  206. begin
  207. Rec := sddPhasePay.Records[iIndex];
  208. if CheckMinus(Rec.ValueByName('ID').AsInteger) then
  209. Result := Result - Rec.ValueByName(sTotalPriceField).AsFloat
  210. else
  211. Result := Result + Rec.ValueByName(sTotalPriceField).AsFloat;
  212. end;
  213. end;
  214. function TPhasePayData.CheckMinus(AID: Integer): Boolean;
  215. begin
  216. with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do
  217. Result := sddDealPayment.FindKey('idxID', AID).ValueByName('IsMinus').AsBoolean;
  218. end;
  219. function TPhasePayData.GetFormula(AID: Integer): string;
  220. begin
  221. with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do
  222. Result := sddDealPayment.FindKey('idxID', AID).ValueByName('Formula').AsString;
  223. end;
  224. procedure TPhasePayData.AfterBatchOperation;
  225. begin
  226. sddPhasePay.BeforeValueChange := sddPhasePayBeforeValueChange;
  227. sddPhasePay.AfterValueChanged := sddPhasePayAfterValueChanged;
  228. end;
  229. procedure TPhasePayData.BeforeBatchOperation;
  230. begin
  231. sddPhasePay.BeforeValueChange := nil;
  232. sddPhasePay.AfterValueChanged := nil;
  233. end;
  234. procedure TPhasePayData.CalculateCurPay;
  235. var
  236. Rec: TsdDataRecord;
  237. sTPField: string;
  238. I: Integer;
  239. begin
  240. sTPField := 'TotalPrice' + IntToStr(TPhaseData(FPhaseData).StageIndex);
  241. for I := 0 to sddPhasePay.RecordCount - 1 do
  242. begin
  243. Rec := sddPhasePay.Records[I];
  244. if GetCalcType(Rec.ValueByName('ID').AsInteger) = 1 then
  245. begin
  246. Rec.ValueByName(sTPField).AsFloat := CurPayable;
  247. Rec.ValueByName('End' + sTPField).AsFloat := Rec.ValueByName(sTPField).AsFloat
  248. + Rec.ValueByName('Pre' + sTPField).AsFloat;
  249. Break;
  250. end;
  251. end;
  252. end;
  253. function TPhasePayData.GetCurPayable: Double;
  254. var
  255. Rec: TsdDataRecord;
  256. sTPField: string;
  257. i: Integer;
  258. begin
  259. sTPField := 'TotalPrice' + IntToStr(TPhaseData(FPhaseData).StageIndex);
  260. Result := 0;
  261. for I := 0 to sddPhasePay.RecordCount - 1 do
  262. begin
  263. Rec := sddPhasePay.Records[I];
  264. // 检查是否为一般项
  265. if GetCalcType(Rec.ValueByName('ID').AsInteger) = 0 then
  266. if CheckMinus(Rec.ValueByName('ID').AsInteger) then
  267. Result := Result - Rec.ValueByName(sTPField).AsFloat
  268. else
  269. Result := Result + Rec.ValueByName(sTPField).AsFloat;
  270. end;
  271. end;
  272. function TPhasePayData.GetCalcType(AID: Integer): Integer;
  273. var
  274. Rec: TsdDataRecord;
  275. begin
  276. Result := 0;
  277. with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do
  278. Rec := sddDealPayment.FindKey('idxID', AID);
  279. if Assigned(Rec) then
  280. Result := Rec.ValueByName('CalcType').AsInteger;
  281. end;
  282. function TPhasePayData.GetLastestPhasePay(AType: Integer): Double;
  283. var
  284. Rec: TsdDataRecord;
  285. sTPField: string;
  286. i: Integer;
  287. begin
  288. case AType of
  289. 1: sTPField := 'TotalPrice' + IntToStr(TPhaseData(FPhaseData).PhaseProperty.AuditCount);
  290. 2: sTPField := 'EndTotalPrice' + IntToStr(TPhaseData(FPhaseData).PhaseProperty.AuditCount);
  291. 3: sTPField := 'PreTotalPrice' + IntToStr(TPhaseData(FPhaseData).PhaseProperty.AuditCount);
  292. end;
  293. Result := 0;
  294. for i := 0 to sddPhasePay.RecordCount - 1 do
  295. begin
  296. Rec := sddPhasePay.Records[i];
  297. // 检查是否为一般项
  298. if GetCalcType(Rec.ValueByName('ID').AsInteger) = 0 then
  299. if CheckMinus(Rec.ValueByName('ID').AsInteger) then
  300. Result := Result - Rec.ValueByName(sTPField).AsFloat
  301. else
  302. Result := Result + Rec.ValueByName(sTPField).AsFloat;
  303. end;
  304. end;
  305. procedure TPhasePayData.CopyPrePhasePayData;
  306. var
  307. iRecord: Integer;
  308. Rec, NewRec: TsdDataRecord;
  309. begin
  310. BeforeBatchOperation;
  311. try
  312. if sddPhasePay.RecordCount > 0 then Exit;
  313. with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do
  314. for iRecord := 0 to sddDealPayment.RecordCount - 1 do
  315. begin
  316. Rec := sddDealPayment.Records[iRecord];
  317. NewRec := sddPhasePay.Add;
  318. NewRec.ValueByName('ID').AsInteger := Rec.ValueByName('ID').AsInteger;
  319. NewRec.ValueByName('EndTotalPrice0').AsFloat := Rec.ValueByName('TotalPrice').AsFloat;
  320. NewRec.ValueByName('PreTotalPrice0').AsFloat := Rec.ValueByName('TotalPrice').AsFloat;
  321. NewRec.ValueByName('Formula0').AsString := Rec.ValueByName('Formula').AsString;
  322. end;
  323. finally
  324. AfterBatchOperation;
  325. end;
  326. end;
  327. procedure TPhasePayData.SetFieldValidChar;
  328. var
  329. i: Integer;
  330. sField: string;
  331. begin
  332. for i := 0 to iMaxStageCount - 1 do
  333. begin
  334. sField := 'TotalPrice' + IntToStr(i);
  335. sddPhasePay.FieldByName(sField).ValidChars := sddPhasePay.FieldByName(sField).ValidChars + ArithmeticCharSet + ExprsBaseCharSet;
  336. end;
  337. end;
  338. function TPhasePayData.PayRecord(AID: Integer): TsdDataRecord;
  339. begin
  340. Result := sddPhasePay.FindKey('idxID', AID);
  341. end;
  342. procedure TPhasePayData.RepairPhaseRecord;
  343. var
  344. i: Integer;
  345. vDealRec, vPhaseRec: TsdDataRecord;
  346. begin
  347. // 旧设计中,DealPayment中数据多于PhasePay
  348. // 在于用户新增了合同支付项,但未输入金额或公式,以减少数据
  349. // 现,要求存在合同支付项,设置了计提期限,但未输入金额或公式时,达计提期限时,金额需计
  350. // 故在每次计算前,检查一遍合同支付数据,以兼容旧项目,并保证DealPayment与PhasePay数据行相同
  351. with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do
  352. begin
  353. if sddDealPayment.RecordCount > sddPhasePay.RecordCount then
  354. begin
  355. for i := 0 to sddDealPayment.RecordCount - 1 do
  356. begin
  357. vDealRec := sddDealPayment.Records[i];
  358. vPhaseRec := PayRecord(vDealRec.ValueByName('ID').AsInteger);
  359. if not Assigned(vPhaseRec) then
  360. vPhaseRec := AddPayRecord(vDealRec.ValueByName('ID').AsInteger);
  361. end;
  362. end;
  363. end;
  364. end;
  365. end.