Measure/DataModules/DealPaymentDm.pas

unit DealPaymentDm;

interface

uses
  SysUtils, Classes, sdDB, sdProvider, ADODB, FormulaCalc, UtilMethods;

type
  TDealPaymentData = class(TDataModule)
    sdpDealPayment: TsdADOProvider;
    sddDealPayment: TsdDataSet;
    sdvDealPayment: TsdDataView;
    procedure sddDealPaymentAfterAddRecord(ARecord: TsdDataRecord);
    procedure sdvDealPaymentGetText(var Text: String;
      ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
      DisplayText: Boolean);
    procedure sdvDealPaymentNeedLookupRecord(ARecord: TsdDataRecord;
      AColumn: TsdViewColumn; ANewText: String);
    procedure sdvDealPaymentSetText(var Text: string;
      ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
      var Allow: Boolean);
    procedure sddDealPaymentBeforeAddRecord(ARecord: TsdDataRecord;
      var Allow: Boolean);
    procedure sddDealPaymentAfterValueChanged(AValue: TsdValue);
    procedure sddDealPaymentBeforeDeleteRecord(ARecord: TsdDataRecord;
      var Allow: Boolean);
    procedure sdvDealPaymentBeforeAddRecord(ARecord: TsdDataRecord;
      var Allow: Boolean);
  private
    FProjectData: TObject;
    FPayFormula: TPayFormula;

    procedure InitPredefinedPayItems;
    procedure RepairSerialNo;
    procedure RepairLockedFormula;

    function GetNewID: Integer;
    function GetNewSerialNo: Integer;

    function GetAddTotalPrice: Double;
    function GetCutTotalPrice: Double;
    function GetPaidTotalPrice: Double;
  public
    constructor Create(AProjectData: TObject);
    destructor Destroy; override;

    procedure Open(AConnection: TADOConnection);
    procedure Close;
    procedure Save;
    procedure Init;

    // 扣款项是否已达起扣金额
    function CheckStartedPrice(AID: Integer): Boolean;
    function CheckReachPlan(ARec: TsdDataRecord): Boolean;
    function GetAllowTotalPrice(AID: Integer; ATotalPrice, APreTotalPrice: Double): Double;
    procedure UpdateTotalPrice(AID: Integer; ATotalPrice: Double);
    procedure SetTotalPrice(AID: Integer; ATotalPrice: Double);

    function DealPayRecord(const AName: string): TsdDataRecord;

    function PlanStr(ARec: TsdDataRecord): string;

    function GetStartedPrice(AID: Integer): Double;

    procedure CalcStarted_RangePrice;

    procedure ResetPhaseLink;
    procedure LockedData;

    procedure UpdateLinkSerialNo;

    property ProjectData: TObject read FProjectData;

    // 扣款项，累计金额合计
    property CutTotalPrice: Double read GetCutTotalPrice;
    // 非扣款项，累计金额合计
    property AddTotalPrice: Double read GetAddTotalPrice;
    // 实付
    property PaidTotalPrice: Double read GetPaidTotalPrice;
    property PayFormula: TPayFormula read FPayFormula;
  end;

implementation

uses
  ProjectData, PhasePayDm, PhaseData, ZhAPI, BillsDm, Math, Variants,
  ProjectProperty;

{$R *.dfm}

{ TDealPaymentData }

function TDealPaymentData.CheckStartedPrice(AID: Integer): Boolean;
var
  Rec: TsdDataRecord;
begin
  Rec := sddDealPayment.FindKey('idxID', AID);
  with TProjectData(FProjectData).BillsData do
  begin
    if (Rec.ValueByName('StartedPrice').AsFloat = 0) then
      Result := True
    else
      Result := Settlement[AddGatherIndex] >= Rec.ValueByName('StartedPrice').AsFloat;
  end;
end;

constructor TDealPaymentData.Create(AProjectData: TObject);
begin
  inherited Create(nil);
  FProjectData := AProjectData;
  FPayFormula := TPayFormula.Create(FProjectData);
  with TProjectData(FProjectData) do
    FPayFormula.Decimal := ProjProperties.DecimalManager.DealPay;
end;

destructor TDealPaymentData.Destroy;
begin
  FPayFormula.Free;
  inherited;
end;

