DealPaymentDm.pas 24 KB

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