DealPaymentDm.pas 24 KB

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