123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381 |
- unit DealPaymentFme;
- interface
- uses
- DealPaymentDm, FormulaCalc, DB,
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, ExtCtrls, sdGridDBA, ZJGrid, JimLabels, dxBar, sdDB,
- ActnList;
- type
- TDealPaymentFrame = class(TFrame)
- pnlExprs: TPanel;
- laEdtExprs: TLabeledEdit;
- pnlPayRecord: TPanel;
- zgDealPayment: TZJGrid;
- sdDealPayment: TsdGridDBA;
- pnlTitle: TPanel;
- labTitle: TJimGradLabel;
- pnlParameter: TPanel;
- zgParameter: TZJGrid;
- imgHelp: TImage;
- dxpmDealPayment: TdxBarPopupMenu;
- actnDealPayment: TActionList;
- actnCalculatePhasePay: TAction;
- actnSetDealPayPlan: TAction;
- procedure zgParameterCellCanEdit(Sender: TObject; const ACoord: TPoint;
- var Allow: Boolean);
- procedure imgHelpClick(Sender: TObject);
- procedure zgDealPaymentMouseDown(Sender: TObject; Button: TMouseButton;
- Shift: TShiftState; X, Y: Integer);
- procedure laEdtExprsExit(Sender: TObject);
- procedure laEdtExprsKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
- procedure dxpmDealPaymentPopup(Sender: TObject);
- procedure actnCalculatePhasePayExecute(Sender: TObject);
- procedure actnCalculatePhasePayUpdate(Sender: TObject);
- procedure zgDealPaymentCellGetColor(Sender: TObject; ACoord: TPoint;
- var AColor: TColor);
- procedure zgDealPaymentCurrentChanged(Sender: TObject; Col,
- Row: Integer);
- procedure laEdtExprsKeyPress(Sender: TObject; var Key: Char);
- procedure zgDealPaymentCanEditAcceptKey(var AKey: Char;
- var Accept: Boolean);
- procedure actnSetDealPayPlanExecute(Sender: TObject);
- procedure zgDealPaymentShowHint(var HintStr: String;
- var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint);
- procedure actnSetDealPayPlanUpdate(Sender: TObject);
- private
- FDealPaymentData: TDealPaymentData;
- procedure InitParameterGrid;
- function CheckColHasFormula(ACol: Integer): Boolean;
- function CheckCurTotalPriceCol(ACol: Integer): Boolean;
- function CheckLimitPriceCol(ACol: Integer): Boolean;
- procedure RefreshFormula(ACol, ARow: Integer);
- procedure ResetBaseDataReadOnly(AReadOnly: Boolean);
- procedure ResetPhaseDataReadOnly(AReadOnly: Boolean);
- procedure ResetAllowInsert(AAllow: Boolean);
- public
- constructor Create(AProjectFrame: TFrame; ADealPaymentData: TDealPaymentData);
- destructor Destroy; override;
- procedure RefreshPhase_Stage;
- end;
- implementation
- uses
- MainFrm, UtilMethods, ProjectData, PhaseData, DealPayPlanFrm;
- {$R *.dfm}
- { TDealPaymentFrame }
- constructor TDealPaymentFrame.Create(AProjectFrame: TFrame;
- ADealPaymentData: TDealPaymentData);
- begin
- inherited Create(AProjectFrame);
- FDealPaymentData := ADealPaymentData;
- sdDealPayment.DataView := FDealPaymentData.sdvDealPayment;
- InitParameterGrid;
- end;
- destructor TDealPaymentFrame.Destroy;
- begin
- inherited;
- end;
- procedure TDealPaymentFrame.InitParameterGrid;
- begin
- zgParameter.ColWidths[1] := 150;
- zgParameter.ColWidths[2] := 60;
- zgParameter.Cells[1, 0].Text := '可选基数';
- zgParameter.Cells[2, 0].Text := '计算代号';
- zgParameter.Cells[1, 1].Text := '签约合同价';
- zgParameter.Cells[1, 1].Align := gaCenterLeft;
- zgParameter.Cells[2, 1].Text := 'htj';
- zgParameter.Cells[1, 2].Text := '签约开工预付款';
- zgParameter.Cells[1, 2].Align := gaCenterLeft;
- zgParameter.Cells[2, 2].Text := 'kgyfk';
- zgParameter.Cells[1, 3].Text := '签约材料预付款';
- zgParameter.Cells[1, 3].Align := gaCenterLeft;
- zgParameter.Cells[2, 3].Text := 'clyfk';
- zgParameter.Cells[1, 4].Text := '本期完成计量';
- zgParameter.Cells[1, 4].Align := gaCenterLeft;
- zgParameter.Cells[2, 4].Text := 'bqwc';
- zgParameter.Cells[1, 5].Text := '100章本期完成计量';
- zgParameter.Cells[1, 5].Align := gaCenterLeft;
- zgParameter.Cells[2, 5].Text := 'ybbqwc';
- end;
- procedure TDealPaymentFrame.zgParameterCellCanEdit(Sender: TObject;
- const ACoord: TPoint; var Allow: Boolean);
- begin
- Allow := False;
- end;
- procedure TDealPaymentFrame.imgHelpClick(Sender: TObject);
- begin
- pnlParameter.Visible := not pnlParameter.Visible;
- end;
- procedure TDealPaymentFrame.zgDealPaymentMouseDown(Sender: TObject;
- Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
- begin
- if Button = mbRight then
- dxpmDealPayment.PopupFromCursorPos;
- end;
- procedure TDealPaymentFrame.laEdtExprsExit(Sender: TObject);
- begin
- if CheckColHasFormula(zgDealPayment.CurCell.Col) then
- begin
- zgDealPayment.CurCell.Text := laEdtExprs.Text;
- RefreshFormula(zgDealPayment.CurCol, zgDealPayment.CurRow);
- end;
- end;
- procedure TDealPaymentFrame.laEdtExprsKeyDown(Sender: TObject;
- var Key: Word; Shift: TShiftState);
- begin
- if Key = VK_Return then
- zgDealPayment.SetFocus
- else if (ssCtrl in Shift) and (Key in [67, 99]) then
- laEdtExprs.CopyToClipboard;
- end;
- function TDealPaymentFrame.CheckColHasFormula(ACol: Integer): Boolean;
- begin
- Result := (ACol - 1 = sdDealPayment.VisibleCol('CurTotalPrice')) or
- (ACol - 1 = sdDealPayment.VisibleCol('StartedPrice')) or
- (ACol - 1 = sdDealPayment.VisibleCol('RangePrice'));
- end;
- procedure TDealPaymentFrame.dxpmDealPaymentPopup(Sender: TObject);
- begin
- SetDxBtnAction(actnCalculatePhasePay, MainForm.dxbtnCalculatePhasePay);
- SetDxBtnAction(actnSetDealPayPlan, MainForm.dxbtnSetDealPayPlan);
- end;
- procedure TDealPaymentFrame.actnCalculatePhasePayExecute(Sender: TObject);
- begin
- TProjectData(FDealPaymentData.ProjectData).PhaseData.PhasePayData.CalculateAll;
- end;
- procedure TDealPaymentFrame.actnCalculatePhasePayUpdate(Sender: TObject);
- begin
- TAction(Sender).Enabled := TProjectData(FDealPaymentData.ProjectData).PhaseData.Active;
- end;
- procedure TDealPaymentFrame.zgDealPaymentCellGetColor(Sender: TObject;
- ACoord: TPoint; var AColor: TColor);
- var
- Rec: TsdDataRecord;
- iCurPhase: Integer;
- begin
- if (ACoord.Y > zgDealPayment.FixedRowCount - 1) and
- (ACoord.Y < zgDealPayment.RowCount - sdDealPayment.ExtendRowCount) then
- begin
- Rec := sdDealPayment.DataView.Records[ACoord.Y - 1];
- iCurPhase := TProjectData(FDealPaymentData.ProjectData).PhaseIndex;
- // 本期应付
- if Rec.ValueByName('CalcType').AsInteger = 1 then
- AColor := clSkyBlue
- // 本期实付
- //else if Rec.ValueByName('CalcType').AsInteger = 2 then
- else if iCurPhase = 0 then
- AColor := clWindow
- //AColor := clSkyBlue
- // 当期不存在项(例如:查看第二期数据,该项为第三期新增项)
- else if Rec.ValueByName('CreatePhaseID').AsInteger > iCurPhase then
- AColor := clSilver
- // 当期新增项
- else if Rec.ValueByName('CreatePhaseID').AsInteger = iCurPhase then
- AColor := clInfoBk;
- end;
- end;
- procedure TDealPaymentFrame.zgDealPaymentCurrentChanged(Sender: TObject;
- Col, Row: Integer);
- begin
- RefreshFormula(Col, Row);
- end;
- procedure TDealPaymentFrame.RefreshFormula(ACol, ARow: Integer);
- begin
- if (ARow > 0) and (ARow < zgDealPayment.RowCount - sdDealPayment.ExtendRowCount) then
- begin
- if CheckColHasFormula(ACol) then
- laEdtExprs.Text := zgDealPayment.CurCell.EditText
- else
- laEdtExprs.Text := '';
- end
- else
- laEdtExprs.Text := '';
- end;
- procedure TDealPaymentFrame.RefreshPhase_Stage;
- begin
- with TProjectData(FDealPaymentData.ProjectData) do
- begin
- if ProjProperties.PhaseCount = 0 then
- ResetPhaseDataReadOnly(False)
- else
- ResetPhaseDataReadOnly(StageDataReadOnly);
- ResetBaseDataReadOnly(BaseDataReadOnly);
- ResetAllowInsert(AllowInsert);
- end;
- zgDealPayment.Invalidate;
- RefreshFormula(zgDealPayment.CurCol, zgDealPayment.CurRow);
- end;
- procedure TDealPaymentFrame.laEdtExprsKeyPress(Sender: TObject;
- var Key: Char);
- begin
- if CheckCurTotalPriceCol(zgDealPayment.CurCol) then
- begin
- if not((Key in ArithmeticCharSet) or (Key in ExprsBaseCharSet) or (Key in [#8, #17])) then
- Key := #0;
- end
- else if CheckLimitPriceCol(zgDealPayment.CurCol) then
- begin
- if not((Key in ArithmeticCharSet) or (Key in ExprsExceptCharSet) or (Key in [#8, #17])) then
- Key := #0;
- end
- else
- Key := #0;
- end;
- procedure TDealPaymentFrame.zgDealPaymentCanEditAcceptKey(var AKey: Char;
- var Accept: Boolean);
- var
- Col: TsdViewColumn;
- begin
- Accept := False;
- if sdDealPayment.FindViewColumn(zgDealPayment.CurCol, Col) then
- begin
- if (AKey = #161) and
- ((Assigned(Col.Field) and (Col.Field.DataType in [ftFloat, ftCurrency, ftBCD])) or
- (Assigned(Col.LookUpField) and (Col.LookUpField.DataType in [ftFloat, ftCurrency, ftBCD]))) then
- AKey := '.';
- if (Col.Field <> nil) then
- Accept := Col.Field.IsValidChar(AKey)
- else if (Col.LookUpField <> nil) then
- Accept := Col.LookUpField.IsValidChar(AKey)
- else if SameText(Col.FieldName, 'CurTotalPrice') then
- Accept := (AKey in ArithmeticCharSet) or (AKey in ExprsBaseCharSet)
- else
- Accept := True;
- end;
- end;
- procedure TDealPaymentFrame.ResetAllowInsert(AAllow: Boolean);
- begin
- if AAllow then
- sdDealPayment.Options := sdDealPayment.Options + [aoAllowInsert]
- else
- sdDealPayment.Options := sdDealPayment.Options - [aoAllowInsert];
- end;
- procedure TDealPaymentFrame.ResetBaseDataReadOnly(AReadOnly: Boolean);
- begin
- sdDealPayment.Column('Name').ReadOnly := AReadOnly;
- sdDealPayment.Column('IsMinus').ReadOnly := AReadOnly;
- end;
- procedure TDealPaymentFrame.ResetPhaseDataReadOnly(AReadOnly: Boolean);
- begin
- sdDealPayment.Column('CurTotalPrice').ReadOnly := AReadOnly;
- laEdtExprs.ReadOnly := AReadOnly;
- end;
- function TDealPaymentFrame.CheckCurTotalPriceCol(ACol: Integer): Boolean;
- begin
- Result := (ACol - 1 = sdDealPayment.VisibleCol('CurTotalPrice'));
- end;
- function TDealPaymentFrame.CheckLimitPriceCol(ACol: Integer): Boolean;
- begin
- Result := (ACol - 1 = sdDealPayment.VisibleCol('StartedPrice')) or
- (ACol - 1 = sdDealPayment.VisibleCol('RangePrice'));
- end;
- procedure TDealPaymentFrame.actnSetDealPayPlanExecute(Sender: TObject);
- function CheckCanPlan(ARec: TsdDataRecord): Boolean;
- begin
- Result := True;
- if ARec.ValueByName('CalcType').AsInteger <> 0 then
- begin
- ErrorMessage('本期应付,本期实付不可设置计提期限。');
- Result := False;
- end
- else if ARec.ValueByName('RangePrice').AsFloat = 0 then
- begin
- ErrorMessage('计提期限用于达到条件时,即刻计量至付(扣)款限额,应先设置付(扣)款限额。');
- Result := False;
- end
- else if ARec.ValueByName('Locked').AsBoolean then
- begin
- if ARec.ValueByName('PlanType').AsInteger = 0 then
- ErrorMessage('该支付(扣款)项被锁定,不可修改!')
- else
- TipMessage(Format('该支付(扣款)项已设置计提期限为:%s', [FDealPaymentData.PlanStr(ARec)]) + #13#10 + '且该项已被锁定,不可修改!');
- Result := False;
- end;
- end;
- var
- Rec: TsdDataRecord;
- PlanForm: TDealPayPlanForm;
- begin
- Rec := sdDealPayment.DataView.Current;
- if CheckCanPlan(Rec) then
- begin
- PlanForm := TDealPayPlanForm.Create(Rec, FDealPaymentData.ProjectData);
- try
- if PlanForm.ShowModal = mrOk then
- PlanForm.SavePlanInfos;
- finally
- PlanForm.Free;
- end;
- end;
- end;
- procedure TDealPaymentFrame.zgDealPaymentShowHint(var HintStr: String;
- var CanShow: Boolean; var HintInfo: THintInfo; const ACoord: TPoint);
- var
- Rec: TsdDataRecord;
- begin
- // 用户鼠标点击移动至本期金额时,提示是否含计提限额
- if (ACoord.X = 3) and (ACoord.Y > 0) and (ACoord.Y <= zgDealPayment.RowCount - 3) then
- begin
- Rec := sdDealPayment.DataView.Records[ACoord.Y - 1];
- if Assigned(Rec) and (Rec.ValueByName('Formula').AsString <> '') then
- begin
- if (Rec.ValueByName('PlanType').AsInteger <> 0) then
- begin
- CanShow := True;
- HintStr := Format('计提期限为(%s)', [FDealPaymentData.PlanStr(Rec)]);
- end;
- if (zgDealPayment.Cells[ACoord.X, ACoord.Y].Text <> '') and FDealPaymentData.CheckReachPlan(Rec) then
- begin
- CanShow := True;
- HintStr := '已达到计提期限,使用公式计算的当期金额须一次性计提至限额' + #13#10 +
- Format('计提期限为(%s)', [FDealPaymentData.PlanStr(Rec)]);
- end;
- end;
- end;
- end;
- procedure TDealPaymentFrame.actnSetDealPayPlanUpdate(Sender: TObject);
- begin
- TAction(Sender).Enabled := Assigned(sdDealPayment.DataView.Current);
- end;
- end.
|