DealPaymentFme.pas 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479
  1. unit DealPaymentFme;
  2. interface
  3. uses
  4. DealPaymentDm, FormulaCalc, DB,
  5. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  6. Dialogs, StdCtrls, ExtCtrls, sdGridDBA, ZJGrid, JimLabels, dxBar, sdDB,
  7. ActnList;
  8. type
  9. TDealPaymentFrame = class(TFrame)
  10. pnlExprs: TPanel;
  11. laEdtExprs: TLabeledEdit;
  12. pnlPayRecord: TPanel;
  13. zgDealPayment: TZJGrid;
  14. sdDealPayment: TsdGridDBA;
  15. pnlTitle: TPanel;
  16. labTitle: TJimGradLabel;
  17. pnlParameter: TPanel;
  18. zgParameter: TZJGrid;
  19. imgHelp: TImage;
  20. dxpmDealPayment: TdxBarPopupMenu;
  21. actnDealPayment: TActionList;
  22. actnCalculatePhasePay: TAction;
  23. actnSetDealPayPlan: TAction;
  24. actnCanCalc: TAction;
  25. actnWithoutCalcCurPay: TAction;
  26. procedure zgParameterCellCanEdit(Sender: TObject; const ACoord: TPoint;
  27. var Allow: Boolean);
  28. procedure imgHelpClick(Sender: TObject);
  29. procedure zgDealPaymentMouseDown(Sender: TObject; Button: TMouseButton;
  30. Shift: TShiftState; X, Y: Integer);
  31. procedure laEdtExprsExit(Sender: TObject);
  32. procedure laEdtExprsKeyDown(Sender: TObject; var Key: Word;
  33. Shift: TShiftState);
  34. procedure dxpmDealPaymentPopup(Sender: TObject);
  35. procedure actnCalculatePhasePayExecute(Sender: TObject);
  36. procedure actnCalculatePhasePayUpdate(Sender: TObject);
  37. procedure zgDealPaymentCellGetColor(Sender: TObject; ACoord: TPoint;
  38. var AColor: TColor);
  39. procedure zgDealPaymentCurrentChanged(Sender: TObject; Col,
  40. Row: Integer);
  41. procedure laEdtExprsKeyPress(Sender: TObject; var Key: Char);
  42. procedure zgDealPaymentCanEditAcceptKey(var AKey: Char;
  43. var Accept: Boolean);
  44. procedure actnSetDealPayPlanExecute(Sender: TObject);
  45. procedure zgDealPaymentShowHint(var HintStr: String;
  46. var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint);
  47. procedure actnSetDealPayPlanUpdate(Sender: TObject);
  48. procedure actnCanCalcExecute(Sender: TObject);
  49. procedure actnCanCalcUpdate(Sender: TObject);
  50. procedure actnWithoutCalcCurPayExecute(Sender: TObject);
  51. procedure actnWithoutCalcCurPayUpdate(Sender: TObject);
  52. private
  53. FDealPaymentData: TDealPaymentData;
  54. procedure InitParameterGrid;
  55. function CheckColHasFormula(ACol: Integer): Boolean;
  56. function CheckCurTotalPriceCol(ACol: Integer): Boolean;
  57. function CheckLimitPriceCol(ACol: Integer): Boolean;
  58. procedure RefreshFormula(ACol, ARow: Integer);
  59. procedure ResetBaseDataReadOnly(AReadOnly: Boolean);
  60. procedure ResetPhaseDataReadOnly(AReadOnly: Boolean);
  61. procedure ResetAllowInsert(AAllow: Boolean);
  62. public
  63. constructor Create(AProjectFrame: TFrame; ADealPaymentData: TDealPaymentData);
  64. destructor Destroy; override;
  65. procedure RefreshPhase_Stage;
  66. end;
  67. implementation
  68. uses
  69. MainFrm, UtilMethods, ProjectData, PhaseData, DealPayPlanFrm, PhasePayDm,
  70. Math;
  71. {$R *.dfm}
  72. { TDealPaymentFrame }
  73. constructor TDealPaymentFrame.Create(AProjectFrame: TFrame;
  74. ADealPaymentData: TDealPaymentData);
  75. begin
  76. inherited Create(AProjectFrame);
  77. FDealPaymentData := ADealPaymentData;
  78. sdDealPayment.DataView := FDealPaymentData.sdvDealPayment;
  79. InitParameterGrid;
  80. end;
  81. destructor TDealPaymentFrame.Destroy;
  82. begin
  83. inherited;
  84. end;
  85. procedure TDealPaymentFrame.InitParameterGrid;
  86. begin
  87. zgParameter.ColWidths[1] := 150;
  88. zgParameter.ColWidths[2] := 60;
  89. zgParameter.Cells[1, 0].Text := '可选基数';
  90. zgParameter.Cells[2, 0].Text := '计算代号';
  91. zgParameter.Cells[1, 1].Text := '签约合同价';
  92. zgParameter.Cells[1, 1].Align := gaCenterLeft;
  93. zgParameter.Cells[2, 1].Text := 'htj';
  94. zgParameter.Cells[1, 2].Text := '签约开工预付款';
  95. zgParameter.Cells[1, 2].Align := gaCenterLeft;
  96. zgParameter.Cells[2, 2].Text := 'kgyfk';
  97. zgParameter.Cells[1, 3].Text := '签约材料预付款';
  98. zgParameter.Cells[1, 3].Align := gaCenterLeft;
  99. zgParameter.Cells[2, 3].Text := 'clyfk';
  100. zgParameter.Cells[1, 4].Text := '本期完成计量';
  101. zgParameter.Cells[1, 4].Align := gaCenterLeft;
  102. zgParameter.Cells[2, 4].Text := 'bqwc';
  103. zgParameter.Cells[1, 5].Text := '100章本期完成计量';
  104. zgParameter.Cells[1, 5].Align := gaCenterLeft;
  105. zgParameter.Cells[2, 5].Text := 'ybbqwc';
  106. end;
  107. procedure TDealPaymentFrame.zgParameterCellCanEdit(Sender: TObject;
  108. const ACoord: TPoint; var Allow: Boolean);
  109. begin
  110. Allow := False;
  111. end;
  112. procedure TDealPaymentFrame.imgHelpClick(Sender: TObject);
  113. begin
  114. pnlParameter.Visible := not pnlParameter.Visible;
  115. end;
  116. procedure TDealPaymentFrame.zgDealPaymentMouseDown(Sender: TObject;
  117. Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  118. begin
  119. if Button = mbRight then
  120. dxpmDealPayment.PopupFromCursorPos;
  121. end;
  122. procedure TDealPaymentFrame.laEdtExprsExit(Sender: TObject);
  123. begin
  124. if CheckColHasFormula(zgDealPayment.CurCell.Col) then
  125. begin
  126. zgDealPayment.CurCell.Text := laEdtExprs.Text;
  127. RefreshFormula(zgDealPayment.CurCol, zgDealPayment.CurRow);
  128. end;
  129. end;
  130. procedure TDealPaymentFrame.laEdtExprsKeyDown(Sender: TObject;
  131. var Key: Word; Shift: TShiftState);
  132. begin
  133. if Key = VK_Return then
  134. zgDealPayment.SetFocus
  135. else if (ssCtrl in Shift) and (Key in [67, 99]) then
  136. laEdtExprs.CopyToClipboard;
  137. end;
  138. function TDealPaymentFrame.CheckColHasFormula(ACol: Integer): Boolean;
  139. begin
  140. Result := (ACol - 1 = sdDealPayment.VisibleCol('CurTotalPrice')) or
  141. (ACol - 1 = sdDealPayment.VisibleCol('StartedPrice')) or
  142. (ACol - 1 = sdDealPayment.VisibleCol('RangePrice'));
  143. end;
  144. procedure TDealPaymentFrame.dxpmDealPaymentPopup(Sender: TObject);
  145. begin
  146. SetDxBtnAction(actnCalculatePhasePay, MainForm.dxbtnCalculatePhasePay);
  147. SetDxBtnAction(actnSetDealPayPlan, MainForm.dxbtnSetDealPayPlan);
  148. SetDxBtnAction(actnCanCalc, MainForm.dxbtnCanCalc);
  149. SetDxBtnAction(actnWithoutCalcCurPay, MainForm.dxbtnWithoutCalcCurPay);
  150. end;
  151. procedure TDealPaymentFrame.actnCalculatePhasePayExecute(Sender: TObject);
  152. begin
  153. TProjectData(FDealPaymentData.ProjectData).PhaseData.PhasePayData.CalculateAll;
  154. end;
  155. procedure TDealPaymentFrame.actnCalculatePhasePayUpdate(Sender: TObject);
  156. begin
  157. TAction(Sender).Enabled := TProjectData(FDealPaymentData.ProjectData).PhaseData.Active;
  158. end;
  159. procedure TDealPaymentFrame.zgDealPaymentCellGetColor(Sender: TObject;
  160. ACoord: TPoint; var AColor: TColor);
  161. var
  162. Rec, PhaseRec: TsdDataRecord;
  163. iCurPhase: Integer;
  164. begin
  165. if (ACoord.Y > zgDealPayment.FixedRowCount - 1) and
  166. (ACoord.Y < zgDealPayment.RowCount - sdDealPayment.ExtendRowCount) then
  167. begin
  168. Rec := sdDealPayment.DataView.Records[ACoord.Y - 1];
  169. iCurPhase := TProjectData(FDealPaymentData.ProjectData).PhaseIndex;
  170. // 本期应付
  171. if Rec.ValueByName('CalcType').AsInteger = 1 then
  172. AColor := clSkyBlue
  173. else if Rec.ValueByName('CalcType').AsInteger = 3 then
  174. AColor := $00E6E6E6
  175. // 本期实付
  176. //else if Rec.ValueByName('CalcType').AsInteger = 2 then
  177. else if iCurPhase = 0 then
  178. AColor := clWindow
  179. //AColor := clSkyBlue
  180. // 当期不存在项(例如:查看第二期数据,该项为第三期新增项)
  181. else if Rec.ValueByName('CreatePhaseID').AsInteger > iCurPhase then
  182. AColor := clSilver
  183. // 当期新增项
  184. else if Rec.ValueByName('CreatePhaseID').AsInteger = iCurPhase then
  185. AColor := clInfoBk;
  186. with TProjectData(FDealPaymentData.ProjectData) do
  187. if PhaseData.Active then
  188. begin
  189. PhaseRec := PhaseData.PhasePayData.PayRecord(Rec.ValueByName('ID').AsInteger);
  190. if Assigned(PhaseRec) and PhaseRec.ValueByName('StopCalc').AsBoolean then
  191. AColor := clSilver;
  192. end;
  193. end;
  194. end;
  195. procedure TDealPaymentFrame.zgDealPaymentCurrentChanged(Sender: TObject;
  196. Col, Row: Integer);
  197. begin
  198. RefreshFormula(Col, Row);
  199. end;
  200. procedure TDealPaymentFrame.RefreshFormula(ACol, ARow: Integer);
  201. begin
  202. if (ARow > 0) and (ARow < zgDealPayment.RowCount - sdDealPayment.ExtendRowCount) then
  203. begin
  204. if CheckColHasFormula(ACol) then
  205. laEdtExprs.Text := zgDealPayment.CurCell.EditText
  206. else
  207. laEdtExprs.Text := '';
  208. end
  209. else
  210. laEdtExprs.Text := '';
  211. end;
  212. procedure TDealPaymentFrame.RefreshPhase_Stage;
  213. begin
  214. with TProjectData(FDealPaymentData.ProjectData) do
  215. begin
  216. if ProjProperties.PhaseCount = 0 then
  217. ResetPhaseDataReadOnly(False)
  218. else
  219. ResetPhaseDataReadOnly(StageDataReadOnly);
  220. ResetBaseDataReadOnly(BaseDataReadOnly);
  221. ResetAllowInsert(AllowInsert);
  222. end;
  223. zgDealPayment.Invalidate;
  224. RefreshFormula(zgDealPayment.CurCol, zgDealPayment.CurRow);
  225. end;
  226. procedure TDealPaymentFrame.laEdtExprsKeyPress(Sender: TObject;
  227. var Key: Char);
  228. begin
  229. if CheckCurTotalPriceCol(zgDealPayment.CurCol) then
  230. begin
  231. if not((Key in ArithmeticCharSet) or (Key in ExprsBaseCharSet) or (Key in [#8, #17])) then
  232. Key := #0;
  233. end
  234. else if CheckLimitPriceCol(zgDealPayment.CurCol) then
  235. begin
  236. if not((Key in ArithmeticCharSet) or (Key in ExprsExceptCharSet) or (Key in [#8, #17])) then
  237. Key := #0;
  238. end
  239. else
  240. Key := #0;
  241. end;
  242. procedure TDealPaymentFrame.zgDealPaymentCanEditAcceptKey(var AKey: Char;
  243. var Accept: Boolean);
  244. var
  245. Col: TsdViewColumn;
  246. begin
  247. Accept := False;
  248. if sdDealPayment.FindViewColumn(zgDealPayment.CurCol, Col) then
  249. begin
  250. if (AKey = #161) and
  251. ((Assigned(Col.Field) and (Col.Field.DataType in [ftFloat, ftCurrency, ftBCD])) or
  252. (Assigned(Col.LookUpField) and (Col.LookUpField.DataType in [ftFloat, ftCurrency, ftBCD]))) then
  253. AKey := '.';
  254. if (Col.Field <> nil) then
  255. Accept := Col.Field.IsValidChar(AKey)
  256. else if (Col.LookUpField <> nil) then
  257. Accept := Col.LookUpField.IsValidChar(AKey)
  258. else if SameText(Col.FieldName, 'CurTotalPrice') then
  259. Accept := (AKey in ArithmeticCharSet) or (AKey in ExprsBaseCharSet)
  260. else
  261. Accept := True;
  262. end;
  263. end;
  264. procedure TDealPaymentFrame.ResetAllowInsert(AAllow: Boolean);
  265. begin
  266. if AAllow then
  267. sdDealPayment.Options := sdDealPayment.Options + [aoAllowInsert]
  268. else
  269. sdDealPayment.Options := sdDealPayment.Options - [aoAllowInsert];
  270. end;
  271. procedure TDealPaymentFrame.ResetBaseDataReadOnly(AReadOnly: Boolean);
  272. begin
  273. sdDealPayment.Column('Name').ReadOnly := AReadOnly;
  274. sdDealPayment.Column('IsMinus').ReadOnly := AReadOnly;
  275. end;
  276. procedure TDealPaymentFrame.ResetPhaseDataReadOnly(AReadOnly: Boolean);
  277. begin
  278. sdDealPayment.Column('CurTotalPrice').ReadOnly := AReadOnly;
  279. laEdtExprs.ReadOnly := AReadOnly;
  280. end;
  281. function TDealPaymentFrame.CheckCurTotalPriceCol(ACol: Integer): Boolean;
  282. begin
  283. Result := (ACol - 1 = sdDealPayment.VisibleCol('CurTotalPrice'));
  284. end;
  285. function TDealPaymentFrame.CheckLimitPriceCol(ACol: Integer): Boolean;
  286. begin
  287. Result := (ACol - 1 = sdDealPayment.VisibleCol('StartedPrice')) or
  288. (ACol - 1 = sdDealPayment.VisibleCol('RangePrice'));
  289. end;
  290. procedure TDealPaymentFrame.actnSetDealPayPlanExecute(Sender: TObject);
  291. function CheckCanPlan(ARec: TsdDataRecord): Boolean;
  292. begin
  293. Result := True;
  294. if ARec.ValueByName('CalcType').AsInteger = 3 then
  295. begin
  296. ErrorMessage('"不参与本期应付计算项"不可设置计提期限。');
  297. Result := False;
  298. end
  299. else if ARec.ValueByName('CalcType').AsInteger <> 0 then
  300. begin
  301. ErrorMessage('本期应付,本期实付不可设置计提期限。');
  302. Result := False;
  303. end
  304. else if ARec.ValueByName('RangePrice').AsFloat = 0 then
  305. begin
  306. ErrorMessage('计提期限用于达到条件时,即刻计量至付(扣)款限额,应先设置付(扣)款限额。');
  307. Result := False;
  308. end
  309. else if ARec.ValueByName('Locked').AsBoolean then
  310. begin
  311. if ARec.ValueByName('PlanType').AsInteger = 0 then
  312. ErrorMessage('该支付(扣款)项被锁定,不可修改!')
  313. else
  314. TipMessage(Format('该支付(扣款)项已设置计提期限为:%s', [FDealPaymentData.PlanStr(ARec)]) + #13#10 + '且该项已被锁定,不可修改!');
  315. Result := False;
  316. end;
  317. end;
  318. var
  319. Rec: TsdDataRecord;
  320. PlanForm: TDealPayPlanForm;
  321. begin
  322. Rec := sdDealPayment.DataView.Current;
  323. if CheckCanPlan(Rec) then
  324. begin
  325. PlanForm := TDealPayPlanForm.Create(Rec, FDealPaymentData.ProjectData);
  326. try
  327. if PlanForm.ShowModal = mrOk then
  328. PlanForm.SavePlanInfos;
  329. finally
  330. PlanForm.Free;
  331. end;
  332. end;
  333. end;
  334. procedure TDealPaymentFrame.zgDealPaymentShowHint(var HintStr: String;
  335. var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint);
  336. var
  337. Rec: TsdDataRecord;
  338. begin
  339. // 用户鼠标点击移动至本期金额时,提示是否含计提限额
  340. if (ACoord.X = 3) and (ACoord.Y > 0) and (ACoord.Y <= zgDealPayment.RowCount - 3) then
  341. begin
  342. Rec := sdDealPayment.DataView.Records[ACoord.Y - 1];
  343. if Assigned(Rec) and (Rec.ValueByName('Formula').AsString <> '') then
  344. begin
  345. if (Rec.ValueByName('PlanType').AsInteger <> 0) then
  346. begin
  347. CanShow := True;
  348. HintStr := Format('计提期限为(%s)', [FDealPaymentData.PlanStr(Rec)]);
  349. end;
  350. if (zgDealPayment.Cells[ACoord.X, ACoord.Y].Text <> '') and FDealPaymentData.CheckReachPlan(Rec) then
  351. begin
  352. CanShow := True;
  353. HintStr := '已达到计提期限,使用公式计算的当期金额须一次性计提至限额' + #13#10 +
  354. Format('计提期限为(%s)', [FDealPaymentData.PlanStr(Rec)]);
  355. end;
  356. end;
  357. end;
  358. end;
  359. procedure TDealPaymentFrame.actnSetDealPayPlanUpdate(Sender: TObject);
  360. begin
  361. TAction(Sender).Enabled := Assigned(sdDealPayment.DataView.Current);
  362. end;
  363. procedure TDealPaymentFrame.actnCanCalcExecute(Sender: TObject);
  364. var
  365. Rec, PhaseRec: TsdDataRecord;
  366. begin
  367. Rec := sdDealPayment.DataView.Current;
  368. with TProjectData(FDealPaymentData.ProjectData).PhaseData.PhasePayData do
  369. begin
  370. PhaseRec := PayRecord(Rec.ValueByName('ID').AsInteger);
  371. if not Assigned(PhaseRec) then
  372. PhaseRec := AddPayRecord(Rec.ValueByName('ID').AsInteger);
  373. end;
  374. PhaseRec.ValueByName('StopCalc').AsBoolean := not PhaseRec.ValueByName('StopCalc').AsBoolean;
  375. Rec.ValueByName('StopCalc').AsBoolean := PhaseRec.ValueByName('StopCalc').AsBoolean;
  376. TProjectData(FDealPaymentData.ProjectData).PhaseData.PhasePayData.CalculateAll;
  377. end;
  378. procedure TDealPaymentFrame.actnCanCalcUpdate(Sender: TObject);
  379. var
  380. Rec, PhaseRec: TsdDataRecord;
  381. begin
  382. Rec := sdDealPayment.DataView.Current;
  383. if not Assigned(Rec) or Rec.ValueByName('PreDefined').AsBoolean or
  384. (Rec.ValueByName('CalcType').AsInteger <> 0) or
  385. (Rec.ValueByName('Name').AsString = '本期完成计量') then
  386. begin
  387. TAction(Sender).Visible := False;
  388. Exit;
  389. end;
  390. TAction(Sender).Visible := TProjectData(FDealPaymentData.ProjectData).ValidStageIsRefer;
  391. with TProjectData(FDealPaymentData.ProjectData) do
  392. if PhaseData.Active then
  393. PhaseRec := PhaseData.PhasePayData.PayRecord(Rec.ValueByName('ID').AsInteger)
  394. else
  395. PhaseRec := nil;
  396. if Assigned(PhaseRec) then
  397. begin
  398. if PhaseRec.ValueByName('StopCalc').AsBoolean then
  399. TAction(Sender).Caption := '启用'
  400. else
  401. TAction(Sender).Caption := '停用';
  402. end
  403. else
  404. TAction(Sender).Caption := '停用';
  405. end;
  406. procedure TDealPaymentFrame.actnWithoutCalcCurPayExecute(Sender: TObject);
  407. var
  408. Rec, PhaseRec: TsdDataRecord;
  409. begin
  410. Rec := sdDealPayment.DataView.Current;
  411. Rec.ValueByName('CalcType').AsInteger := 3;
  412. if (TProjectData(FDealPaymentData.ProjectData).PhaseData.Active) then
  413. TProjectData(FDealPaymentData.ProjectData).PhaseData.PhasePayData.CalculateAll;
  414. end;
  415. procedure TDealPaymentFrame.actnWithoutCalcCurPayUpdate(Sender: TObject);
  416. var
  417. Rec: TsdDataRecord;
  418. begin
  419. Rec := sdDealPayment.DataView.Current;
  420. if not Assigned(Rec) or Rec.ValueByName('PreDefined').AsBoolean or
  421. (Rec.ValueByName('CalcType').AsInteger <> 0) or
  422. (Rec.ValueByName('Name').AsString = '本期完成计量') then
  423. begin
  424. TAction(Sender).Visible := False;
  425. Exit;
  426. end;
  427. TAction(Sender).Visible := (TProjectData(FDealPaymentData.ProjectData).PhaseIndex = Rec.ValueByName('CreatePhaseID').AsInteger) and
  428. (TProjectData(FDealPaymentData.ProjectData).ValidStageIsRefer or (not TProjectData(FDealPaymentData.ProjectData).StartMeasure));
  429. end;
  430. end.