合同支付，增加计提期限功能

DataModules/DealPaymentDm.dfm

@@ -58,7 +58,18 @@ object DealPaymentData: TDealPaymentData
       4E65656450726F636573734E616D65090001044E616D65060D4C6F636B656446
       6F726D756C61094669656C644E616D65060D4C6F636B6564466F726D756C6108
       44617461547970650205084461746153697A6502010549734B6579080F4E6565
-      6450726F636573734E616D65090000}
+      6450726F636573734E616D65090001044E616D650608506C616E547970650946
+      69656C644E616D650608506C616E547970650844617461547970650203084461
+      746153697A6502040549734B6579080F4E65656450726F636573734E616D6509
+      0001044E616D65060B506C616E53756254797065094669656C644E616D65060B
+      506C616E537562547970650844617461547970650203084461746153697A6502
+      040549734B6579080F4E65656450726F636573734E616D65090001044E616D65
+      060C506C616E446561646C696E65094669656C644E616D65060C506C616E4465
+      61646C696E650844617461547970650206084461746153697A6502080549734B
+      6579080F4E65656450726F636573734E616D65080001044E616D650609504446
+      6F726D756C61094669656C644E616D6506095044466F726D756C610844617461
+      547970650218084461746153697A6502640549734B6579080F4E65656450726F
+      636573734E616D65090000}
   end
   object sdvDealPayment: TsdDataView
     Active = False

DataModules/DealPaymentDm.pas

@@ -49,9 +49,12 @@ type
 
     // 扣款项是否已达起扣金额
     function CheckStartedPrice(AID: Integer): Boolean;
+    function CheckReachPlan(ARec: TsdDataRecord): Boolean;
     function GetAllowTotalPrice(AID: Integer; ATotalPrice: Double): Double;
     procedure UpdateTotalPrice(AID: Integer; ATotalPrice: Double);
 
+    function PlanStr(ARec: TsdDataRecord): string;
+
     function GetStartedPrice(AID: Integer): Double;
 
     procedure CalcStarted_RangePrice;
@@ -67,6 +70,7 @@ type
     property AddTotalPrice: Double read GetAddTotalPrice;
     // 实付
     property PaidTotalPrice: Double read GetPaidTotalPrice;
+    property PayFormula: TPayFormula read FPayFormula;
   end;
 
 implementation
@@ -110,7 +114,10 @@ begin
   Rec := sddDealPayment.FindKey('idxID', AID);
   if Rec.ValueByName('RangePrice').AsFloat = 0 then Exit;
   fAllowPrice := Rec.ValueByName('RangePrice').AsFloat - Rec.ValueByName('TotalPrice').AsFloat;
-  Result := Min(fAllowPrice, ATotalPrice);
+  if not CheckReachPlan(Rec) then
+    Result := Min(fAllowPrice, ATotalPrice)
+  else
+    Result := fAllowPrice;
 end;
 
 function TDealPaymentData.GetNewID: Integer;