function TDealPaymentData.GetAllowTotalPrice(AID: Integer;
  ATotalPrice, APreTotalPrice: Double): Double;
var
  Rec: TsdDataRecord;
  fAllowPrice: Double;
begin
  Result := ATotalPrice;
  Rec := sddDealPayment.FindKey('idxID', AID);
  if Rec.ValueByName('RangePrice').AsFloat = 0 then Exit;
  fAllowPrice := Rec.ValueByName('RangePrice').AsFloat - APreTotalPrice;
  if not CheckReachPlan(Rec) then
    Result := Min(fAllowPrice, ATotalPrice)
  else
    Result := fAllowPrice;
end;

function TDealPaymentData.GetNewID: Integer;
var
  idx: TsdIndex;
begin
  idx := sddDealPayment.FindIndex('idxID');
  if idx.RecordCount > 0 then
    Result := idx.Records[idx.RecordCount - 1].ValueByName('ID').AsInteger + 1
  else
    Result := 1;
end;

procedure TDealPaymentData.Init;
begin
  if sddDealPayment.RecordCount > 0 then Exit;
  InitPredefinedPayItems;
end;

procedure TDealPaymentData.InitPredefinedPayItems;

  procedure AddPredefinedPayItem(const AItem: string);
  var
    sgsItem: TStrings;
    f: Double;
    Rec: TsdDataRecord;
  begin
    sgsItem := TStringList.Create;
    try
      sgsItem.Delimiter := ';';
      sgsItem.DelimitedText := AItem;
      if sgsItem.Count < 7 then Exit;

      Rec := sddDealPayment.Add;
      Rec.ValueByName('Name').AsString := sgsItem[0];
      Rec.ValueByName('CalcType').AsInteger := StrToIntDef(sgsItem[1], 0);
      Rec.ValueByName('IsMinus').AsBoolean := sgsItem[2] = '1';
      if TryStrToFloat(sgsItem[3], f) then
        Rec.ValueByName('StartedPrice').AsFloat := f
      else
        Rec.ValueByName('SFormula').AsString := sgsItem[3];
      if TryStrToFloat(sgsItem[4], f) then
        Rec.ValueByName('RangePrice').AsFloat := f
      else
        Rec.ValueByName('RFormula').AsString := sgsItem[4];
      Rec.ValueByName('Formula').AsString := sgsItem[5];
      if SameText(sgsItem[5], 'bqwc') then
        Rec.ValueByName('LockedFormula').AsBoolean := True;
      Rec.ValueByName('PreDefined').AsBoolean := StrToBoolDef(sgsItem[6], False);
    finally
      sgsItem.Free;
    end;
  end;

var
  sgsItems: TStrings;
  I: Integer;
begin
  sgsItems := TStringList.Create;
  try
    sgsItems.LoadFromFile(GetAppFilePath + 'DealPayment.txt');
    for I := 0 to sgsItems.Count - 1 do
      if sgsItems[I] <> '' then
        AddPredefinedPayItem(sgsItems[I]);
  finally
    sgsItems.Free;
  end;
end;

procedure TDealPaymentData.LockedData;
var
  iIndex: Integer;
  Rec: TsdDataRecord;
begin
  for iIndex := 0 to sddDealPayment.RecordCount - 1 do
  begin
    Rec := sddDealPayment.Records[iIndex];
    Rec.ValueByName('Locked').AsBoolean := True;
    if Rec.ValueByName('Formula').AsString <> '' then
      Rec.ValueByName('LockedFormula').AsBoolean := True;
  end;
end;

procedure TDealPaymentData.Open(AConnection: TADOConnection);
begin
  sdpDealPayment.Connection := AConnection;
  sddDealPayment.Open;
  RepairSerialNo;
  RepairLockedFormula;
  if not Assigned(sddDealPayment.IndexList.FindByName('idxID')) then
    sddDealPayment.AddIndex('idxID', 'ID');
  if not Assigned(sddDealPayment.IndexList.FindByName('idxView')) then
    sddDealPayment.AddIndex('idxView', 'SerialNo');
  // 开始计量前，CutTotalPrice链接至TotalPrice，已解决无计量数据时无法输入问题
  sddDealPayment.FieldByName('TotalPrice').ValidChars := sddDealPayment.FieldByName('TotalPrice').ValidChars + ArithmeticCharSet + ExprsBaseCharSet;
  sddDealPayment.FieldByName('StartedPrice').ValidChars := sddDealPayment.FieldByName('StartedPrice').ValidChars + ArithmeticCharSet + ExprsExceptCharSet;
  sddDealPayment.FieldByName('RangePrice').ValidChars := sddDealPayment.FieldByName('RangePrice').ValidChars + ArithmeticCharSet + ExprsExceptCharSet;
  sdvDealPayment.Open;
  sdvDealPayment.IndexName := 'idxView';
