DealPaymentFme.pas 14 KB

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