DealPaymentDm.pas 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715
  1. unit DealPaymentDm;
  2. interface
  3. uses
  4. SysUtils, Classes, sdDB, sdProvider, ADODB, FormulaCalc, UtilMethods;
  5. type
  6. TDealPaymentData = class(TDataModule)
  7. sdpDealPayment: TsdADOProvider;
  8. sddDealPayment: TsdDataSet;
  9. sdvDealPayment: TsdDataView;
  10. procedure sddDealPaymentAfterAddRecord(ARecord: TsdDataRecord);
  11. procedure sdvDealPaymentGetText(var Text: String;
  12. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  13. DisplayText: Boolean);
  14. procedure sdvDealPaymentNeedLookupRecord(ARecord: TsdDataRecord;
  15. AColumn: TsdViewColumn; ANewText: String);
  16. procedure sdvDealPaymentSetText(var Text: string;
  17. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  18. var Allow: Boolean);
  19. procedure sddDealPaymentBeforeAddRecord(ARecord: TsdDataRecord;
  20. var Allow: Boolean);
  21. procedure sddDealPaymentAfterValueChanged(AValue: TsdValue);
  22. procedure sddDealPaymentBeforeDeleteRecord(ARecord: TsdDataRecord;
  23. var Allow: Boolean);
  24. private
  25. FProjectData: TObject;
  26. FPayFormula: TPayFormula;
  27. procedure InitPredefinedPayItems;
  28. procedure RepairSerialNo;
  29. procedure RepairLockedFormula;
  30. function GetNewID: Integer;
  31. function GetNewSerialNo: Integer;
  32. function GetAddTotalPrice: Double;
  33. function GetCutTotalPrice: Double;
  34. function GetPaidTotalPrice: Double;
  35. public
  36. constructor Create(AProjectData: TObject);
  37. destructor Destroy; override;
  38. procedure Open(AConnection: TADOConnection);
  39. procedure Close;
  40. procedure Save;
  41. procedure Init;
  42. // 扣款项是否已达起扣金额
  43. function CheckStartedPrice(AID: Integer): Boolean;
  44. function CheckReachPlan(ARec: TsdDataRecord): Boolean;
  45. function GetAllowTotalPrice(AID: Integer; ATotalPrice: Double): Double;
  46. procedure UpdateTotalPrice(AID: Integer; ATotalPrice: Double);
  47. function PlanStr(ARec: TsdDataRecord): string;
  48. function GetStartedPrice(AID: Integer): Double;
  49. procedure CalcStarted_RangePrice;
  50. procedure ResetPhaseLink;
  51. procedure LockedData;
  52. procedure UpdateLinkSerialNo;
  53. property ProjectData: TObject read FProjectData;
  54. // 扣款项,累计金额合计
  55. property CutTotalPrice: Double read GetCutTotalPrice;
  56. // 非扣款项,累计金额合计
  57. property AddTotalPrice: Double read GetAddTotalPrice;
  58. // 实付
  59. property PaidTotalPrice: Double read GetPaidTotalPrice;
  60. property PayFormula: TPayFormula read FPayFormula;
  61. end;
  62. implementation
  63. uses
  64. ProjectData, PhasePayDm, PhaseData, ZhAPI, BillsDm, Math;
  65. {$R *.dfm}
  66. { TDealPaymentData }
  67. function TDealPaymentData.CheckStartedPrice(AID: Integer): Boolean;
  68. var
  69. Rec: TsdDataRecord;
  70. begin
  71. Rec := sddDealPayment.FindKey('idxID', AID);
  72. with TProjectData(FProjectData).BillsData do
  73. Result := Settlement[AddGatherIndex] >= Rec.ValueByName('StartedPrice').AsFloat;
  74. end;
  75. constructor TDealPaymentData.Create(AProjectData: TObject);
  76. begin
  77. inherited Create(nil);
  78. FProjectData := AProjectData;
  79. FPayFormula := TPayFormula.Create(FProjectData);
  80. end;
  81. destructor TDealPaymentData.Destroy;
  82. begin
  83. FPayFormula.Free;
  84. inherited;
  85. end;
  86. function TDealPaymentData.GetAllowTotalPrice(AID: Integer;
  87. ATotalPrice: Double): Double;
  88. var
  89. Rec: TsdDataRecord;
  90. fAllowPrice: Double;
  91. begin
  92. Result := ATotalPrice;
  93. Rec := sddDealPayment.FindKey('idxID', AID);
  94. if Rec.ValueByName('RangePrice').AsFloat = 0 then Exit;
  95. fAllowPrice := Rec.ValueByName('RangePrice').AsFloat - Rec.ValueByName('TotalPrice').AsFloat;
  96. if not CheckReachPlan(Rec) then
  97. Result := Min(fAllowPrice, ATotalPrice)
  98. else
  99. Result := fAllowPrice;
  100. end;
  101. function TDealPaymentData.GetNewID: Integer;
  102. var
  103. idx: TsdIndex;
  104. begin
  105. idx := sddDealPayment.FindIndex('idxID');
  106. if idx.RecordCount > 0 then
  107. Result := idx.Records[idx.RecordCount - 1].ValueByName('ID').AsInteger + 1
  108. else
  109. Result := 1;
  110. end;
  111. procedure TDealPaymentData.Init;
  112. begin
  113. if sddDealPayment.RecordCount > 0 then Exit;
  114. InitPredefinedPayItems;
  115. end;
  116. procedure TDealPaymentData.InitPredefinedPayItems;
  117. procedure AddPredefinedPayItem(const AItem: string);
  118. var
  119. sgsItem: TStrings;
  120. f: Double;
  121. Rec: TsdDataRecord;
  122. begin
  123. sgsItem := TStringList.Create;
  124. try
  125. sgsItem.Delimiter := ';';
  126. sgsItem.DelimitedText := AItem;
  127. if sgsItem.Count < 7 then Exit;
  128. Rec := sddDealPayment.Add;
  129. Rec.ValueByName('Name').AsString := sgsItem[0];
  130. Rec.ValueByName('CalcType').AsInteger := StrToIntDef(sgsItem[1], 0);
  131. Rec.ValueByName('IsMinus').AsBoolean := sgsItem[2] = '1';
  132. if TryStrToFloat(sgsItem[3], f) then
  133. Rec.ValueByName('StartedPrice').AsFloat := f
  134. else
  135. Rec.ValueByName('SFormula').AsString := sgsItem[3];
  136. if TryStrToFloat(sgsItem[4], f) then
  137. Rec.ValueByName('RangePrice').AsFloat := f
  138. else
  139. Rec.ValueByName('RFormula').AsString := sgsItem[4];
  140. Rec.ValueByName('Formula').AsString := sgsItem[5];
  141. if SameText(sgsItem[5], 'bqwc') then
  142. Rec.ValueByName('LockedFormula').AsBoolean := True;
  143. Rec.ValueByName('PreDefined').AsBoolean := StrToBoolDef(sgsItem[6], False);
  144. finally
  145. sgsItem.Free;
  146. end;
  147. end;
  148. var
  149. sgsItems: TStrings;
  150. I: Integer;
  151. begin
  152. sgsItems := TStringList.Create;
  153. try
  154. sgsItems.LoadFromFile(GetAppFilePath + 'DealPayment.txt');
  155. for I := 0 to sgsItems.Count - 1 do
  156. if sgsItems[I] <> '' then
  157. AddPredefinedPayItem(sgsItems[I]);
  158. finally
  159. sgsItems.Free;
  160. end;
  161. end;
  162. procedure TDealPaymentData.LockedData;
  163. var
  164. iIndex: Integer;
  165. Rec: TsdDataRecord;
  166. begin
  167. for iIndex := 0 to sddDealPayment.RecordCount - 1 do
  168. begin
  169. Rec := sddDealPayment.Records[iIndex];
  170. Rec.ValueByName('Locked').AsBoolean := True;
  171. if Rec.ValueByName('Formula').AsString <> '' then
  172. Rec.ValueByName('LockedFormula').AsBoolean := True;
  173. end;
  174. end;
  175. procedure TDealPaymentData.Open(AConnection: TADOConnection);
  176. begin
  177. sdpDealPayment.Connection := AConnection;
  178. sddDealPayment.Open;
  179. RepairSerialNo;
  180. RepairLockedFormula;
  181. if not Assigned(sddDealPayment.IndexList.FindByName('idxID')) then
  182. sddDealPayment.AddIndex('idxID', 'ID');
  183. if not Assigned(sddDealPayment.IndexList.FindByName('idxView')) then
  184. sddDealPayment.AddIndex('idxView', 'SerialNo');
  185. // 开始计量前,CutTotalPrice链接至TotalPrice,已解决无计量数据时无法输入问题
  186. sddDealPayment.FieldByName('TotalPrice').ValidChars := sddDealPayment.FieldByName('TotalPrice').ValidChars + ArithmeticCharSet + ExprsBaseCharSet;
  187. sddDealPayment.FieldByName('StartedPrice').ValidChars := sddDealPayment.FieldByName('StartedPrice').ValidChars + ArithmeticCharSet + ExprsExceptCharSet;
  188. sddDealPayment.FieldByName('RangePrice').ValidChars := sddDealPayment.FieldByName('RangePrice').ValidChars + ArithmeticCharSet + ExprsExceptCharSet;
  189. sdvDealPayment.Open;
  190. sdvDealPayment.IndexName := 'idxView';
  191. end;
  192. procedure TDealPaymentData.ResetPhaseLink;
  193. begin
  194. with TProjectData(FProjectData).PhaseData do
  195. begin
  196. sdvDealPayment.Columns.FindColumn('CurTotalPrice').LookupDataSet := PhasePayData.sddPhasePay;
  197. sdvDealPayment.Columns.FindColumn('CurTotalPrice').LookupResultField := 'TotalPrice' + IntToStr(StageIndex);
  198. end;
  199. end;
  200. procedure TDealPaymentData.Save;
  201. begin
  202. sddDealPayment.Save;
  203. end;
  204. procedure TDealPaymentData.sddDealPaymentAfterAddRecord(
  205. ARecord: TsdDataRecord);
  206. var
  207. iSerialNo: Integer;
  208. begin
  209. iSerialNo := GetNewSerialNo;
  210. ARecord.ValueByName('ID').AsInteger := GetNewID;
  211. ARecord.ValueByName('SerialNo').AsInteger := iSerialNo;
  212. ARecord.ValueByName('CreatePhaseID').AsInteger := TProjectData(FProjectData).PhaseIndex;
  213. end;
  214. procedure TDealPaymentData.sdvDealPaymentGetText(var Text: String;
  215. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  216. DisplayText: Boolean);
  217. procedure GetDisplayText;
  218. begin
  219. if not Assigned(AValue) or
  220. ((Pos('Price', AValue.FieldName) > 0) and (AValue.AsFloat = 0)) then
  221. Text := '';
  222. end;
  223. function GetFormulaField(const APriceField: string): string;
  224. begin
  225. if SameText(APriceField, 'StartedPrice') then
  226. Result := 'SFormula'
  227. else if SameText(APriceField, 'RangePrice') then
  228. Result := 'RFormula'
  229. else if SameText(APriceField, 'CurTotalPrice') then
  230. Result := 'Formula'
  231. else if Pos('TotalPrice', APriceField) = 1 then
  232. Result := StringReplace(AValue.FieldName, 'TotalPrice', 'Formula', []);
  233. end;
  234. procedure GetStageEditText;
  235. var
  236. sField, sFormula: string;
  237. begin
  238. if Assigned(AValue) then
  239. begin
  240. Text := AValue.AsString;
  241. sField := GetFormulaField(AValue.FieldName);
  242. sFormula := AValue.Owner.ValueByName(sField).AsString;
  243. if (sField <> '') and (sFormula <> '') then
  244. Text:= sFormula;
  245. end
  246. else
  247. Text := '';
  248. end;
  249. procedure GetMainEditText;
  250. var
  251. sField, sFormula: string;
  252. begin
  253. sField := GetFormulaField(AColumn.FieldName);
  254. if (sField <> '') then
  255. begin
  256. sFormula := ARecord.ValueByName(sField).AsString;
  257. if (sFormula <> '') then
  258. Text := sFormula;
  259. end
  260. else
  261. Text := '';
  262. end;
  263. begin
  264. if Pos('Price', AColumn.FieldName)> 0 then
  265. begin
  266. if DisplayText then
  267. GetDisplayText
  268. else if TProjectData(FProjectData).PhaseIndex > 0 then
  269. GetStageEditText
  270. else
  271. GetMainEditText;
  272. end;
  273. end;
  274. procedure TDealPaymentData.sdvDealPaymentNeedLookupRecord(
  275. ARecord: TsdDataRecord; AColumn: TsdViewColumn; ANewText: String);
  276. procedure SetNewRecData(APayRec: TsdDataRecord);
  277. var
  278. AID: Integer;
  279. sTPField, sFField: string;
  280. fTotalPrice: Double;
  281. begin
  282. sTPField := 'TotalPrice' + IntToStr(TProjectData(FProjectData).PhaseData.StageIndex);
  283. sFField := 'Formula' + IntToStr(TProjectData(FProjectData).PhaseData.StageIndex);
  284. if CheckNumeric(ANewText) then
  285. APayRec.ValueByName(sTPField).AsString := ANewText
  286. else
  287. begin
  288. AID := ARecord.ValueByName('ID').AsInteger;
  289. APayRec.ValueByName(sFField).AsString := ANewText;
  290. ARecord.ValueByName('Formula').AsString := ANewText;
  291. fTotalPrice := FPayFormula.Calculate(ANewText);
  292. if CheckStartedPrice(AID) then
  293. APayRec.ValueByName(sTPField).AsFloat := GetAllowTotalPrice(AID, fTotalPrice);
  294. end;
  295. end;
  296. var
  297. NewRec: TsdDataRecord;
  298. begin
  299. if SameText(AColumn.FieldName, 'CurTotalPrice') then
  300. begin
  301. with TProjectData(FProjectData).PhaseData.PhasePayData do
  302. NewRec := AddPayRecord(ARecord.ValueByName('ID').AsInteger);
  303. SetNewRecData(NewRec);
  304. end;
  305. end;
  306. procedure TDealPaymentData.sdvDealPaymentSetText(var Text: string;
  307. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  308. var Allow: Boolean);
  309. procedure CheckLockedData;
  310. var
  311. Rec: TsdDataRecord;
  312. sFormula: string;
  313. begin
  314. Rec := sddDealPayment.FindKey('idxID', ARecord.ValueByName('ID').AsInteger);
  315. if Rec.ValueByName('CalcType').AsInteger = 1 then
  316. begin
  317. if SameText(AValue.FieldName, 'Name') or
  318. SameText(AValue.FieldName, 'IsMinus') or
  319. (Pos('TotalPrice', AValue.FieldName) > 0) or
  320. SameText(AValue.FieldName, 'StartedPrice') or
  321. SameText(AValue.FieldName, 'RangePrice') then
  322. DataSetErrorMessage(Allow, '固定项不可修改!');
  323. end;
  324. if not Allow then Exit;
  325. if Rec.ValueByName('LockedFormula').AsBoolean then
  326. begin
  327. if (Pos('TotalPrice', AValue.FieldName) = 1) and
  328. (Rec.ValueByName('Formula').AsString <> '') then
  329. begin
  330. // 如果有公式计算,如果是纯数学计算式,则可设置,基数计算,则不可
  331. sFormula := Rec.ValueByName('Formula').AsString;
  332. if (Pos('bqwc', sFormula)>0) or (Pos('htj', sFormula)>0) or
  333. (Pos('kgyfk', sFormula)>0) or (Pos('clyfk', sFormula)>0) then
  334. DataSetErrorMessage(Allow, '该支付(扣款)项已设置基数计算公式且被锁定,不可修改!');
  335. end;
  336. end;
  337. if not Allow then Exit;
  338. if Rec.ValueByName('Locked').AsBoolean then
  339. begin
  340. if SameText(AValue.FieldName, 'StartedPrice') then
  341. DataSetErrorMessage(Allow, '该支付(扣款)项的起扣金额被锁定,不可修改!')
  342. else if SameText(AValue.FieldName, 'RangePrice') then
  343. DataSetErrorMessage(Allow, '该支付(扣款)项的付(扣)款限额被锁定,不可修改!')
  344. else if SameText(AValue.FieldName, 'Name') or SameText(AValue.FieldName, 'IsMinus') then
  345. DataSetErrorMessage(Allow, '该项已被锁定,不可修改!');
  346. end;
  347. end;
  348. procedure DoStartedPriceChanged;
  349. begin
  350. if AValue.Owner.ValueByName('TotalPrice').AsFloat <> 0 then
  351. DataSetErrorMessage(Allow, '该付(扣)款金额已经计量,不可修改起扣金额!');
  352. if not Allow then Exit;
  353. if CheckStringNull(Text) or CheckNumeric(Text) then
  354. AValue.Owner.ValueByName('SFormula').AsString := ''
  355. else if Pos('bqwc', Text) = 0 then
  356. begin
  357. AValue.Owner.ValueByName('SFormula').AsString := Text;
  358. Text := FloatToStr(FPayFormula.Calculate(Text));
  359. end
  360. else
  361. DataSetErrorMessage(Allow, '起扣金额不可引用“本期计算价”进行计算!');
  362. end;
  363. procedure DoRangePriceChanged;
  364. begin
  365. if AValue.Owner.ValueByName('TotalPrice').AsFloat <> 0 then
  366. DataSetErrorMessage(Allow, '该付(扣)款金额已经计量,不可修改付(扣)款限额!');
  367. if not Allow then Exit;
  368. if CheckStringNull(Text) or CheckNumeric(Text) then
  369. AValue.Owner.ValueByName('RFormula').AsString := ''
  370. else if Pos('bqwc', Text) = 0 then
  371. begin
  372. AValue.Owner.ValueByName('RFormula').AsString := Text;
  373. Text := FloatToStr(FPayFormula.Calculate(Text));
  374. end
  375. else
  376. DataSetErrorMessage(Allow, '付(扣)款限额不可引用“本期计算价”进行计算!');
  377. end;
  378. procedure DoCurTotalPriceChanged;
  379. var
  380. AID: Integer;
  381. sFField: string;
  382. fTotalPrice: Double;
  383. Rec: TsdDataRecord;
  384. begin
  385. Rec := sddDealPayment.FindKey('idxID', ARecord.ValueByName('ID').AsInteger);
  386. sFField := StringReplace(AValue.FieldName, 'TotalPrice', 'Formula', []);
  387. if CheckStringNull(Text) or CheckNumeric(Text) then
  388. begin
  389. Rec.ValueByName('Formula').AsString := '';
  390. AValue.Owner.ValueByName(sFField).AsString := '';
  391. AID := ARecord.ValueByName('ID').AsInteger;
  392. fTotalPrice := StrToFloatDef(Text, 0) - AValue.AsFloat;
  393. if CheckStartedPrice(AID) then
  394. Text := FloatToStr(AValue.AsFloat + GetAllowTotalPrice(AID, fTotalPrice))
  395. else
  396. Text := '';
  397. end
  398. else
  399. begin
  400. Rec.ValueByName('Formula').AsString := Text;
  401. AValue.Owner.ValueByName(sFField).AsString := Text;
  402. AID := ARecord.ValueByName('ID').AsInteger;
  403. fTotalPrice := FPayFormula.Calculate(Text) - AValue.AsFloat;
  404. if CheckStartedPrice(AID) then
  405. Text := FloatToStr(AValue.AsFloat + GetAllowTotalPrice(AID, fTotalPrice))
  406. else
  407. Text := '';
  408. end;
  409. end;
  410. procedure DoLedgerFormulaChanged;
  411. begin
  412. if CheckStringNull(Text) or CheckNumeric(Text) then
  413. ARecord.ValueByName('Formula').AsString := ''
  414. else
  415. ARecord.ValueByName('Formula').AsString := Text;
  416. Text := '';
  417. end;
  418. begin
  419. if not Assigned(AValue) then Exit;
  420. CheckLockedData;
  421. if not Allow then Exit;
  422. if SameText('StartedPrice', AValue.FieldName) then
  423. DoStartedPriceChanged;
  424. if SameText('RangePrice', AValue.FieldName) then
  425. DoRangePriceChanged;
  426. if Pos('TotalPrice', AValue.FieldName) = 1 then
  427. if TProjectData(FProjectData).ProjProperties.PhaseCount > 0 then
  428. DoCurTotalPriceChanged
  429. else
  430. DoLedgerFormulaChanged;
  431. end;
  432. procedure TDealPaymentData.UpdateTotalPrice(AID: Integer;
  433. ATotalPrice: Double);
  434. var
  435. Rec: TsdDataRecord;
  436. begin
  437. Rec := sddDealPayment.FindKey('idxID', AID);
  438. Rec.ValueByName('TotalPrice').AsFloat := Rec.ValueByName('TotalPrice').AsFloat + ATotalPrice;
  439. end;
  440. procedure TDealPaymentData.sddDealPaymentBeforeAddRecord(
  441. ARecord: TsdDataRecord; var Allow: Boolean);
  442. begin
  443. { if ARecord.ValueByName('Name').AsString = '' then
  444. Allow := False;}
  445. end;
  446. procedure TDealPaymentData.CalcStarted_RangePrice;
  447. var
  448. I: Integer;
  449. Rec: TsdDataRecord;
  450. begin
  451. if TProjectData(FProjectData).ProjProperties.PhaseCount > 0 then Exit;
  452. for I := 0 to sddDealPayment.RecordCount - 1 do
  453. begin
  454. Rec := sddDealPayment.Records[I];
  455. if Rec.ValueByName('CalcType').AsInteger <> 0 then Continue;
  456. Rec.ValueByName('StartedPrice').AsFloat := FPayFormula.Calculate(Rec.ValueByName('SFormula').AsString);
  457. Rec.ValueByName('RangePrice').AsFloat := FPayFormula.Calculate(Rec.ValueByName('RFormula').AsString);
  458. end;
  459. end;
  460. procedure TDealPaymentData.sddDealPaymentAfterValueChanged(
  461. AValue: TsdValue);
  462. begin
  463. if SameText('IsMinus', AValue.FieldName) then
  464. TProjectData(FProjectData).PhaseData.PhasePayData.CalculateCurPay;
  465. end;
  466. function TDealPaymentData.GetAddTotalPrice: Double;
  467. var
  468. iIndex: Integer;
  469. Rec: TsdDataRecord;
  470. begin
  471. Result := 0;
  472. for iIndex := 0 to sddDealPayment.RecordCount - 1 do
  473. begin
  474. Rec := sddDealPayment.Records[iIndex];
  475. if (Rec.ValueByName('CalcType').AsInteger = 0) and not Rec.ValueByName('IsMinus').AsBoolean then
  476. Result := Result + Rec.ValueByName('TotalPrice').AsFloat;
  477. end;
  478. end;
  479. function TDealPaymentData.GetCutTotalPrice: Double;
  480. var
  481. iIndex: Integer;
  482. Rec: TsdDataRecord;
  483. begin
  484. Result := 0;
  485. for iIndex := 0 to sddDealPayment.RecordCount - 1 do
  486. begin
  487. Rec := sddDealPayment.Records[iIndex];
  488. if (Rec.ValueByName('CalcType').AsInteger = 0) and Rec.ValueByName('IsMinus').AsBoolean then
  489. Result := Result + Rec.ValueByName('TotalPrice').AsFloat;
  490. end;
  491. end;
  492. function TDealPaymentData.GetPaidTotalPrice: Double;
  493. var
  494. Rec: TsdDataRecord;
  495. begin
  496. Rec := sddDealPayment.Locate('CalcType', 2);
  497. if Assigned(Rec) then
  498. Result := Rec.ValueByName('TotalPrice').AsFloat
  499. else
  500. Result := 0;
  501. end;
  502. procedure TDealPaymentData.sddDealPaymentBeforeDeleteRecord(
  503. ARecord: TsdDataRecord; var Allow: Boolean);
  504. begin
  505. if ARecord.ValueByName('Locked').AsBoolean then
  506. DataSetErrorMessage(Allow, '该支付(扣款)项已锁定,不可删除!')
  507. else if ARecord.ValueByName('PreDefined').AsBoolean then
  508. DataSetErrorMessage(Allow, '此项为预定义项,不允许删除!')
  509. else if ARecord.ValueByName('TotalPrice').AsFloat <> 0 then
  510. DataSetErrorMessage(Allow, '该支付(扣款)项存在数据,如需删除请先清除本期金额!');
  511. if Allow and TProjectData(FProjectData).PhaseData.Active then
  512. TProjectData(FProjectData).PhaseData.PhasePayData.Delete(ARecord.ValueByName('ID').AsInteger);
  513. end;
  514. procedure TDealPaymentData.Close;
  515. begin
  516. sddDealPayment.Close;
  517. end;
  518. procedure TDealPaymentData.RepairSerialNo;
  519. var
  520. Rec: TsdDataRecord;
  521. iRec: Integer;
  522. begin
  523. if sddDealPayment.RecordCount = 0 then Exit;
  524. Rec := sddDealPayment.Records[0];
  525. if Rec.ValueByName('SerialNo').AsString = '' then
  526. begin
  527. for iRec := 0 to sddDealPayment.RecordCount - 1 do
  528. begin
  529. Rec := sddDealPayment.Records[iRec];
  530. Rec.ValueByName('SerialNo').AsInteger := iRec;
  531. end;
  532. end;
  533. end;
  534. function TDealPaymentData.GetNewSerialNo: Integer;
  535. var
  536. idx: TsdIndex;
  537. begin
  538. idx := sddDealPayment.FindIndex('idxView');
  539. if idx.RecordCount > 0 then
  540. Result := idx.Records[idx.RecordCount - 1].ValueByName('SerialNo').AsInteger + 1
  541. else
  542. Result := 1;
  543. end;
  544. procedure TDealPaymentData.RepairLockedFormula;
  545. function CheckHasRepair: Boolean;
  546. var
  547. iRec: Integer;
  548. Rec: TsdDataRecord;
  549. begin
  550. Result := True;
  551. for iRec := 0 to sddDealPayment.RecordCount - 1 do
  552. begin
  553. Rec := sddDealPayment.Records[iRec];
  554. if Rec.ValueByName('Locked').AsBoolean and
  555. (Rec.ValueByName('Formula').AsString <> '') and (Rec.ValueByName('LockedFormula').AsBoolean) then
  556. begin
  557. Result := False;
  558. Break;
  559. end;
  560. end;
  561. end;
  562. var
  563. iRec: Integer;
  564. Rec: TsdDataRecord;
  565. begin
  566. if sddDealPayment.RecordCount = 0 then Exit;
  567. if CheckHasRepair then
  568. begin
  569. for iRec := 0 to sddDealPayment.RecordCount - 1 do
  570. begin
  571. Rec := sddDealPayment.Records[iRec];
  572. if Rec.ValueByName('Locked').AsBoolean and (Rec.ValueByName('Formula').AsString <> '') then
  573. Rec.ValueByName('LockedFormula').AsBoolean := True;
  574. end;
  575. end;
  576. end;
  577. function TDealPaymentData.GetStartedPrice(AID: Integer): Double;
  578. var
  579. Rec: TsdDataRecord;
  580. begin
  581. Rec := sddDealPayment.FindKey('idxID', AID);
  582. Result := Rec.ValueByName('StartedPrice').AsFloat;
  583. end;
  584. function TDealPaymentData.CheckReachPlan(ARec: TsdDataRecord): Boolean;
  585. var
  586. fCurValue, fDeadlineValue: Double;
  587. begin
  588. Result := False;
  589. if ARec.ValueByName('PlanType').AsInteger <> 0 then
  590. begin
  591. if ARec.ValueByName('PlanType').AsInteger = 1 then
  592. fCurValue := TProjectData(FProjectData).ProjProperties.PhaseCount
  593. else if ARec.ValueByName('PlanSubType').AsInteger = 0 then
  594. fCurValue := TProjectData(FProjectData).BillsData.Settlement[4]
  595. else if ARec.ValueByName('PlanSubType').AsInteger = 1 then
  596. fCurValue := TProjectData(FProjectData).BillsData.Settlement[1]
  597. else if ARec.ValueByName('PlanSubType').AsInteger = 2 then
  598. fCurValue := TProjectData(FProjectData).BillsData.Settlement[2];
  599. fDeadlineValue := ARec.ValueByName('PlanDeadline').AsFloat;
  600. Result := fCurValue >= fDeadlineValue;
  601. end;
  602. end;
  603. function TDealPaymentData.PlanStr(ARec: TsdDataRecord): string;
  604. begin
  605. if ARec.ValueByName('PlanType').AsInteger = 0 then
  606. Result := '无'
  607. else if ARec.ValueByName('PlanType').AsInteger = 1 then
  608. Result := Format('计量期数 >= %d', [ARec.ValueByName('PlanDeadline').AsInteger])
  609. else if ARec.ValueByName('PlanSubType').AsInteger = 0 then
  610. Result := Format('累计完成计量金额 >= %f', [ARec.ValueByName('PlanDeadline').AsFloat])
  611. else if ARec.ValueByName('PlanSubType').AsInteger = 1 then
  612. Result := Format('累计合同计量金额 >= %f', [ARec.ValueByName('PlanDeadline').AsFloat])
  613. else if ARec.ValueByName('PlanSubType').AsInteger = 2 then
  614. Result := Format('累计变更计量金额 >= %f', [ARec.ValueByName('PlanDeadline').AsFloat])
  615. end;
  616. procedure TDealPaymentData.UpdateLinkSerialNo;
  617. var
  618. iPay, iCut, iIndex: Integer;
  619. Rec: TsdDataRecord;
  620. begin
  621. iPay := 1;
  622. iCut := 1;
  623. for iIndex := 0 to sdvDealPayment.RecordCount - 1 do
  624. begin
  625. Rec := sdvDealPayment.Records[iIndex];
  626. if Rec.ValueByName('CalcType').AsInteger = 0 then
  627. begin
  628. if Rec.ValueByName('IsMinus').AsBoolean then
  629. begin
  630. Rec.ValueByName('LinkSerialNo').AsInteger := iCut;
  631. Inc(iCut);
  632. end
  633. else
  634. begin
  635. Rec.ValueByName('LinkSerialNo').AsInteger := iPay;
  636. Inc(iPay);
  637. end;
  638. end;
  639. end;
  640. end;
  641. end.