end;

procedure TDealPaymentData.ResetPhaseLink;
begin
  with TProjectData(FProjectData).PhaseData do
  begin
    sdvDealPayment.Columns.FindColumn('CurTotalPrice').LookupDataSet := PhasePayData.sddPhasePay;
    sdvDealPayment.Columns.FindColumn('CurTotalPrice').LookupResultField := 'TotalPrice' + IntToStr(StageIndex);
    sdvDealPayment.Columns.FindColumn('EndTotalPrice').LookupDataSet := PhasePayData.sddPhasePay;
    sdvDealPayment.Columns.FindColumn('EndTotalPrice').LookupResultField := 'EndTotalPrice' + IntToStr(StageIndex);
  end;
end;

procedure TDealPaymentData.Save;
begin
  sddDealPayment.Save;
end;

procedure TDealPaymentData.sddDealPaymentAfterAddRecord(
  ARecord: TsdDataRecord);
var
  iSerialNo: Integer;
begin
  iSerialNo := GetNewSerialNo;
  ARecord.ValueByName('ID').AsInteger := GetNewID;
  ARecord.ValueByName('SerialNo').AsInteger := iSerialNo;
  ARecord.ValueByName('CreatePhaseID').AsInteger := TProjectData(FProjectData).PhaseIndex;
end;

procedure TDealPaymentData.sdvDealPaymentGetText(var Text: String;
  ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  DisplayText: Boolean);

  procedure GetDisplayText;
  begin
    if not Assigned(AValue) or
        ((Pos('Price', AValue.FieldName) > 0) and (AValue.AsFloat = 0)) then
      Text := '';
  end;

  function GetFormulaField(const APriceField: string): string;
  begin
    if SameText(APriceField, 'StartedPrice') then
      Result := 'SFormula'
    else if SameText(APriceField, 'RangePrice') then
      Result := 'RFormula'
    else if SameText(APriceField, 'CurTotalPrice') then
      Result := 'Formula'
    else if Pos('TotalPrice', APriceField) = 1 then
      Result := StringReplace(AValue.FieldName, 'TotalPrice', 'Formula', []);
  end;

  procedure GetStageEditText;
  var
    sField, sFormula: string;
  begin
    if Assigned(AValue) then
    begin
      sField := GetFormulaField(AValue.FieldName);
      sFormula := AValue.Owner.ValueByName(sField).AsString;
      if (sField <> '') and (sFormula <> '') then
        Text:= sFormula;
    end
    else
      Text := '';
  end;

  procedure GetMainEditText;
  var
    sField, sFormula: string;
  begin
    sField := GetFormulaField(AColumn.FieldName);
    if (sField <> '') then
    begin
      sFormula := ARecord.ValueByName(sField).AsString;
      if (sFormula <> '') then
        Text := sFormula;
    end
    else
      Text := '';
  end;

begin
  if Pos('Price', AColumn.FieldName)> 0 then
  begin
    if DisplayText then
      GetDisplayText
    else if TProjectData(FProjectData).PhaseIndex > 0 then
      GetStageEditText
    else
      GetMainEditText;
  end;
end;

