Measure/Forms/DealPayPlanFrm.pas

unit DealPayPlanFrm;

interface

uses
  sdDB,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, JimPages;

type
  TDealPayPlanForm = class(TForm)
    lblTitle: TLabel;
    lblDealPayName: TLabel;
    lblTitle2: TLabel;
    btnOk: TButton;
    btnCancel: TButton;
    lblPlanType: TLabel;
    rbIsPlanPhase: TRadioButton;
    rbIsPlanPrice: TRadioButton;
    lblResultPre: TLabel;
    lblResult: TLabel;
    lblResultPost: TLabel;
    gbPhase: TGroupBox;
    leDeadlinePhase: TLabeledEdit;
    udDeadlinePhase: TUpDown;
    gbPrice: TGroupBox;
    rbAddGatherTotalPrice: TRadioButton;
    rbAddDealTotalPrice: TRadioButton;
    rbAddQCTotalPrice: TRadioButton;
    lePDFormula: TLabeledEdit;
    rbIsPlanNon: TRadioButton;
    lblEquar: TLabel;
    lblPriceDeadline: TLabel;
    procedure btnOkClick(Sender: TObject);
    procedure rbIsPlanNonClick(Sender: TObject);
    procedure rbAddGatherTotalPriceClick(Sender: TObject);
    procedure udDeadlinePhaseClick(Sender: TObject; Button: TUDBtnType);
    procedure leDeadlinePhaseKeyPress(Sender: TObject; var Key: Char);
    procedure leDeadlinePhaseChange(Sender: TObject);
    procedure lePDFormulaExit(Sender: TObject);
  private
    FDealPayRec: TsdDataRecord;
    FProjectData: TObject;

    FPlanType: Integer;
    FPlanSubType: Integer;

    //FFormulaSet: t

    procedure InitForm;

    procedure AssignResult;

    procedure SetPlanType(const Value: Integer);
    procedure SetPlanSubType(const Value: Integer);
    function GetPhaseDeadline: Integer;
    procedure SetPhaseDeadline(const Value: Integer);
    function GetPriceDeadline: Double;
    procedure SetPriceDeadline(const Value: Double);
    function GetPDFormula: string;
    procedure SetPDFormula(const Value: string);
    function GetLimitPrice: Double;
    function GetPlanSubTypeName: string;
  public
    constructor Create(ADealPayRec: TsdDataRecord; AProjectData: TObject);
    destructor Destroy; override;

    procedure SavePlanInfos;

    property PlanType: Integer read FPlanType write SetPlanType;
    property PlanSubType: Integer read FPlanSubType write SetPlanSubType;
    property PlanSubTypeName: string read GetPlanSubTypeName;
    property PhaseDeadline: Integer read GetPhaseDeadline write SetPhaseDeadline;
    property PriceDeadline: Double read GetPriceDeadline write SetPriceDeadline;
    property PDFormula: string read GetPDFormula write SetPDFormula;
    property LimitPrice: Double read GetLimitPrice;
  end;

implementation

uses
  UtilMethods, ProjectData, BillsDm, DealPaymentDm, ZhAPI;

{$R *.dfm}

{ TDealPayPlanForm }

constructor TDealPayPlanForm.Create(ADealPayRec: TsdDataRecord; AProjectData: TObject);
begin
  inherited Create(nil);
  FDealPayRec := ADealPayRec;
  FProjectData := AProjectData;
  InitForm;
end;

destructor TDealPayPlanForm.Destroy;
begin
  inherited;
end;

procedure TDealPayPlanForm.InitForm;
begin
  ClientHeight := 259;
  ClientWidth := 403;

  lblDealPayName.Caption := FDealPayRec.ValueByName('Name').AsString;
  lblTitle2.Left := lblDealPayName.Left + lblDealPayName.Width + 6;
  PlanType := FDealPayRec.ValueByName('PlanType').AsInteger;
  if PlanType = 1 then
    PhaseDeadline := FDealPayRec.ValueByName('PlanDeadline').AsInteger
  else if PlanType = 2 then
  begin
    PlanSubType := FDealPayRec.ValueByName('PlanSubType').AsInteger;
    PriceDeadline := FDealPayRec.ValueByName('PlanDeadline').AsFloat;
    PDFormula := FDealPayRec.ValueByName('PDFormula').AsString;
  end;
end;

procedure TDealPayPlanForm.SavePlanInfos;
begin
  FDealPayRec.ValueByName('PlanType').AsInteger := PlanType;
  if PlanType = 0 then
  begin
    FDealPayRec.ValueByName('PlanSubType').AsInteger := 0;
    FDealPayRec.ValueByName('PlanDeadline').AsFloat := 0;
    FDealPayRec.ValueByName('PDFormula').AsString := '';
  end
  else if PlanType = 1 then
  begin
    FDealPayRec.ValueByName('PlanSubType').AsInteger := 0;
    FDealPayRec.ValueByName('PlanDeadline').AsInteger := PhaseDeadline;
    FDealPayRec.ValueByName('PDFormula').AsString := '';
  end
  else
  begin
    FDealPayRec.ValueByName('PlanSubType').AsInteger := PlanSubType;
    FDealPayRec.ValueByName('PlanDeadline').AsFloat := PriceDeadline;
    FDealPayRec.ValueByName('PDFormula').AsString := PDFormula;
  end;