@@ -431,6 +438,11 @@ procedure TDealPaymentData.sdvDealPaymentSetText(var Text: string;
     begin
       Rec.ValueByName('Formula').AsString := '';
       AValue.Owner.ValueByName(sFField).AsString := '';
+      fTotalPrice := StrToFloatDef(Text, 0) - AValue.AsFloat;
+      if CheckStartedPrice(AID) then
+        Text := FloatToStr(AValue.AsFloat + GetAllowTotalPrice(AID, fTotalPrice))
+      else
+        Text := '';
     end
     else
     begin
@@ -637,4 +649,38 @@ begin
   Result := Rec.ValueByName('StartedPrice').AsFloat;
 end;
 
+function TDealPaymentData.CheckReachPlan(ARec: TsdDataRecord): Boolean;
+var
+  fCurValue, fDeadlineValue: Double;
+begin
+  Result := False;
+  if ARec.ValueByName('PlanType').AsInteger <> 0 then
+  begin
+    if ARec.ValueByName('PlanType').AsInteger = 1 then
+      fCurValue := TProjectData(FProjectData).ProjProperties.PhaseCount
+    else if ARec.ValueByName('PlanSubType').AsInteger = 0 then
+      fCurValue := TProjectData(FProjectData).BillsData.Settlement[4]
+    else if ARec.ValueByName('PlanSubType').AsInteger = 1 then
+      fCurValue := TProjectData(FProjectData).BillsData.Settlement[1]
+    else if ARec.ValueByName('PlanSubType').AsInteger = 2 then
+      fCurValue := TProjectData(FProjectData).BillsData.Settlement[2];
+    fDeadlineValue := ARec.ValueByName('PlanDeadline').AsFloat;
+    Result := fCurValue >= fDeadlineValue;
+  end;
+end;
+
+function TDealPaymentData.PlanStr(ARec: TsdDataRecord): string;
+begin
+  if ARec.ValueByName('PlanType').AsInteger = 0 then
+    Result := '无'
+  else if ARec.ValueByName('PlanType').AsInteger = 1 then
+    Result := Format('计量期数 >= %d', [ARec.ValueByName('PlanDeadline').AsInteger])
+  else if ARec.ValueByName('PlanSubType').AsInteger = 0 then
+    Result := Format('累计完成计量金额 >= %f', [ARec.ValueByName('PlanDeadline').AsFloat])
+  else if ARec.ValueByName('PlanSubType').AsInteger = 1 then
+    Result := Format('累计合同计量金额 >= %f', [ARec.ValueByName('PlanDeadline').AsFloat])
+  else if ARec.ValueByName('PlanSubType').AsInteger = 2 then
+    Result := Format('累计变更计量金额 >= %f', [ARec.ValueByName('PlanDeadline').AsFloat])
+end;
+
 end.

Forms/MainFrm.dfm

@@ -956,6 +956,12 @@ object MainForm: TMainForm
       Hint = #23450#20301
       Visible = ivAlways
     end
+    object dxbtnSetDealPayPlan: TdxBarButton
+      Caption = #35774#32622#35745#25552#26399#38480
+      Category = 0
+      Hint = #35774#32622#35745#25552#26399#38480
+      Visible = ivAlways
+    end
   end
   object Images: TImageList
     DrawingStyle = dsTransparent

Forms/MainFrm.pas

@@ -142,6 +142,7 @@ type
     dxbtnChangeDealBillsMode: TdxBarButton;
     dxsiExpandTo: TdxBarSubItem;
     dxbtnLocateBookmark: TdxBarButton;
+    dxbtnSetDealPayPlan: TdxBarButton;
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     procedure jtsProjectsChange(Sender: TObject; NewTab: Integer;

Frames/DealPaymentFme.dfm

@@ -119,6 +119,7 @@ object DealPaymentFrame: TDealPaymentFrame
       FrozenRow = 0
       OnCurrentChanged = zgDealPaymentCurrentChanged
       OnCanEditAcceptKey = zgDealPaymentCanEditAcceptKey
+      OnShowHint = zgDealPaymentShowHint
       OnCellGetColor = zgDealPaymentCellGetColor
       OnMouseDown = zgDealPaymentMouseDown
       Align = alClient
@@ -305,6 +306,10 @@ object DealPaymentFrame: TDealPaymentFrame
         BeginGroup = True
         Item = MainForm.dxbtnCalculatePhasePay
         Visible = True
+      end
+      item
+        Item = MainForm.dxbtnSetDealPayPlan
+        Visible = True
       end>
     UseOwnFont = False
     OnPopup = dxpmDealPaymentPopup
@@ -321,5 +326,10 @@ object DealPaymentFrame: TDealPaymentFrame
       OnExecute = actnCalculatePhasePayExecute
       OnUpdate = actnCalculatePhasePayUpdate
     end
+    object actnSetDealPayPlan: TAction
+      Caption = #35774#32622#35745#25552#26399#38480
+      Hint = #36798#21040#26465#20214#26102#65292#21363#21051#35745#37327#33267#20184'('#25187')'#27454#38480#39069
+      OnExecute = actnSetDealPayPlanExecute
+    end
   end
 end

Frames/DealPaymentFme.pas

@@ -23,6 +23,7 @@ type
     dxpmDealPayment: TdxBarPopupMenu;
     actnDealPayment: TActionList;
     actnCalculatePhasePay: TAction;
+    actnSetDealPayPlan: TAction;
     procedure zgParameterCellCanEdit(Sender: TObject; const ACoord: TPoint;
       var Allow: Boolean);
     procedure imgHelpClick(Sender: TObject);
@@ -41,6 +42,9 @@ type
     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);
   private
     FDealPaymentData: TDealPaymentData;
 
@@ -64,7 +68,7 @@ type
 implementation
 
 uses
-  MainFrm, UtilMethods, ProjectData, PhaseData;
+  MainFrm, UtilMethods, ProjectData, PhaseData, DealPayPlanFrm;
 
 {$R *.dfm}
 
@@ -151,6 +155,7 @@ end;
 procedure TDealPaymentFrame.dxpmDealPaymentPopup(Sender: TObject);
 begin
   SetDxBtnAction(actnCalculatePhasePay, MainForm.dxbtnCalculatePhasePay);
+  SetDxBtnAction(actnSetDealPayPlan, MainForm.dxbtnSetDealPayPlan);
 end;
 
 procedure TDealPaymentFrame.actnCalculatePhasePayExecute(Sender: TObject);
@@ -297,4 +302,62 @@ begin
             (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
+      ErrorMessage('该支付(扣款)项被锁定，不可修改！');
+      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 (zgDealPayment.Cells[ACoord.X, ACoord.Y].Text <> '') and Assigned(Rec) then
+      if FDealPaymentData.CheckReachPlan(Rec) then
+      begin
+        CanShow := True;
+        HintStr := '已达到计提期限，当前金额须一次性计提至限额' + #13#10 +
+            Format('计提期限为（%s）', [FDealPaymentData.PlanStr(Rec)]);
+      end;
+  end;
+end;
+
 end.

Units/DataBaseTables.pas

@@ -266,7 +266,7 @@ const
 
   {合同支付}
   SDealPayment = 'DealPayment';
-  tdDealPayment: array [0..14] of TScFieldDef =(
+  tdDealPayment: array [0..18] of TScFieldDef =(
     (FieldName: 'ID'; FieldType: ftInteger; Size: 0; NotNull: True; PrimaryKey: True; ForceUpdate: False),
     (FieldName: 'Name'; FieldType: ftString; Size: 200; NotNull: False; PrimaryKey: False; ForceUpdate: False),
     // 计算类型
@@ -288,6 +288,14 @@ const
     (FieldName: 'RangePrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
     // 限额 -- 公式
     (FieldName: 'RFormula'; FieldType: ftString; Size: 100; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 计提期限 -- 方式 0:无 1:计量期数 2:计量金额
+    (FieldName: 'PlanType'; FieldType: ftInteger; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 计提期限 -- 子方式(计量金额)  0:累计完成计量金额 1: 累计合同计量金额 2: 累计变更计量金额
+    (FieldName: 'PlanSubType'; FieldType: ftInteger; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 计提期限 -- 截止限定
+    (FieldName: 'PlanDeadline'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 计提期限 -- 截止限定 -- 计算公式
+    (FieldName: 'PDFormula'; FieldType: ftString; Size: 100; NotNull: False; PrimaryKey: False; ForceUpdate: False),
     // 锁定
     (FieldName: 'Locked'; FieldType: ftBoolean; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
     // 创建期数