procedure TDealPaymentData.sdvDealPaymentNeedLookupRecord(
  ARecord: TsdDataRecord; AColumn: TsdViewColumn; ANewText: String);

  procedure SetNewRecData(APayRec: TsdDataRecord);
  var
    iID: Integer;
    sTPField, sFField: string;
    fTotalPrice, fAllow: Double;
  begin
    sTPField := 'TotalPrice' + IntToStr(TProjectData(FProjectData).PhaseData.StageIndex);
    sFField := 'Formula' + IntToStr(TProjectData(FProjectData).PhaseData.StageIndex);
    if CheckNumeric(ANewText) then
    begin
      APayRec.ValueByName(sFField).AsString := ANewText;
      fTotalPrice := StrToFloat(ANewText);
    end
    else
    begin
      APayRec.ValueByName(sFField).AsString := ANewText;
      ARecord.ValueByName('Formula').AsString := ANewText;
      fTotalPrice := FPayFormula.Calculate(ANewText, ARecord.ValueByName('StartedPrice').AsFloat);
    end;
    iID := ARecord.ValueByName('ID').AsInteger;
    if CheckStartedPrice(iID) then
    begin
      fAllow := GetAllowTotalPrice(iID, fTotalPrice, 0);
      APayRec.ValueByName(sTPField).AsFloat := fAllow;
      if fAllow < fTotalPrice then
        TipMessage(Format('“%s”已达扣款限额，本期金额计%s。', [ARecord.ValueByName('Name').AsString, FloatToStr(fAllow)]))
      else if fAllow > fTotalPrice then
        TipMessage(Format('“%s”已达计提期限，本期金额计%s。', [ARecord.ValueByName('Name').AsString, FloatToStr(fAllow)]));
    end
    else
      TipMessage(Format('“%s”未达到起扣金额，本期金额计零。', [ARecord.ValueByName('Name').AsString]));
  end;

var
  NewRec: TsdDataRecord;
begin
  if SameText(AColumn.FieldName, 'CurTotalPrice') then
  begin
    with TProjectData(FProjectData).PhaseData.PhasePayData do
      NewRec := AddPayRecord(ARecord.ValueByName('ID').AsInteger);
    SetNewRecData(NewRec);
  end;
end;

