DealPaymentDm.pas 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798
  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. end;
  206. end;
  207. procedure TDealPaymentData.Save;
  208. begin
  209. sddDealPayment.Save;
  210. end;
  211. procedure TDealPaymentData.sddDealPaymentAfterAddRecord(
  212. ARecord: TsdDataRecord);
  213. var
  214. iSerialNo: Integer;
  215. begin
  216. iSerialNo := GetNewSerialNo;
  217. ARecord.ValueByName('ID').AsInteger := GetNewID;
  218. ARecord.ValueByName('SerialNo').AsInteger := iSerialNo;
  219. ARecord.ValueByName('CreatePhaseID').AsInteger := TProjectData(FProjectData).PhaseIndex;
  220. end;
  221. procedure TDealPaymentData.sdvDealPaymentGetText(var Text: String;
  222. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  223. DisplayText: Boolean);
  224. procedure GetDisplayText;
  225. begin
  226. if not Assigned(AValue) or
  227. ((Pos('Price', AValue.FieldName) > 0) and (AValue.AsFloat = 0)) then
  228. Text := '';
  229. end;
  230. function GetFormulaField(const APriceField: string): string;
  231. begin
  232. if SameText(APriceField, 'StartedPrice') then
  233. Result := 'SFormula'
  234. else if SameText(APriceField, 'RangePrice') then
  235. Result := 'RFormula'
  236. else if SameText(APriceField, 'CurTotalPrice') then
  237. Result := 'Formula'
  238. else if Pos('TotalPrice', APriceField) = 1 then
  239. Result := StringReplace(AValue.FieldName, 'TotalPrice', 'Formula', []);
  240. end;
  241. procedure GetStageEditText;
  242. var
  243. sField, sFormula: string;
  244. begin
  245. if Assigned(AValue) then
  246. begin
  247. sField := GetFormulaField(AValue.FieldName);
  248. sFormula := AValue.Owner.ValueByName(sField).AsString;
  249. if (sField <> '') and (sFormula <> '') then
  250. Text:= sFormula;
  251. end
  252. else
  253. Text := '';
  254. end;
  255. procedure GetMainEditText;
  256. var
  257. sField, sFormula: string;
  258. begin
  259. sField := GetFormulaField(AColumn.FieldName);
  260. if (sField <> '') then
  261. begin
  262. sFormula := ARecord.ValueByName(sField).AsString;
  263. if (sFormula <> '') then
  264. Text := sFormula;
  265. end
  266. else
  267. Text := '';
  268. end;
  269. begin
  270. if Pos('Price', AColumn.FieldName)> 0 then
  271. begin
  272. if DisplayText then
  273. GetDisplayText
  274. else if TProjectData(FProjectData).PhaseIndex > 0 then
  275. GetStageEditText
  276. else
  277. GetMainEditText;
  278. end;
  279. end;
  280. procedure TDealPaymentData.sdvDealPaymentNeedLookupRecord(
  281. ARecord: TsdDataRecord; AColumn: TsdViewColumn; ANewText: String);
  282. procedure SetNewRecData(APayRec: TsdDataRecord);
  283. var
  284. iID: Integer;
  285. sTPField, sFField: string;
  286. fTotalPrice, fAllow: Double;
  287. begin
  288. sTPField := 'TotalPrice' + IntToStr(TProjectData(FProjectData).PhaseData.StageIndex);
  289. sFField := 'Formula' + IntToStr(TProjectData(FProjectData).PhaseData.StageIndex);
  290. if CheckNumeric(ANewText) then
  291. begin
  292. APayRec.ValueByName(sFField).AsString := ANewText;
  293. fTotalPrice := StrToFloat(ANewText);
  294. end
  295. else
  296. begin
  297. APayRec.ValueByName(sFField).AsString := ANewText;
  298. ARecord.ValueByName('Formula').AsString := ANewText;
  299. fTotalPrice := FPayFormula.Calculate(ANewText, ARecord.ValueByName('StartedPrice').AsFloat);
  300. end;
  301. iID := ARecord.ValueByName('ID').AsInteger;
  302. if CheckStartedPrice(iID) then
  303. begin
  304. fAllow := GetAllowTotalPrice(iID, fTotalPrice, 0);
  305. APayRec.ValueByName(sTPField).AsFloat := fAllow;
  306. if fAllow < fTotalPrice then
  307. TipMessage(Format('“%s”已达扣款限额,本期金额计%s。', [ARecord.ValueByName('Name').AsString, FloatToStr(fAllow)]))
  308. else if fAllow > fTotalPrice then
  309. TipMessage(Format('“%s”已达计提期限,本期金额计%s。', [ARecord.ValueByName('Name').AsString, FloatToStr(fAllow)]));
  310. end
  311. else
  312. TipMessage(Format('“%s”未达到起扣金额,本期金额计零。', [ARecord.ValueByName('Name').AsString]));
  313. end;
  314. var
  315. NewRec: TsdDataRecord;
  316. begin
  317. if SameText(AColumn.FieldName, 'CurTotalPrice') then
  318. begin
  319. with TProjectData(FProjectData).PhaseData.PhasePayData do
  320. NewRec := AddPayRecord(ARecord.ValueByName('ID').AsInteger);
  321. SetNewRecData(NewRec);
  322. end;
  323. end;
  324. procedure TDealPaymentData.sdvDealPaymentSetText(var Text: string;
  325. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  326. var Allow: Boolean);
  327. procedure CheckLockedData;
  328. var
  329. Rec: TsdDataRecord;
  330. sFormula: string;
  331. begin
  332. Rec := ARecord;//sddDealPayment.FindKey('idxID', ARecord.ValueByName('ID').AsInteger);
  333. if Rec.ValueByName('CalcType').AsInteger = 1 then
  334. begin
  335. if SameText(AValue.FieldName, 'Name') or
  336. SameText(AValue.FieldName, 'IsMinus') or
  337. (Pos('TotalPrice', AValue.FieldName) > 0) or
  338. SameText(AValue.FieldName, 'StartedPrice') or
  339. SameText(AValue.FieldName, 'RangePrice') then
  340. DataSetErrorMessage(Allow, '固定项不可修改!');
  341. end;
  342. if not Allow then Exit;
  343. if Rec.ValueByName('LockedFormula').AsBoolean then
  344. begin
  345. if (Pos('TotalPrice', AValue.FieldName) = 1) and
  346. (Rec.ValueByName('Formula').AsString <> '') then
  347. begin
  348. // 如果有公式计算,如果是纯数学计算式,则可设置,基数计算,则不可
  349. sFormula := Rec.ValueByName('Formula').AsString;
  350. if (Pos('bqwc', sFormula)>0) or (Pos('htj', sFormula)>0) or
  351. (Pos('kgyfk', sFormula)>0) or (Pos('clyfk', sFormula)>0) then
  352. DataSetErrorMessage(Allow, '该支付(扣款)项已设置基数计算公式且被锁定,不可修改!');
  353. end;
  354. end;
  355. if not Allow then Exit;
  356. if Rec.ValueByName('Locked').AsBoolean then
  357. begin
  358. if SameText(AValue.FieldName, 'StartedPrice') then
  359. DataSetErrorMessage(Allow, '该支付(扣款)项的起扣金额被锁定,不可修改!')
  360. else if SameText(AValue.FieldName, 'RangePrice') then
  361. DataSetErrorMessage(Allow, '该支付(扣款)项的付(扣)款限额被锁定,不可修改!')
  362. else if SameText(AValue.FieldName, 'Name') or SameText(AValue.FieldName, 'IsMinus') then
  363. DataSetErrorMessage(Allow, '该项已被锁定,不可修改!');
  364. end;
  365. end;
  366. procedure DoStartedPriceChanged;
  367. begin
  368. if AValue.Owner.ValueByName('TotalPrice').AsFloat <> 0 then
  369. DataSetErrorMessage(Allow, '该付(扣)款金额已经计量,不可修改起扣金额!');
  370. if not Allow then Exit;
  371. if CheckStringNull(Text) or CheckNumeric(Text) then
  372. AValue.Owner.ValueByName('SFormula').AsString := ''
  373. else if Pos('bqwc', Text) = 0 then
  374. begin
  375. AValue.Owner.ValueByName('SFormula').AsString := Text;
  376. Text := FloatToStr(FPayFormula.Calculate(Text));
  377. end
  378. else
  379. DataSetErrorMessage(Allow, '起扣金额不可引用“本期计算价”进行计算!');
  380. end;
  381. procedure DoRangePriceChanged;
  382. begin
  383. if AValue.Owner.ValueByName('TotalPrice').AsFloat <> 0 then
  384. DataSetErrorMessage(Allow, '该付(扣)款金额已经计量,不可修改付(扣)款限额!');
  385. if not Allow then Exit;
  386. if CheckStringNull(Text) or CheckNumeric(Text) then
  387. AValue.Owner.ValueByName('RFormula').AsString := ''
  388. else if Pos('bqwc', Text) = 0 then
  389. begin
  390. AValue.Owner.ValueByName('RFormula').AsString := Text;
  391. Text := FloatToStr(FPayFormula.Calculate(Text));
  392. end
  393. else
  394. DataSetErrorMessage(Allow, '付(扣)款限额不可引用“本期计算价”进行计算!');
  395. end;
  396. procedure DoCurTotalPriceChanged;
  397. var
  398. iID: Integer;
  399. sFField, sPreField: string;
  400. fTotalPrice, fAllow: Double;
  401. Rec: TsdDataRecord;
  402. begin
  403. Rec := ARecord;//sddDealPayment.FindKey('idxID', ARecord.ValueByName('ID').AsInteger);
  404. sFField := StringReplace(AValue.FieldName, 'TotalPrice', 'Formula', []);
  405. if CheckStringNull(Text) or CheckNumeric(Text) then
  406. begin
  407. Rec.ValueByName('Formula').AsString := '';
  408. AValue.Owner.ValueByName(sFField).AsString := Text;
  409. fTotalPrice := StrToFloatDef(Text, 0);
  410. end
  411. else
  412. begin
  413. Rec.ValueByName('Formula').AsString := Text;
  414. AValue.Owner.ValueByName(sFField).AsString := Text;
  415. if AValue.Owner.ValueByName('Pre' + AValue.FieldName).AsFloat = 0 then
  416. fTotalPrice := FPayFormula.Calculate(Text, Rec.ValueByName('StartedPrice').AsFloat)
  417. else
  418. fTotalPrice := FPayFormula.Calculate(Text);
  419. end;
  420. if AValue.Owner.ValueByName('StopCalc').AsBoolean then
  421. begin
  422. fTotalPrice := 0;
  423. Text := '';
  424. end
  425. else
  426. begin
  427. iID := ARecord.ValueByName('ID').AsInteger;
  428. if CheckStartedPrice(iID) then
  429. begin
  430. sPreField := StringReplace(AValue.FieldName, 'TotalPrice', 'PreTotalPrice', []);
  431. fAllow := GetAllowTotalPrice(iID, fTotalPrice, AValue.Owner.ValueByName(sPreField).AsFloat);
  432. Text := FloatToStr(fAllow);
  433. if fAllow < fTotalPrice then
  434. TipMessage(Format('“%s”已达扣款限额,本期金额计%s。', [Rec.ValueByName('Name').AsString, Text]))
  435. else if fAllow > fTotalPrice then
  436. TipMessage(Format('“%s”已达计提期限,本期金额计%s。', [Rec.ValueByName('Name').AsString, Text]));
  437. end
  438. else
  439. begin
  440. Text := '';
  441. TipMessage(Format('“%s”未达到起扣金额,本期金额计零。', [Rec.ValueByName('Name').AsString]));
  442. end;
  443. end;
  444. end;
  445. procedure DoLedgerFormulaChanged;
  446. begin
  447. if CheckStringNull(Text) or CheckNumeric(Text) then
  448. ARecord.ValueByName('Formula').AsString := ''
  449. else
  450. ARecord.ValueByName('Formula').AsString := Text;
  451. Text := '';
  452. end;
  453. begin
  454. if not Assigned(AValue) then Exit;
  455. Text := Trim(Text);
  456. if SameText('Name', AValue.FieldName) and (Text = '') then
  457. begin
  458. ErrorMessage('合同支付项名称不允许为空,如需删除,请点击右键进行删除');
  459. Allow := False;
  460. Exit;
  461. end;
  462. CheckLockedData;
  463. if not Allow then Exit;
  464. if SameText('StartedPrice', AValue.FieldName) then
  465. DoStartedPriceChanged;
  466. if SameText('RangePrice', AValue.FieldName) then
  467. DoRangePriceChanged;
  468. if SameText('CurTotalPrice', AColumn.FieldName) then
  469. if TProjectData(FProjectData).ProjProperties.PhaseCount > 0 then
  470. DoCurTotalPriceChanged
  471. else
  472. DoLedgerFormulaChanged;
  473. end;
  474. procedure TDealPaymentData.UpdateTotalPrice(AID: Integer;
  475. ATotalPrice: Double);
  476. var
  477. Rec: TsdDataRecord;
  478. begin
  479. Rec := sddDealPayment.FindKey('idxID', AID);
  480. Rec.ValueByName('TotalPrice').AsFloat := Rec.ValueByName('TotalPrice').AsFloat + ATotalPrice;
  481. end;
  482. procedure TDealPaymentData.sddDealPaymentBeforeAddRecord(
  483. ARecord: TsdDataRecord; var Allow: Boolean);
  484. begin
  485. { if ARecord.ValueByName('Name').AsString = '' then
  486. Allow := False;}
  487. end;
  488. procedure TDealPaymentData.CalcStarted_RangePrice;
  489. var
  490. I: Integer;
  491. Rec: TsdDataRecord;
  492. begin
  493. with TProjectData(FProjectData).ProjProperties do
  494. if (PhaseCount > 1) or ((PhaseCount = 1) and (AuditStatus <> 0)) then Exit;
  495. for I := 0 to sddDealPayment.RecordCount - 1 do
  496. begin
  497. Rec := sddDealPayment.Records[I];
  498. if Rec.ValueByName('CalcType').AsInteger <> 0 then Continue;
  499. if Rec.ValueByName('SFormula').AsString <> '' then
  500. Rec.ValueByName('StartedPrice').AsFloat := FPayFormula.Calculate(Rec.ValueByName('SFormula').AsString);
  501. if Rec.ValueByName('RFormula').AsString <> '' then
  502. Rec.ValueByName('RangePrice').AsFloat := FPayFormula.Calculate(Rec.ValueByName('RFormula').AsString);
  503. end;
  504. end;
  505. procedure TDealPaymentData.sddDealPaymentAfterValueChanged(
  506. AValue: TsdValue);
  507. begin
  508. if SameText('IsMinus', AValue.FieldName) then
  509. TProjectData(FProjectData).PhaseData.PhasePayData.CalculateCurPay;
  510. end;
  511. function TDealPaymentData.GetAddTotalPrice: Double;
  512. var
  513. iIndex: Integer;
  514. Rec: TsdDataRecord;
  515. begin
  516. Result := 0;
  517. for iIndex := 0 to sddDealPayment.RecordCount - 1 do
  518. begin
  519. Rec := sddDealPayment.Records[iIndex];
  520. if (Rec.ValueByName('CalcType').AsInteger = 0) and not Rec.ValueByName('IsMinus').AsBoolean then
  521. Result := Result + Rec.ValueByName('TotalPrice').AsFloat;
  522. end;
  523. end;
  524. function TDealPaymentData.GetCutTotalPrice: Double;
  525. var
  526. iIndex: Integer;
  527. Rec: TsdDataRecord;
  528. begin
  529. Result := 0;
  530. for iIndex := 0 to sddDealPayment.RecordCount - 1 do
  531. begin
  532. Rec := sddDealPayment.Records[iIndex];
  533. if (Rec.ValueByName('CalcType').AsInteger = 0) and Rec.ValueByName('IsMinus').AsBoolean then
  534. Result := Result + Rec.ValueByName('TotalPrice').AsFloat;
  535. end;
  536. end;
  537. function TDealPaymentData.GetPaidTotalPrice: Double;
  538. var
  539. Rec: TsdDataRecord;
  540. begin
  541. Rec := sddDealPayment.Locate('CalcType', 2);
  542. if Assigned(Rec) then
  543. Result := Rec.ValueByName('TotalPrice').AsFloat
  544. else
  545. Result := 0;
  546. end;
  547. procedure TDealPaymentData.sddDealPaymentBeforeDeleteRecord(
  548. ARecord: TsdDataRecord; var Allow: Boolean);
  549. begin
  550. if ARecord.ValueByName('Locked').AsBoolean then
  551. DataSetErrorMessage(Allow, '该支付(扣款)项已锁定,不可删除!')
  552. else if ARecord.ValueByName('PreDefined').AsBoolean then
  553. DataSetErrorMessage(Allow, '此项为预定义项,不允许删除!')
  554. else if ARecord.ValueByName('TotalPrice').AsFloat <> 0 then
  555. DataSetErrorMessage(Allow, '该支付(扣款)项存在数据,如需删除请先清除本期金额!');
  556. if Allow and TProjectData(FProjectData).PhaseData.Active then
  557. TProjectData(FProjectData).PhaseData.PhasePayData.Delete(ARecord.ValueByName('ID').AsInteger);
  558. end;
  559. procedure TDealPaymentData.Close;
  560. begin
  561. sddDealPayment.Close;
  562. end;
  563. procedure TDealPaymentData.RepairSerialNo;
  564. var
  565. Rec: TsdDataRecord;
  566. iRec: Integer;
  567. begin
  568. if sddDealPayment.RecordCount = 0 then Exit;
  569. Rec := sddDealPayment.Records[0];
  570. if Rec.ValueByName('SerialNo').AsString = '' then
  571. begin
  572. for iRec := 0 to sddDealPayment.RecordCount - 1 do
  573. begin
  574. Rec := sddDealPayment.Records[iRec];
  575. Rec.ValueByName('SerialNo').AsInteger := iRec;
  576. end;
  577. end;
  578. end;
  579. function TDealPaymentData.GetNewSerialNo: Integer;
  580. var
  581. idx: TsdIndex;
  582. begin
  583. idx := sddDealPayment.FindIndex('idxView');
  584. if idx.RecordCount > 0 then
  585. Result := idx.Records[idx.RecordCount - 1].ValueByName('SerialNo').AsInteger + 1
  586. else
  587. Result := 1;
  588. end;
  589. procedure TDealPaymentData.RepairLockedFormula;
  590. function CheckHasRepair: Boolean;
  591. var
  592. iRec: Integer;
  593. Rec: TsdDataRecord;
  594. begin
  595. Result := True;
  596. for iRec := 0 to sddDealPayment.RecordCount - 1 do
  597. begin
  598. Rec := sddDealPayment.Records[iRec];
  599. if Rec.ValueByName('Locked').AsBoolean and
  600. (Rec.ValueByName('Formula').AsString <> '') and (Rec.ValueByName('LockedFormula').AsBoolean) then
  601. begin
  602. Result := False;
  603. Break;
  604. end;
  605. end;
  606. end;
  607. var
  608. iRec: Integer;
  609. Rec: TsdDataRecord;
  610. begin
  611. if sddDealPayment.RecordCount = 0 then Exit;
  612. if CheckHasRepair then
  613. begin
  614. for iRec := 0 to sddDealPayment.RecordCount - 1 do
  615. begin
  616. Rec := sddDealPayment.Records[iRec];
  617. if Rec.ValueByName('Locked').AsBoolean and (Rec.ValueByName('Formula').AsString <> '') then
  618. Rec.ValueByName('LockedFormula').AsBoolean := True;
  619. end;
  620. end;
  621. end;
  622. function TDealPaymentData.GetStartedPrice(AID: Integer): Double;
  623. var
  624. Rec: TsdDataRecord;
  625. begin
  626. Rec := sddDealPayment.FindKey('idxID', AID);
  627. Result := Rec.ValueByName('StartedPrice').AsFloat;
  628. end;
  629. function TDealPaymentData.CheckReachPlan(ARec: TsdDataRecord): Boolean;
  630. var
  631. fCurValue, fDeadlineValue: Double;
  632. begin
  633. Result := False;
  634. if ARec.ValueByName('PlanType').AsInteger <> 0 then
  635. begin
  636. if ARec.ValueByName('PlanType').AsInteger = 1 then
  637. fCurValue := TProjectData(FProjectData).ProjProperties.PhaseCount
  638. else if ARec.ValueByName('PlanSubType').AsInteger = 0 then
  639. fCurValue := TProjectData(FProjectData).BillsData.Settlement[4]
  640. else if ARec.ValueByName('PlanSubType').AsInteger = 1 then
  641. fCurValue := TProjectData(FProjectData).BillsData.Settlement[1]
  642. else if ARec.ValueByName('PlanSubType').AsInteger = 2 then
  643. fCurValue := TProjectData(FProjectData).BillsData.Settlement[2];
  644. fDeadlineValue := ARec.ValueByName('PlanDeadline').AsFloat;
  645. Result := fCurValue >= fDeadlineValue;
  646. end;
  647. end;
  648. function TDealPaymentData.PlanStr(ARec: TsdDataRecord): string;
  649. begin
  650. if ARec.ValueByName('PlanType').AsInteger = 0 then
  651. Result := '无'
  652. else if ARec.ValueByName('PlanType').AsInteger = 1 then
  653. Result := Format('计量期数 >= %d', [ARec.ValueByName('PlanDeadline').AsInteger])
  654. else if ARec.ValueByName('PlanSubType').AsInteger = 0 then
  655. Result := Format('累计完成计量金额 >= %f', [ARec.ValueByName('PlanDeadline').AsFloat])
  656. else if ARec.ValueByName('PlanSubType').AsInteger = 1 then
  657. Result := Format('累计合同计量金额 >= %f', [ARec.ValueByName('PlanDeadline').AsFloat])
  658. else if ARec.ValueByName('PlanSubType').AsInteger = 2 then
  659. Result := Format('累计变更计量金额 >= %f', [ARec.ValueByName('PlanDeadline').AsFloat]);
  660. end;
  661. procedure TDealPaymentData.UpdateLinkSerialNo;
  662. var
  663. iPay, iCut, iIndex: Integer;
  664. Rec: TsdDataRecord;
  665. begin
  666. iPay := 1;
  667. iCut := 1;
  668. for iIndex := 0 to sdvDealPayment.RecordCount - 1 do
  669. begin
  670. Rec := sdvDealPayment.Records[iIndex];
  671. if Rec.ValueByName('CalcType').AsInteger = 0 then
  672. begin
  673. if Rec.ValueByName('IsMinus').AsBoolean then
  674. begin
  675. Rec.ValueByName('LinkSerialNo').AsInteger := iCut;
  676. Inc(iCut);
  677. end
  678. else
  679. begin
  680. Rec.ValueByName('LinkSerialNo').AsInteger := iPay;
  681. Inc(iPay);
  682. end;
  683. end;
  684. end;
  685. end;
  686. function TDealPaymentData.DealPayRecord(
  687. const AName: string): TsdDataRecord;
  688. var
  689. iRec: Integer;
  690. Rec: TsdDataRecord;
  691. begin
  692. Result := nil;
  693. for iRec := 0 to sddDealPayment.RecordCount - 1 do
  694. begin
  695. Rec := sddDealPayment.Records[iRec];
  696. if SameText(AName, Rec.ValueByName('Name').AsString) then
  697. begin
  698. Result := Rec;
  699. Break;
  700. end;
  701. end;
  702. end;
  703. procedure TDealPaymentData.sdvDealPaymentBeforeAddRecord(
  704. ARecord: TsdDataRecord; var Allow: Boolean);
  705. begin
  706. Allow := VarToStrDef(ARecord.ValueByName('Name').CachedValue, '') <> '';
  707. end;
  708. procedure TDealPaymentData.SetTotalPrice(AID: Integer;
  709. ATotalPrice: Double);
  710. var
  711. Rec: TsdDataRecord;
  712. begin
  713. Rec := sddDealPayment.FindKey('idxID', AID);
  714. Rec.ValueByName('TotalPrice').AsFloat := ATotalPrice;
  715. end;
  716. end.