DealPaymentDm.pas 22 KB

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