procedure TDealPaymentData.sdvDealPaymentSetText(var Text: string;
  ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  var Allow: Boolean);

  procedure CheckLockedData;
  var
    Rec: TsdDataRecord;
    sFormula: string;
  begin
    Rec := ARecord;//sddDealPayment.FindKey('idxID', ARecord.ValueByName('ID').AsInteger);
    if Rec.ValueByName('CalcType').AsInteger = 1 then
    begin
      if SameText(AValue.FieldName, 'Name') or
          SameText(AValue.FieldName, 'IsMinus') or
          (Pos('TotalPrice', AValue.FieldName) > 0) or
          SameText(AValue.FieldName, 'StartedPrice') or
          SameText(AValue.FieldName, 'RangePrice') then
        DataSetErrorMessage(Allow, '固定项不可修改！');
    end;
    if not Allow then Exit;

    if Rec.ValueByName('LockedFormula').AsBoolean then
    begin
      if (Pos('TotalPrice', AValue.FieldName) = 1) and
         (Rec.ValueByName('Formula').AsString <> '') and
         (Rec.ValueByName('CalcType').AsInteger <> 2) then
      begin
        // 如果有公式计算，如果是纯数学计算式，则可设置，基数计算，则不可
        sFormula := Rec.ValueByName('Formula').AsString;
        if (Pos('bqwc', sFormula)>0) or (Pos('htj', sFormula)>0) or
           (Pos('kgyfk', sFormula)>0) or (Pos('clyfk', sFormula)>0) then
          DataSetErrorMessage(Allow, '该支付(扣款)项已设置基数计算公式且被锁定，不可修改！');
      end;
    end;
    if not Allow then Exit;

    if Rec.ValueByName('Locked').AsBoolean then
    begin
      if SameText(AValue.FieldName, 'StartedPrice') then
        DataSetErrorMessage(Allow, '该支付(扣款)项的起扣金额被锁定，不可修改！')
      else if SameText(AValue.FieldName, 'RangePrice') then
        DataSetErrorMessage(Allow, '该支付(扣款)项的付(扣)款限额被锁定，不可修改！')
      else if SameText(AValue.FieldName, 'Name') or SameText(AValue.FieldName, 'IsMinus') then
        DataSetErrorMessage(Allow, '该项已被锁定，不可修改！');
    end;
  end;

  procedure DoStartedPriceChanged;
  begin
    if AValue.Owner.ValueByName('TotalPrice').AsFloat <> 0 then
      DataSetErrorMessage(Allow, '该付(扣)款金额已经计量，不可修改起扣金额！');
    if not Allow then Exit;

    if CheckStringNull(Text) or CheckNumeric(Text) then
      AValue.Owner.ValueByName('SFormula').AsString := ''
    else if Pos('bqwc', Text) = 0 then
    begin
      AValue.Owner.ValueByName('SFormula').AsString := Text;
      Text := FloatToStr(FPayFormula.Calculate(Text));
    end
    else
      DataSetErrorMessage(Allow, '起扣金额不可引用“本期计算价”进行计算！');
  end;

  procedure DoRangePriceChanged;
  begin
    if AValue.Owner.ValueByName('TotalPrice').AsFloat <> 0 then
      DataSetErrorMessage(Allow, '该付(扣)款金额已经计量，不可修改付(扣)款限额！');
    if not Allow then Exit;

    if CheckStringNull(Text) or CheckNumeric(Text) then
      AValue.Owner.ValueByName('RFormula').AsString := ''
    else if Pos('bqwc', Text) = 0 then
    begin
      AValue.Owner.ValueByName('RFormula').AsString := Text;
      Text := FloatToStr(FPayFormula.Calculate(Text));
    end
    else
      DataSetErrorMessage(Allow, '付(扣)款限额不可引用“本期计算价”进行计算！');
  end;

  procedure DoCurTotalPriceChanged;
  var
    iID: Integer;
    sFField, sPreField: string;
    fTotalPrice, fAllow: Double;
    Rec: TsdDataRecord;
  begin
    Rec := ARecord;//sddDealPayment.FindKey('idxID', ARecord.ValueByName('ID').AsInteger);
    sFField := StringReplace(AValue.FieldName, 'TotalPrice', 'Formula', []);
    if CheckStringNull(Text) or CheckNumeric(Text) then
    begin
      Rec.ValueByName('Formula').AsString := '';
      AValue.Owner.ValueByName(sFField).AsString := Text;
      fTotalPrice := StrToFloatDef(Text, 0);
    end
    else
    begin
      Rec.ValueByName('Formula').AsString := Text;
      AValue.Owner.ValueByName(sFField).AsString := Text;
      if AValue.Owner.ValueByName('Pre' + AValue.FieldName).AsFloat = 0 then
        fTotalPrice := FPayFormula.Calculate(Text, Rec.ValueByName('StartedPrice').AsFloat)
      else
        fTotalPrice := FPayFormula.Calculate(Text);
    end;

    if AValue.Owner.ValueByName('StopCalc').AsBoolean then
    begin
      fTotalPrice := 0;
      Text := '';
    end
    else
    begin
      iID := ARecord.ValueByName('ID').AsInteger;
      if CheckStartedPrice(iID) then
      begin
        sPreField := StringReplace(AValue.FieldName, 'TotalPrice', 'PreTotalPrice', []);
        fAllow := GetAllowTotalPrice(iID, fTotalPrice, AValue.Owner.ValueByName(sPreField).AsFloat);
        Text := FloatToStr(fAllow);
        if fAllow < fTotalPrice then
          TipMessage(Format('“%s”已达扣款限额，本期金额计%s。', [Rec.ValueByName('Name').AsString, Text]))
        else if fAllow > fTotalPrice then
          TipMessage(Format('“%s”已达计提期限，本期金额计%s。', [Rec.ValueByName('Name').AsString, Text]));
      end
      else
      begin
        Text := '';
        TipMessage(Format('“%s”未达到起扣金额，本期金额计零。', [Rec.ValueByName('Name').AsString]));
      end;
    end;
  end;

  procedure DoLedgerFormulaChanged;
  begin
    if CheckStringNull(Text) or CheckNumeric(Text) then
      ARecord.ValueByName('Formula').AsString := ''
    else
      ARecord.ValueByName('Formula').AsString := Text;
    Text := '';
  end;

begin
  if not Assigned(AValue) then Exit;

  Text := Trim(Text);
  if SameText('Name', AValue.FieldName) and (Text = '') then
  begin
    ErrorMessage('合同支付项名称不允许为空，如需删除，请点击右键进行删除');
    Allow := False;
    Exit;
  end;

  CheckLockedData;
  if not Allow then Exit;

  if SameText('StartedPrice', AValue.FieldName) then
    DoStartedPriceChanged;
  if SameText('RangePrice', AValue.FieldName) then
    DoRangePriceChanged;
  if SameText('CurTotalPrice', AColumn.FieldName) then
    if TProjectData(FProjectData).ProjProperties.PhaseCount > 0 then
      DoCurTotalPriceChanged
    else
      DoLedgerFormulaChanged;
