DealPaymentDm.pas 24 KB

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