DealPaymentDm.pas 24 KB

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