end;

procedure TDealPaymentData.UpdateTotalPrice(AID: Integer;
  ATotalPrice: Double);
var
  Rec: TsdDataRecord;
begin
  Rec := sddDealPayment.FindKey('idxID', AID);
  Rec.ValueByName('TotalPrice').AsFloat := Rec.ValueByName('TotalPrice').AsFloat + ATotalPrice;
end;

procedure TDealPaymentData.sddDealPaymentBeforeAddRecord(
  ARecord: TsdDataRecord; var Allow: Boolean);
begin
{  if ARecord.ValueByName('Name').AsString = '' then
    Allow := False;}
end;

procedure TDealPaymentData.CalcStarted_RangePrice;
var
  I: Integer;
  Rec: TsdDataRecord;
begin
  with TProjectData(FProjectData).ProjProperties do
    if (PhaseCount > 1) or ((PhaseCount = 1) and (AuditStatus <> 0)) then Exit;
  for I := 0 to sddDealPayment.RecordCount - 1 do
  begin
    Rec := sddDealPayment.Records[I];
    if Rec.ValueByName('CalcType').AsInteger <> 0 then Continue;
    if Rec.ValueByName('SFormula').AsString <> '' then
      Rec.ValueByName('StartedPrice').AsFloat := FPayFormula.Calculate(Rec.ValueByName('SFormula').AsString);
    if Rec.ValueByName('RFormula').AsString <> '' then
      Rec.ValueByName('RangePrice').AsFloat := FPayFormula.Calculate(Rec.ValueByName('RFormula').AsString);
  end;
end;

procedure TDealPaymentData.sddDealPaymentAfterValueChanged(
  AValue: TsdValue);
begin
  if SameText('IsMinus', AValue.FieldName) then
    TProjectData(FProjectData).PhaseData.PhasePayData.CalculateCurPay;
end;

function TDealPaymentData.GetAddTotalPrice: Double;
var
  iIndex: Integer;
  Rec: TsdDataRecord;
begin
  Result := 0;
  for iIndex := 0 to sddDealPayment.RecordCount - 1 do
  begin
    Rec := sddDealPayment.Records[iIndex];
    if (Rec.ValueByName('CalcType').AsInteger = 0) and not Rec.ValueByName('IsMinus').AsBoolean then
      Result := Result + Rec.ValueByName('TotalPrice').AsFloat;
  end;
end;

function TDealPaymentData.GetCutTotalPrice: Double;
var
  iIndex: Integer;
  Rec: TsdDataRecord;
begin
  Result := 0;
  for iIndex := 0 to sddDealPayment.RecordCount - 1 do
  begin
    Rec := sddDealPayment.Records[iIndex];
    if (Rec.ValueByName('CalcType').AsInteger = 0) and Rec.ValueByName('IsMinus').AsBoolean then
      Result := Result + Rec.ValueByName('TotalPrice').AsFloat;
  end;
end;

function TDealPaymentData.GetPaidTotalPrice: Double;
var
  Rec: TsdDataRecord;
begin
  Rec := sddDealPayment.Locate('CalcType', 2);
  if Assigned(Rec) then
    Result := Rec.ValueByName('TotalPrice').AsFloat
  else
    Result := 0;
end;

procedure TDealPaymentData.sddDealPaymentBeforeDeleteRecord(
  ARecord: TsdDataRecord; var Allow: Boolean);
begin
  if ARecord.ValueByName('Locked').AsBoolean then
    DataSetErrorMessage(Allow, '该支付（扣款）项已锁定，不可删除！')
  else if ARecord.ValueByName('PreDefined').AsBoolean then
    DataSetErrorMessage(Allow, '此项为预定义项，不允许删除！')
  else if ARecord.ValueByName('TotalPrice').AsFloat <> 0 then
    DataSetErrorMessage(Allow, '该支付（扣款）项存在数据，如需删除请先清除本期金额！');
    
  if Allow and TProjectData(FProjectData).PhaseData.Active then
    TProjectData(FProjectData).PhaseData.PhasePayData.Delete(ARecord.ValueByName('ID').AsInteger);