end;

procedure TDealPayPlanForm.SetPriceDeadline(const Value: Double);
begin
  lblPriceDeadline.Caption := FloatToStr(Value);
end;

procedure TDealPayPlanForm.SetPlanSubType(const Value: Integer);
begin
  FPlanSubType := Value;
  rbAddGatherTotalPrice.Checked := FPlanSubType = 0;
  rbAddDealTotalPrice.Checked := FPlanSubType = 1;
  rbAddQCTotalPrice.Checked := FPlanSubType = 2;
  AssignResult;
end;

procedure TDealPayPlanForm.SetPlanType(const Value: Integer);
begin
  FPlanType := Value;
  rbIsPlanNon.Checked := FPlanType = 0;
  rbIsPlanPhase.Checked := FPlanType = 1;
  rbIsPlanPrice.Checked := FPlanType = 2;
  gbPhase.Enabled := rbIsPlanPhase.Checked;
  if gbPhase.Enabled then
    gbPhase.Font.Color := clBlack
  else
    gbPhase.Font.Color := clGray;
  gbPrice.Enabled := rbIsPlanPrice.Checked;
  if gbPrice.Enabled then
    gbPrice.Font.Color := clBlack
  else
    gbPrice.Font.Color := clGray;
  AssignResult;
end;

procedure TDealPayPlanForm.SetPhaseDeadline(const Value: Integer);
begin
  udDeadlinePhase.Position := Value;
end;

procedure TDealPayPlanForm.btnOkClick(Sender: TObject);
begin
  if (PlanType = 2) and (PriceDeadline < LimitPrice) then
    ErrorMessage(Format('当前“%s”已计量至%f，限制金额应大于该值！', [PlanSubTypeName, LimitPrice]))
  else
    ModalResult := mrOk;
end;

function TDealPayPlanForm.GetPhaseDeadline: Integer;
begin
  Result := udDeadlinePhase.Position;
end;

function TDealPayPlanForm.GetPriceDeadline: Double;
begin
  Result := StrToFloat(lblPriceDeadline.Caption);
end;

function TDealPayPlanForm.GetPDFormula: string;
begin
  Result := lePDFormula.Text;
end;

procedure TDealPayPlanForm.SetPDFormula(const Value: string);
begin
  lePDFormula.Text := Value;
end;

function TDealPayPlanForm.GetLimitPrice: Double;
begin
  with TProjectData(FProjectData).BillsData do
  begin
    case PlanSubType of
      0: Result := Settlement[4];
      1: Result := Settlement[1];
      2: Result := Settlement[2] + Settlement[3];
    end;
  end;
end;

procedure TDealPayPlanForm.rbIsPlanNonClick(Sender: TObject);
begin
  if PlanType <> TRadioButton(Sender).Tag then
    PlanType := TRadioButton(Sender).Tag;
end;

procedure TDealPayPlanForm.rbAddGatherTotalPriceClick(Sender: TObject);
begin
  if PlanSubType <> TRadioButton(Sender).Tag then
    PlanSubType := TRadioButton(Sender).Tag;
end;

procedure TDealPayPlanForm.AssignResult;

  procedure CalcPriceDeadline;
  begin
    if CheckStringNull(PDFormula) then
      PriceDeadline := 0
    else if CheckNumeric(PDFormula) then
      PriceDeadline := StrToFloatDef(PDFormula, 0)
    else if Pos('bqwc', PDFormula) > 0 then
    begin
      ErrorMessage('不可使用“本期完成计量”计算基数！');
      PriceDeadline := 0;
    end
    else
      PriceDeadline := TProjectData(FProjectData).DealPaymentData.PayFormula.Calculate(PDFormula);
  end;

  function GetResult: String;
  begin
    case PlanType of
      0: Result := '无';
      1: Result := Format('当 计量期数 > %d 时，', [PhaseDeadline]);
      2: Result := Format('当 %s > %f 时', [PlanSubTypeName, PriceDeadline]);
    end;
  end;

begin
  if PlanType = 2 then
    CalcPriceDeadline;
  lblResult.Caption := GetResult;
  lblResultPost.Visible := PlanType <> 0;
end;

function TDealPayPlanForm.GetPlanSubTypeName: string;
begin
  case PlanSubType of
    0: Result := '累计完成计量金额';
    1: Result := '累计合同计量金额';
    2: Result := '累计变更计量金额';
  end;
end;

procedure TDealPayPlanForm.udDeadlinePhaseClick(Sender: TObject;
  Button: TUDBtnType);
begin
  AssignResult;
end;

procedure TDealPayPlanForm.leDeadlinePhaseKeyPress(Sender: TObject;
  var Key: Char);
begin
  if Key = #13 then
    btnOk.SetFocus;
end;

procedure TDealPayPlanForm.leDeadlinePhaseChange(Sender: TObject);
begin
  AssignResult;
end;

procedure TDealPayPlanForm.lePDFormulaExit(Sender: TObject);
begin
  AssignResult;
end;

end.