DealPaymentDm.pas 21 KB

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