| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441 | 
							- 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;
 
-     actnCanCalc: 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);
 
-     procedure actnCanCalcExecute(Sender: TObject);
 
-     procedure actnCanCalcUpdate(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, PhasePayDm,
 
-   Math;
 
- {$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);
 
-   SetDxBtnAction(actnCanCalc, MainForm.dxbtnCanCalc);
 
- 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, PhaseRec: 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;
 
-     with TProjectData(FDealPaymentData.ProjectData) do
 
-       if PhaseData.Active then
 
-       begin
 
-         PhaseRec := PhaseData.PhasePayData.PayRecord(Rec.ValueByName('ID').AsInteger);
 
-         if Assigned(PhaseRec) and PhaseRec.ValueByName('StopCalc').AsBoolean then
 
-           AColor := clSilver;
 
-       end;
 
-   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;
 
- procedure TDealPaymentFrame.actnCanCalcExecute(Sender: TObject);
 
- var
 
-   Rec, PhaseRec: TsdDataRecord;
 
- begin
 
-   Rec := sdDealPayment.DataView.Current;
 
-   with TProjectData(FDealPaymentData.ProjectData).PhaseData.PhasePayData do
 
-   begin
 
-     PhaseRec := PayRecord(Rec.ValueByName('ID').AsInteger);
 
-     if not Assigned(PhaseRec) then
 
-       PhaseRec := AddPayRecord(Rec.ValueByName('ID').AsInteger);
 
-   end;
 
-   PhaseRec.ValueByName('StopCalc').AsBoolean := not PhaseRec.ValueByName('StopCalc').AsBoolean;
 
-   Rec.ValueByName('StopCalc').AsBoolean := PhaseRec.ValueByName('StopCalc').AsBoolean;
 
-   TProjectData(FDealPaymentData.ProjectData).PhaseData.PhasePayData.CalculateAll;
 
- end;
 
- procedure TDealPaymentFrame.actnCanCalcUpdate(Sender: TObject);
 
- var
 
-   Rec, PhaseRec: TsdDataRecord;
 
- begin
 
-   Rec := sdDealPayment.DataView.Current;
 
-   if not Assigned(Rec) or Rec.ValueByName('PreDefined').AsBoolean or
 
-     (Rec.ValueByName('CalcType').AsInteger <> 0) or
 
-     (Rec.ValueByName('Name').AsString = '本期完成计量') then
 
-   begin
 
-     TAction(Sender).Visible := False;
 
-     Exit;
 
-   end;
 
-   TAction(Sender).Visible := TProjectData(FDealPaymentData.ProjectData).ValidStageIsRefer;
 
-   with TProjectData(FDealPaymentData.ProjectData) do
 
-     if PhaseData.Active then
 
-       PhaseRec := PhaseData.PhasePayData.PayRecord(Rec.ValueByName('ID').AsInteger)
 
-     else
 
-       PhaseRec := nil;
 
-   if Assigned(PhaseRec) then
 
-   begin
 
-     if PhaseRec.ValueByName('StopCalc').AsBoolean then
 
-       TAction(Sender).Caption := '启用'
 
-     else
 
-       TAction(Sender).Caption := '停用';
 
-   end
 
-   else
 
-     TAction(Sender).Caption := '停用';
 
- end;
 
- end.
 
 
  |