合同支付相关

Forms/DealPayPlanFrm.dfm

@@ -0,0 +1,252 @@
+object DealPayPlanForm: TDealPayPlanForm
+  Left = 593
+  Top = 331
+  Width = 411
+  Height = 290
+  Caption = #35774#32622#35745#25552#26399#38480
+  Color = clBtnFace
+  Font.Charset = ANSI_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -12
+  Font.Name = #23435#20307
+  Font.Style = []
+  OldCreateOrder = False
+  DesignSize = (
+    403
+    256)
+  PixelsPerInch = 96
+  TextHeight = 12
+  object lblTitle: TLabel
+    Left = 10
+    Top = 9
+    Width = 96
+    Height = 12
+    Caption = #35831#35774#32622#20184'('#25187')'#27454#39033
+  end
+  object lblDealPayName: TLabel
+    Left = 112
+    Top = 8
+    Width = 18
+    Height = 12
+    Caption = 'XXX'
+    Font.Charset = ANSI_CHARSET
+    Font.Color = clBlue
+    Font.Height = -12
+    Font.Name = #23435#20307
+    Font.Style = []
+    ParentFont = False
+  end
+  object lblTitle2: TLabel
+    Left = 136
+    Top = 8
+    Width = 60
+    Height = 12
+    Caption = #30340#35745#25552#26399#38480
+  end
+  object lblPlanType: TLabel
+    Left = 12
+    Top = 30
+    Width = 72
+    Height = 12
+    Caption = #38480#21046#27169#24335#20026#65306
+  end
+  object lblResultPre: TLabel
+    Left = 11
+    Top = 175
+    Width = 48
+    Height = 12
+    Anchors = [akRight, akBottom]
+    Caption = #35774#32622#20026#65306
+  end
+  object lblResult: TLabel
+    Left = 35
+    Top = 192
+    Width = 78
+    Height = 12
+    Anchors = [akRight, akBottom]
+    Caption = 'XX>YY('#20844#24335')'#26102
+    Font.Charset = ANSI_CHARSET
+    Font.Color = clRed
+    Font.Height = -12
+    Font.Name = #23435#20307
+    Font.Style = []
+    ParentFont = False
+  end
+  object lblResultPost: TLabel
+    Left = 34
+    Top = 209
+    Width = 258
+    Height = 12
+    Anchors = [akRight, akBottom]
+    Caption = #24403#26399#37329#39069#30452#25509#35745#37327#33267'('#25187#27454#38480#39069' - '#25130#27490#19978#26399#37329#39069')'
+  end
+  object btnOk: TButton
+    Left = 248
+    Top = 229
+    Width = 70
+    Height = 21
+    Anchors = [akRight, akBottom]
+    Caption = #30830#23450
+    TabOrder = 5
+    OnClick = btnOkClick
+  end
+  object btnCancel: TButton
+    Left = 325
+    Top = 229
+    Width = 70
+    Height = 21
+    Anchors = [akRight, akBottom]
+    Caption = #21462#28040
+    ModalResult = 2
+    TabOrder = 6
+  end
+  object rbIsPlanPhase: TRadioButton
+    Tag = 1
+    Left = 127
+    Top = 28
+    Width = 73
+    Height = 17
+    Caption = #35745#37327#26399#25968
+    TabOrder = 1
+    OnClick = rbIsPlanNonClick
+  end
+  object rbIsPlanPrice: TRadioButton
+    Tag = 2
+    Left = 206
+    Top = 28
+    Width = 73
+    Height = 17
+    Caption = #35745#37327#37329#39069
+    TabOrder = 2
+    OnClick = rbIsPlanNonClick
+  end
+  object gbPhase: TGroupBox
+    Left = 9
+    Top = 48
+    Width = 385
+    Height = 47
+    Caption = #35745#37327#26399#25968#27169#24335
+    Enabled = False
+    Font.Charset = ANSI_CHARSET
+    Font.Color = clGray
+    Font.Height = -12
+    Font.Name = #23435#20307
+    Font.Style = []
+    ParentFont = False
+    TabOrder = 3
+    object leDeadlinePhase: TLabeledEdit
+      Left = 78
+      Top = 19
+      Width = 129
+      Height = 18
+      Ctl3D = False
+      EditLabel.Width = 66
+      EditLabel.Height = 12
+      EditLabel.Caption = #38480#21046#37329#39069#65306' '
+      LabelPosition = lpLeft
+      ParentCtl3D = False
+      TabOrder = 0
+      Text = '2'
+      OnChange = leDeadlinePhaseChange
+      OnKeyPress = leDeadlinePhaseKeyPress
+    end
+    object udDeadlinePhase: TUpDown
+      Left = 207
+      Top = 19
+      Width = 16
+      Height = 18
+      Associate = leDeadlinePhase
+      Min = 2
+      Max = 50
+      Position = 2
+      TabOrder = 1
+      OnClick = udDeadlinePhaseClick
+    end
+  end
+  object gbPrice: TGroupBox
+    Left = 10
+    Top = 103
+    Width = 385
+    Height = 65
+    Caption = #35745#37327#37329#39069#27169#24335
+    Enabled = False
+    Font.Charset = ANSI_CHARSET
+    Font.Color = clGray
+    Font.Height = -12
+    Font.Name = #23435#20307
+    Font.Style = []
+    ParentFont = False
+    TabOrder = 4
+    object lblEquar: TLabel
+      Left = 232
+      Top = 43
+      Width = 6
+      Height = 12
+      Caption = '='
+    end
+    object lblPriceDeadline: TLabel
+      Left = 244
+      Top = 43
+      Width = 6
+      Height = 12
+      Caption = '0'
+    end
+    object rbAddGatherTotalPrice: TRadioButton
+      Left = 8
+      Top = 18
+      Width = 118
+      Height = 17
+      Caption = #32047#35745#23436#25104#35745#37327#37329#39069
+      Checked = True
+      TabOrder = 0
+      TabStop = True
+      OnClick = rbAddGatherTotalPriceClick
+    end
+    object rbAddDealTotalPrice: TRadioButton
+      Tag = 1
+      Left = 136
+      Top = 18
+      Width = 118
+      Height = 17
+      Caption = #32047#35745#21512#21516#35745#37327#37329#39069
+      TabOrder = 1
+      OnClick = rbAddGatherTotalPriceClick
+    end
+    object rbAddQCTotalPrice: TRadioButton
+      Tag = 2
+      Left = 263
+      Top = 18
+      Width = 118
+      Height = 17
+      Caption = #32047#35745#21464#26356#35745#37327#37329#39069
+      TabOrder = 2
+      OnClick = rbAddGatherTotalPriceClick
+    end
+    object lePDFormula: TLabeledEdit
+      Left = 80
+      Top = 40
+      Width = 145
+      Height = 18
+      Ctl3D = False
+      EditLabel.Width = 66
+      EditLabel.Height = 12
+      EditLabel.Caption = #38480#21046#37329#39069#65306' '
+      LabelPosition = lpLeft
+      ParentCtl3D = False
+      TabOrder = 3
+      OnExit = lePDFormulaExit
+      OnKeyPress = leDeadlinePhaseKeyPress
+    end
+  end
+  object rbIsPlanNon: TRadioButton
+    Left = 86
+    Top = 28
+    Width = 40
+    Height = 17
+    Caption = #26080
+    Checked = True
+    TabOrder = 0
+    TabStop = True
+    OnClick = rbIsPlanNonClick
+  end
+end

Forms/DealPayPlanFrm.pas

@@ -0,0 +1,294 @@
+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
+  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.