DealPaymentFme.pas 12 KB

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