end;

procedure TDealPaymentData.Close;
begin
  sddDealPayment.Close;
end;

procedure TDealPaymentData.RepairSerialNo;
var
  Rec: TsdDataRecord;
  iRec: Integer;
begin
  if sddDealPayment.RecordCount = 0 then Exit;
  Rec := sddDealPayment.Records[0];
  if Rec.ValueByName('SerialNo').AsString = '' then
  begin
    for iRec := 0 to sddDealPayment.RecordCount - 1 do
    begin
      Rec := sddDealPayment.Records[iRec];
      Rec.ValueByName('SerialNo').AsInteger := iRec;
    end;
  end;
end;

function TDealPaymentData.GetNewSerialNo: Integer;
var
  idx: TsdIndex;
begin
  idx := sddDealPayment.FindIndex('idxView');
  if idx.RecordCount > 0 then
    Result := idx.Records[idx.RecordCount - 1].ValueByName('SerialNo').AsInteger + 1
  else
    Result := 1;
end;

procedure TDealPaymentData.RepairLockedFormula;

  function CheckHasRepair: Boolean;
  var
    iRec: Integer;
    Rec: TsdDataRecord;
  begin
    Result := True;
    for iRec := 0 to sddDealPayment.RecordCount - 1 do
    begin
      Rec := sddDealPayment.Records[iRec];
      if Rec.ValueByName('Locked').AsBoolean and
        (Rec.ValueByName('Formula').AsString <> '') and (Rec.ValueByName('LockedFormula').AsBoolean) then
      begin
          Result := False;
          Break;
      end;
    end;
  end;

var
  iRec: Integer;
  Rec: TsdDataRecord;
begin
  if sddDealPayment.RecordCount = 0 then Exit;
  if CheckHasRepair then
  begin
    for iRec := 0 to sddDealPayment.RecordCount - 1 do
    begin
      Rec := sddDealPayment.Records[iRec];
      if Rec.ValueByName('Locked').AsBoolean and (Rec.ValueByName('Formula').AsString <> '') then
        Rec.ValueByName('LockedFormula').AsBoolean := True;
    end;
  end;
end;

function TDealPaymentData.GetStartedPrice(AID: Integer): Double;
var
  Rec: TsdDataRecord;
begin
  Rec := sddDealPayment.FindKey('idxID', AID);
  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;

procedure TDealPaymentData.UpdateLinkSerialNo;
var
  iPay, iCut, iIndex: Integer;
  Rec: TsdDataRecord;
begin
  iPay := 1;
  iCut := 1;
  for iIndex := 0 to sdvDealPayment.RecordCount - 1 do
  begin
    Rec := sdvDealPayment.Records[iIndex];
    if Rec.ValueByName('CalcType').AsInteger = 0 then
    begin
      if Rec.ValueByName('IsMinus').AsBoolean then
      begin
        Rec.ValueByName('LinkSerialNo').AsInteger := iCut;
        Inc(iCut);
      end
      else
      begin
        Rec.ValueByName('LinkSerialNo').AsInteger := iPay;
        Inc(iPay);
      end;
    end;
  end;
end;

function TDealPaymentData.DealPayRecord(
  const AName: string): TsdDataRecord;
var
  iRec: Integer;
  Rec: TsdDataRecord;
begin
  Result := nil;
  for iRec := 0 to sddDealPayment.RecordCount - 1 do
  begin
    Rec := sddDealPayment.Records[iRec];
    if SameText(AName, Rec.ValueByName('Name').AsString) then
    begin
      Result := Rec;
      Break;
    end;
  end;
end;

procedure TDealPaymentData.sdvDealPaymentBeforeAddRecord(
  ARecord: TsdDataRecord; var Allow: Boolean);
begin
  Allow := VarToStrDef(ARecord.ValueByName('Name').CachedValue, '') <> '';
end;

procedure TDealPaymentData.SetTotalPrice(AID: Integer;
  ATotalPrice: Double);
var
  Rec: TsdDataRecord;
begin
  Rec := sddDealPayment.FindKey('idxID', AID);
  Rec.ValueByName('TotalPrice').AsFloat := ATotalPrice;
end;

end.