DealPaymentDm.pas 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738
  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, ARecord.ValueByName('StartedPrice').AsFloat);
  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. if ARecord.ValueByName('Pre' + AValue.FieldName).AsFloat = 0 then
  405. fTotalPrice := FPayFormula.Calculate(Text, Rec.ValueByName('StartedPrice').AsFloat) - AValue.AsFloat
  406. else
  407. fTotalPrice := FPayFormula.Calculate(Text) - AValue.AsFloat;
  408. if CheckStartedPrice(AID) then
  409. Text := FloatToStr(AValue.AsFloat + GetAllowTotalPrice(AID, fTotalPrice))
  410. else
  411. Text := '';
  412. end;
  413. end;
  414. procedure DoLedgerFormulaChanged;
  415. begin
  416. if CheckStringNull(Text) or CheckNumeric(Text) then
  417. ARecord.ValueByName('Formula').AsString := ''
  418. else
  419. ARecord.ValueByName('Formula').AsString := Text;
  420. Text := '';
  421. end;
  422. begin
  423. if not Assigned(AValue) then Exit;
  424. CheckLockedData;
  425. if not Allow then Exit;
  426. if SameText('StartedPrice', AValue.FieldName) then
  427. DoStartedPriceChanged;
  428. if SameText('RangePrice', AValue.FieldName) then
  429. DoRangePriceChanged;
  430. if Pos('TotalPrice', AValue.FieldName) = 1 then
  431. if TProjectData(FProjectData).ProjProperties.PhaseCount > 0 then
  432. DoCurTotalPriceChanged
  433. else
  434. DoLedgerFormulaChanged;
  435. end;
  436. procedure TDealPaymentData.UpdateTotalPrice(AID: Integer;
  437. ATotalPrice: Double);
  438. var
  439. Rec: TsdDataRecord;
  440. begin
  441. Rec := sddDealPayment.FindKey('idxID', AID);
  442. Rec.ValueByName('TotalPrice').AsFloat := Rec.ValueByName('TotalPrice').AsFloat + ATotalPrice;
  443. end;
  444. procedure TDealPaymentData.sddDealPaymentBeforeAddRecord(
  445. ARecord: TsdDataRecord; var Allow: Boolean);
  446. begin
  447. { if ARecord.ValueByName('Name').AsString = '' then
  448. Allow := False;}
  449. end;
  450. procedure TDealPaymentData.CalcStarted_RangePrice;
  451. var
  452. I: Integer;
  453. Rec: TsdDataRecord;
  454. begin
  455. if TProjectData(FProjectData).ProjProperties.PhaseCount > 0 then Exit;
  456. for I := 0 to sddDealPayment.RecordCount - 1 do
  457. begin
  458. Rec := sddDealPayment.Records[I];
  459. if Rec.ValueByName('CalcType').AsInteger <> 0 then Continue;
  460. Rec.ValueByName('StartedPrice').AsFloat := FPayFormula.Calculate(Rec.ValueByName('SFormula').AsString);
  461. Rec.ValueByName('RangePrice').AsFloat := FPayFormula.Calculate(Rec.ValueByName('RFormula').AsString);
  462. end;
  463. end;
  464. procedure TDealPaymentData.sddDealPaymentAfterValueChanged(
  465. AValue: TsdValue);
  466. begin
  467. if SameText('IsMinus', AValue.FieldName) then
  468. TProjectData(FProjectData).PhaseData.PhasePayData.CalculateCurPay;
  469. end;
  470. function TDealPaymentData.GetAddTotalPrice: Double;
  471. var
  472. iIndex: Integer;
  473. Rec: TsdDataRecord;
  474. begin
  475. Result := 0;
  476. for iIndex := 0 to sddDealPayment.RecordCount - 1 do
  477. begin
  478. Rec := sddDealPayment.Records[iIndex];
  479. if (Rec.ValueByName('CalcType').AsInteger = 0) and not Rec.ValueByName('IsMinus').AsBoolean then
  480. Result := Result + Rec.ValueByName('TotalPrice').AsFloat;
  481. end;
  482. end;
  483. function TDealPaymentData.GetCutTotalPrice: Double;
  484. var
  485. iIndex: Integer;
  486. Rec: TsdDataRecord;
  487. begin
  488. Result := 0;
  489. for iIndex := 0 to sddDealPayment.RecordCount - 1 do
  490. begin
  491. Rec := sddDealPayment.Records[iIndex];
  492. if (Rec.ValueByName('CalcType').AsInteger = 0) and Rec.ValueByName('IsMinus').AsBoolean then
  493. Result := Result + Rec.ValueByName('TotalPrice').AsFloat;
  494. end;
  495. end;
  496. function TDealPaymentData.GetPaidTotalPrice: Double;
  497. var
  498. Rec: TsdDataRecord;
  499. begin
  500. Rec := sddDealPayment.Locate('CalcType', 2);
  501. if Assigned(Rec) then
  502. Result := Rec.ValueByName('TotalPrice').AsFloat
  503. else
  504. Result := 0;
  505. end;
  506. procedure TDealPaymentData.sddDealPaymentBeforeDeleteRecord(
  507. ARecord: TsdDataRecord; var Allow: Boolean);
  508. begin
  509. if ARecord.ValueByName('Locked').AsBoolean then
  510. DataSetErrorMessage(Allow, '该支付(扣款)项已锁定,不可删除!')
  511. else if ARecord.ValueByName('PreDefined').AsBoolean then
  512. DataSetErrorMessage(Allow, '此项为预定义项,不允许删除!')
  513. else if ARecord.ValueByName('TotalPrice').AsFloat <> 0 then
  514. DataSetErrorMessage(Allow, '该支付(扣款)项存在数据,如需删除请先清除本期金额!');
  515. if Allow and TProjectData(FProjectData).PhaseData.Active then
  516. TProjectData(FProjectData).PhaseData.PhasePayData.Delete(ARecord.ValueByName('ID').AsInteger);
  517. end;
  518. procedure TDealPaymentData.Close;
  519. begin
  520. sddDealPayment.Close;
  521. end;
  522. procedure TDealPaymentData.RepairSerialNo;
  523. var
  524. Rec: TsdDataRecord;
  525. iRec: Integer;
  526. begin
  527. if sddDealPayment.RecordCount = 0 then Exit;
  528. Rec := sddDealPayment.Records[0];
  529. if Rec.ValueByName('SerialNo').AsString = '' then
  530. begin
  531. for iRec := 0 to sddDealPayment.RecordCount - 1 do
  532. begin
  533. Rec := sddDealPayment.Records[iRec];
  534. Rec.ValueByName('SerialNo').AsInteger := iRec;
  535. end;
  536. end;
  537. end;
  538. function TDealPaymentData.GetNewSerialNo: Integer;
  539. var
  540. idx: TsdIndex;
  541. begin
  542. idx := sddDealPayment.FindIndex('idxView');
  543. if idx.RecordCount > 0 then
  544. Result := idx.Records[idx.RecordCount - 1].ValueByName('SerialNo').AsInteger + 1
  545. else
  546. Result := 1;
  547. end;
  548. procedure TDealPaymentData.RepairLockedFormula;
  549. function CheckHasRepair: Boolean;
  550. var
  551. iRec: Integer;
  552. Rec: TsdDataRecord;
  553. begin
  554. Result := True;
  555. for iRec := 0 to sddDealPayment.RecordCount - 1 do
  556. begin
  557. Rec := sddDealPayment.Records[iRec];
  558. if Rec.ValueByName('Locked').AsBoolean and
  559. (Rec.ValueByName('Formula').AsString <> '') and (Rec.ValueByName('LockedFormula').AsBoolean) then
  560. begin
  561. Result := False;
  562. Break;
  563. end;
  564. end;
  565. end;
  566. var
  567. iRec: Integer;
  568. Rec: TsdDataRecord;
  569. begin
  570. if sddDealPayment.RecordCount = 0 then Exit;
  571. if CheckHasRepair then
  572. begin
  573. for iRec := 0 to sddDealPayment.RecordCount - 1 do
  574. begin
  575. Rec := sddDealPayment.Records[iRec];
  576. if Rec.ValueByName('Locked').AsBoolean and (Rec.ValueByName('Formula').AsString <> '') then
  577. Rec.ValueByName('LockedFormula').AsBoolean := True;
  578. end;
  579. end;
  580. end;
  581. function TDealPaymentData.GetStartedPrice(AID: Integer): Double;
  582. var
  583. Rec: TsdDataRecord;
  584. begin
  585. Rec := sddDealPayment.FindKey('idxID', AID);
  586. Result := Rec.ValueByName('StartedPrice').AsFloat;
  587. end;
  588. function TDealPaymentData.CheckReachPlan(ARec: TsdDataRecord): Boolean;
  589. var
  590. fCurValue, fDeadlineValue: Double;
  591. begin
  592. Result := False;
  593. if ARec.ValueByName('PlanType').AsInteger <> 0 then
  594. begin
  595. if ARec.ValueByName('PlanType').AsInteger = 1 then
  596. fCurValue := TProjectData(FProjectData).ProjProperties.PhaseCount
  597. else if ARec.ValueByName('PlanSubType').AsInteger = 0 then
  598. fCurValue := TProjectData(FProjectData).BillsData.Settlement[4]
  599. else if ARec.ValueByName('PlanSubType').AsInteger = 1 then
  600. fCurValue := TProjectData(FProjectData).BillsData.Settlement[1]
  601. else if ARec.ValueByName('PlanSubType').AsInteger = 2 then
  602. fCurValue := TProjectData(FProjectData).BillsData.Settlement[2];
  603. fDeadlineValue := ARec.ValueByName('PlanDeadline').AsFloat;
  604. Result := fCurValue >= fDeadlineValue;
  605. end;
  606. end;
  607. function TDealPaymentData.PlanStr(ARec: TsdDataRecord): string;
  608. begin
  609. if ARec.ValueByName('PlanType').AsInteger = 0 then
  610. Result := '无'
  611. else if ARec.ValueByName('PlanType').AsInteger = 1 then
  612. Result := Format('计量期数 >= %d', [ARec.ValueByName('PlanDeadline').AsInteger])
  613. else if ARec.ValueByName('PlanSubType').AsInteger = 0 then
  614. Result := Format('累计完成计量金额 >= %f', [ARec.ValueByName('PlanDeadline').AsFloat])
  615. else if ARec.ValueByName('PlanSubType').AsInteger = 1 then
  616. Result := Format('累计合同计量金额 >= %f', [ARec.ValueByName('PlanDeadline').AsFloat])
  617. else if ARec.ValueByName('PlanSubType').AsInteger = 2 then
  618. Result := Format('累计变更计量金额 >= %f', [ARec.ValueByName('PlanDeadline').AsFloat]);
  619. end;
  620. procedure TDealPaymentData.UpdateLinkSerialNo;
  621. var
  622. iPay, iCut, iIndex: Integer;
  623. Rec: TsdDataRecord;
  624. begin
  625. iPay := 1;
  626. iCut := 1;
  627. for iIndex := 0 to sdvDealPayment.RecordCount - 1 do
  628. begin
  629. Rec := sdvDealPayment.Records[iIndex];
  630. if Rec.ValueByName('CalcType').AsInteger = 0 then
  631. begin
  632. if Rec.ValueByName('IsMinus').AsBoolean then
  633. begin
  634. Rec.ValueByName('LinkSerialNo').AsInteger := iCut;
  635. Inc(iCut);
  636. end
  637. else
  638. begin
  639. Rec.ValueByName('LinkSerialNo').AsInteger := iPay;
  640. Inc(iPay);
  641. end;
  642. end;
  643. end;
  644. end;
  645. function TDealPaymentData.DealPayRecord(
  646. const AName: string): TsdDataRecord;
  647. var
  648. iRec: Integer;
  649. Rec: TsdDataRecord;
  650. begin
  651. Result := nil;
  652. for iRec := 0 to sddDealPayment.RecordCount - 1 do
  653. begin
  654. Rec := sddDealPayment.Records[iRec];
  655. if SameText(AName, Rec.ValueByName('Name').AsString) then
  656. begin
  657. Result := Rec;
  658. Break;
  659. end;
  660. end;
  661. end;
  662. end.