DealPaymentDm.pas 25 KB

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