Measure/DataModules/PhasePayDm.pas

unit PhasePayDm;

interface

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

type
  TPhasePayData = class(TDataModule)
    sdpPhasePay: TsdADOProvider;
    sddPhasePay: TsdDataSet;
    procedure sddPhasePayBeforeValueChange(AValue: TsdValue;
      const NewValue: Variant; var Allow: Boolean);
    procedure sddPhasePayAfterValueChanged(AValue: TsdValue);
  private
    FPhaseData: TObject;
    FPayFormula: TPayFormula;

    FBeforeChangeTotalPrice: Double;
    FDecimal: TCalcDecimal;

    function CheckMinus(AID: Integer): Boolean;
    function GetFormula(AID: Integer): string;
    function GetCalcType(AID: Integer): Integer;
    function GetName(AID: Integer): string;

    function GetPayablePrice(AIndex: Integer): Double;

    procedure RepairPhaseRecord;

    procedure BeforeBatchOperation;
    procedure AfterBatchOperation;

    function GetCurPayable: Double;
    function GetLastestPhasePay(AType: Integer): Double;

    procedure SetFieldValidChar;
    function GetBqwc(AType: Integer): Double;
    function GetTableName: string;
  public
    constructor Create(APhaseData: TObject);
    destructor Destroy; override;

    procedure Open(AConnection: TADOConnection);
    procedure Save;

    function AddPayRecord(AID: Integer): TsdDataRecord;
    function PayRecord(AID: Integer): TsdDataRecord;
    procedure Delete(AID: Integer);

    procedure CalculateAll;
    procedure Calculate(AID: Integer);
    procedure CalculateCurPay;

    procedure UpdateDataForNewAudit;
    procedure CopyPrePhasePayData; overload;
    procedure CopyPrePhasePayData(const APreFile: string; APreFinalIndex: Integer); overload;

    property TableName: string read GetTableName;
    property PayablePrice[AIndex: Integer]: Double read GetPayablePrice;
    // 本期应付
    property CurPayable: Double read GetCurPayable;
    // AType表示不同类型，取值如下:
    // 1: 本期数据  2: 截止本期数据  3: 截止上期数据
    property LastestPhasePay[AType: Integer]: Double read GetLastestPhasePay;
    property Bqwc[AType: Integer]: Double read GetBqwc;
    property Decimal: TCalcDecimal read FDecimal;
  end;

implementation

uses
  PhaseData, ProjectData, DealPaymentDm, BillsDm, ConstUnit, UtilMethods;

{$R *.dfm}

{ TPhasePayData }

constructor TPhasePayData.Create(APhaseData: TObject);
begin
  inherited Create(nil);
  FPhaseData := APhaseData;
  FPayFormula := TPayFormula.Create(TPhaseData(FPhaseData).ProjectData);
  with TProjectData(TPhaseData(FPhaseData).ProjectData) do
  begin
    FPayFormula.Decimal := ProjProperties.DecimalManager.DealPay;
    FDecimal := ProjProperties.DecimalManager.DealPay;
  end;
end;

procedure TPhasePayData.Delete(AID: Integer);
begin
  sddPhasePay.Remove(sddPhasePay.FindKey('idxID', AID));
end;

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

procedure TPhasePayData.UpdateDataForNewAudit;
var
  iNewAudit, iIndex: Integer;
  Rec: TsdDataRecord;
begin
  BeforeBatchOperation;
  try
    iNewAudit := TPhaseData(FPhaseData).PhaseProperty.AuditCount;
    for iIndex := 0 to sddPhasePay.RecordCount - 1 do
    begin
      Rec := sddPhasePay.Records[iIndex];
      Rec.ValueByName('TotalPrice' + IntToStr(iNewAudit)).AsString :=
        Rec.ValueByName('TotalPrice' + IntToStr(iNewAudit - 1)).AsString;
      Rec.ValueByName('Formula' + IntToStr(iNewAudit)).AsString :=
        Rec.ValueByName('Formula' + IntToStr(iNewAudit - 1)).AsString;
      Rec.ValueByName('EndTotalPrice' + IntToStr(iNewAudit)).AsString :=
        Rec.ValueByName('EndTotalPrice' + IntToStr(iNewAudit - 1)).AsString;
      Rec.ValueByName('PreTotalPrice' + IntToStr(iNewAudit)).AsString :=
        Rec.ValueByName('PreTotalPrice' + IntToStr(iNewAudit - 1)).AsString;
    end;
  finally
    AfterBatchOperation;
  end;
end;

procedure TPhasePayData.Open(AConnection: TADOConnection);
begin
  sdpPhasePay.Connection := AConnection;
  sddPhasePay.Open;
  if not Assigned(sddPhasePay.IndexList.FindByName('idxID')) then
    sddPhasePay.AddIndex('idxID', 'ID');
  SetFieldValidChar;
  // 为适应旧项目处不计算合同支付值所做修改。
  if sddPhasePay.RecordCount = 0 then
  begin
    CopyPrePhasePayData;
    CalculateAll;
  end;
end;

procedure TPhasePayData.Save;
begin
  sddPhasePay.Save;
end;

function TPhasePayData.AddPayRecord(AID: Integer): TsdDataRecord;
begin
  Result := sddPhasePay.Add;
  Result.ValueByName('ID').AsInteger := AID;
end;

procedure TPhasePayData.sddPhasePayBeforeValueChange(AValue: TsdValue;
  const NewValue: Variant; var Allow: Boolean);
begin
  if not Assigned(AValue) then Exit;
  if Pos('TotalPrice', AValue.FieldName) = 1 then
    FBeforeChangeTotalPrice := AValue.AsFloat; 
end;

procedure TPhasePayData.sddPhasePayAfterValueChanged(AValue: TsdValue);
begin
  if Pos('TotalPrice', AValue.FieldName) = 1 then
  begin
    AValue.Owner.ValueByName('End' + AValue.FieldName).AsFloat := AValue.AsFloat
        + AValue.Owner.ValueByName('Pre' + AValue.FieldName).AsFloat;
    with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do
      UpdateTotalPrice(AValue.Owner.ValueByName('ID').AsInteger, AValue.AsFloat - FBeforeChangeTotalPrice);
  end;
  CalculateCurPay;
end;

procedure TPhasePayData.CalculateAll;
var
  iIndex: Integer;
  Rec: TsdDataRecord;
begin
  if TPhaseData(FPhaseData).StageDataReadOnly then Exit;

  RepairPhaseRecord;
  for iIndex := 0 to sddPhasePay.RecordCount - 1 do
  begin
    Rec := sddPhasePay.Records[iIndex];
    if GetCalcType(Rec.ValueByName('ID').AsInteger) in [0, 3] then
      Calculate(Rec.ValueByName('ID').AsInteger);
  end;
  CalculateCurPay;
end;

procedure TPhasePayData.Calculate(AID: Integer);
var
  Rec: TsdDataRecord;
  // 金额列名, 公式列名
  sTPField, sFField, sPreField: string;
  iID: Integer;
  fTotalPrice, fStartedPrice: Double;
begin
  Rec := sddPhasePay.FindKey('idxID', AID);
  sTPField := 'TotalPrice' + IntToStr(TPhaseData(FPhaseData).StageIndex);
  sFField := 'Formula' + IntToStr(TPhaseData(FPhaseData).StageIndex);
  sPreField := 'PreTotalPrice' + IntToStr(TPhaseData(FPhaseData).StageIndex);

  if not Rec.ValueByName('StopCalc').AsBoolean then
  begin
    iID := Rec.ValueByName('ID').AsInteger;
    with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do
    begin
      // 获取起扣金额
      fStartedPrice :=  GetStartedPrice(iID);

      if Rec.ValueByName(sFField).AsString <> '' then
      begin
        // 初次达到起扣金额时，bqwc基数值取值为累计完成计量-起扣金额
        if FDecimal.TotalPrice.RoundTo(Rec.ValueByName('Pre'+sTPField).AsFloat) = 0 then
          fTotalPrice := FPayFormula.Calculate(Rec.ValueByName(sFField).AsString, fStartedPrice)
        else
          fTotalPrice := FPayFormula.Calculate(Rec.ValueByName(sFField).AsString);
      end
      else
        fTotalPrice := 0;

      if CheckStartedPrice(iID) then
        Rec.ValueByName(sTPField).AsFloat := GetAllowTotalPrice(iID, fTotalPrice, Rec.ValueByName(sPreField).AsFloat)
      else
        Rec.ValueByName(sTPField).AsFloat := 0;
    end;
  end
  else
    Rec.ValueByName(sTPField).AsFloat := 0;

  {if Rec.ValueByName(sFField).AsString <> '' then
  begin
    with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do
    begin
      iID := Rec.ValueByName('ID').AsInteger;
      // 获取起扣金额
      fStartedPrice :=  GetStartedPrice(iID);
      // 初次达到起扣金额时，bqwc基数值取值为累计完成计量-起扣金额
      if Rec.ValueByName('Pre'+sTPField).AsFloat = 0 then
        fTotalPrice := FPayFormula.Calculate(Rec.ValueByName(sFField).AsString, fStartedPrice)
      else
        fTotalPrice := FPayFormula.Calculate(Rec.ValueByName(sFField).AsString);
      if CheckStartedPrice(iID) then
        Rec.ValueByName(sTPField).AsFloat := GetAllowTotalPrice(iID, fTotalPrice, Rec.ValueByName(sPreField).AsFloat)
      else
        Rec.ValueByName(sTPField).AsFloat := 0;
    end;
  end;}
  // 计算截止数据
  Rec.ValueByName('End' + sTPField).AsFloat := FDecimal.TotalPrice.RoundTo(Rec.ValueByName(sTPField).AsFloat
      + Rec.ValueByName('Pre' + sTPField).AsFloat);
  with TProjectData(TPhaseData(FPhaseData).ProjectData) do
    if StageDataReadOnly then
      DealPaymentData.SetTotalPrice(AID, Rec.ValueByName('End' + sTPField).AsFloat);
end;

function TPhasePayData.GetPayablePrice(AIndex: Integer): Double;
var
  iIndex: Integer;
  sTotalPriceField: string;
  Rec: TsdDataRecord;
begin
  Result := 0;
  // 阶段在0--14之间
  if (AIndex < 0) or (AIndex > iMaxStageCount-1) then Exit;

  sTotalPriceField := 'TotalPrice' + IntToStr(AIndex);
  for iIndex := 0 to sddPhasePay.RecordCount - 1 do
  begin
    Rec := sddPhasePay.Records[iIndex];
    if CheckMinus(Rec.ValueByName('ID').AsInteger) then
      Result := Result - Rec.ValueByName(sTotalPriceField).AsFloat
    else
      Result := Result + Rec.ValueByName(sTotalPriceField).AsFloat;
  end;
end;

function TPhasePayData.CheckMinus(AID: Integer): Boolean;
begin
  with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do
    Result := sddDealPayment.FindKey('idxID', AID).ValueByName('IsMinus').AsBoolean;
end;

function TPhasePayData.GetFormula(AID: Integer): string;
begin
  with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do
    Result := sddDealPayment.FindKey('idxID', AID).ValueByName('Formula').AsString;
end;

procedure TPhasePayData.AfterBatchOperation;
begin
  sddPhasePay.BeforeValueChange := sddPhasePayBeforeValueChange;
  sddPhasePay.AfterValueChanged := sddPhasePayAfterValueChanged;
  sddPhasePay.EndUpdate;
end;

procedure TPhasePayData.BeforeBatchOperation;
begin
  sddPhasePay.BeginUpdate;
  sddPhasePay.BeforeValueChange := nil;
  sddPhasePay.AfterValueChanged := nil;
end;

procedure TPhasePayData.CalculateCurPay;
var
  Rec: TsdDataRecord;
  sTPField: string;
  I: Integer;
begin
  sTPField := 'TotalPrice' + IntToStr(TPhaseData(FPhaseData).StageIndex);
  for I := 0 to sddPhasePay.RecordCount - 1 do
  begin
    Rec := sddPhasePay.Records[I];
    if GetCalcType(Rec.ValueByName('ID').AsInteger) = 1 then
    begin
      Rec.ValueByName(sTPField).AsFloat := CurPayable;
      Rec.ValueByName('End' + sTPField).AsFloat := Rec.ValueByName(sTPField).AsFloat
          + Rec.ValueByName('Pre' + sTPField).AsFloat;
      Break;
    end;
  end;
end;

function TPhasePayData.GetCurPayable: Double;
var
  Rec: TsdDataRecord;
  sTPField: string;
  i: Integer;
begin
  sTPField := 'TotalPrice' + IntToStr(TPhaseData(FPhaseData).StageIndex);
  Result := 0;
  for I := 0 to sddPhasePay.RecordCount - 1 do
  begin
    Rec := sddPhasePay.Records[I];
    // 检查是否为一般项
    if GetCalcType(Rec.ValueByName('ID').AsInteger) = 0 then
      if CheckMinus(Rec.ValueByName('ID').AsInteger) then
        Result := Result - Rec.ValueByName(sTPField).AsFloat
      else
        Result := Result + Rec.ValueByName(sTPField).AsFloat;
  end;
end;

function TPhasePayData.GetCalcType(AID: Integer): Integer;
var
  Rec: TsdDataRecord;
begin
  Result := 0;
  with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do
    Rec := sddDealPayment.FindKey('idxID', AID);
  if Assigned(Rec) then
    Result := Rec.ValueByName('CalcType').AsInteger;
end;

function TPhasePayData.GetLastestPhasePay(AType: Integer): Double;
var
  Rec: TsdDataRecord;
  sTPField: string;
  i: Integer;
begin
  case AType of
    1: sTPField := 'TotalPrice' + IntToStr(TPhaseData(FPhaseData).PhaseProperty.AuditCount);
    2: sTPField := 'EndTotalPrice' + IntToStr(TPhaseData(FPhaseData).PhaseProperty.AuditCount);
    3: sTPField := 'PreTotalPrice' + IntToStr(TPhaseData(FPhaseData).PhaseProperty.AuditCount);
  end;
  Result := 0;
  for i := 0 to sddPhasePay.RecordCount - 1 do
  begin
    Rec := sddPhasePay.Records[i];
    // 检查是否为一般项
    if GetCalcType(Rec.ValueByName('ID').AsInteger) = 0 then
      if CheckMinus(Rec.ValueByName('ID').AsInteger) then
        Result := Result - Rec.ValueByName(sTPField).AsFloat
      else
        Result := Result + Rec.ValueByName(sTPField).AsFloat;
  end;
end;

procedure TPhasePayData.CopyPrePhasePayData;
var
  iRecord: Integer;
  Rec, NewRec: TsdDataRecord;
begin
  BeforeBatchOperation;
  try
    if sddPhasePay.RecordCount > 0 then Exit;
    with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do
      for iRecord := 0 to sddDealPayment.RecordCount - 1 do
      begin
        Rec := sddDealPayment.Records[iRecord];
        NewRec := sddPhasePay.Add;
        NewRec.ValueByName('ID').AsInteger := Rec.ValueByName('ID').AsInteger;
        NewRec.ValueByName('EndTotalPrice0').AsFloat := Rec.ValueByName('TotalPrice').AsFloat;
        NewRec.ValueByName('PreTotalPrice0').AsFloat := Rec.ValueByName('TotalPrice').AsFloat;
        NewRec.ValueByName('Formula0').AsString := Rec.ValueByName('Formula').AsString;
        NewRec.ValueByName('StopCalc').AsBoolean := Rec.ValueByName('StopCalc').AsBoolean;
      end;
  finally
    AfterBatchOperation;
  end;
end;

procedure TPhasePayData.SetFieldValidChar;
var
  i: Integer;
  sField: string;
begin
  for i := 0 to iMaxStageCount - 1 do
  begin
    sField := 'TotalPrice' + IntToStr(i);
    sddPhasePay.FieldByName(sField).ValidChars := sddPhasePay.FieldByName(sField).ValidChars + ArithmeticCharSet + ExprsBaseCharSet;
  end;
end;

function TPhasePayData.PayRecord(AID: Integer): TsdDataRecord;
begin
  Result := sddPhasePay.FindKey('idxID', AID);
end;

procedure TPhasePayData.RepairPhaseRecord;
var
  i: Integer;
  vDealRec, vPhaseRec: TsdDataRecord;
begin
  // 旧设计中，DealPayment中数据多于PhasePay
  // 在于用户新增了合同支付项，但未输入金额或公式，以减少数据
  // 现，要求存在合同支付项，设置了计提期限，但未输入金额或公式时，达计提期限时，金额需计
  // 故在每次计算前，检查一遍合同支付数据，以兼容旧项目，并保证DealPayment与PhasePay数据行相同
  with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do
  begin
    if sddDealPayment.RecordCount > sddPhasePay.RecordCount then
    begin
      for i := 0 to sddDealPayment.RecordCount - 1 do
      begin
        vDealRec := sddDealPayment.Records[i];
        vPhaseRec := PayRecord(vDealRec.ValueByName('ID').AsInteger);
        if not Assigned(vPhaseRec) then
          vPhaseRec := AddPayRecord(vDealRec.ValueByName('ID').AsInteger);
      end;
    end;
  end;
end;

function TPhasePayData.GetBqwc(AType: Integer): Double;
var
  Rec: TsdDataRecord;
  sTPField: string;
  i: Integer;
begin
  case AType of
    1: sTPField := 'TotalPrice' + IntToStr(TPhaseData(FPhaseData).PhaseProperty.AuditCount);
    2: sTPField := 'EndTotalPrice' + IntToStr(TPhaseData(FPhaseData).PhaseProperty.AuditCount);
    3: sTPField := 'PreTotalPrice' + IntToStr(TPhaseData(FPhaseData).PhaseProperty.AuditCount);
  end;
  Result := 0;
  for i := 0 to sddPhasePay.RecordCount - 1 do
  begin
    Rec := sddPhasePay.Records[i];
    // 检查是否为一般项
    if GetName(Rec.ValueByName('ID').AsInteger) = '本期完成计量' then
    begin
      Result := Rec.ValueByName(sTPField).AsFloat;
      Break;
    end;
  end;
end;

function TPhasePayData.GetName(AID: Integer): string;
var
  Rec: TsdDataRecord;
begin
  Result := '';
  with TProjectData(TPhaseData(FPhaseData).ProjectData).DealPaymentData do
    Rec := sddDealPayment.FindKey('idxID', AID);
  if Assigned(Rec) then
    Result := Rec.ValueByName('Name').AsString;
end;

procedure TPhasePayData.CopyPrePhasePayData(const APreFile: string;
  APreFinalIndex: Integer);

  function CheckFormulaWithBase(AFormula: string): Boolean;
  var
    sFormula: string;
  begin
    sFormula := StringReplace(AFormula, 'htj', '', [rfReplaceAll, rfIgnoreCase]);
    sFormula := StringReplace(sFormula, 'kgyfk', '', [rfReplaceAll, rfIgnoreCase]);
    sFormula := StringReplace(sFormula, 'clyfk', '', [rfReplaceAll, rfIgnoreCase]);
    sFormula := StringReplace(sFormula, 'ybbqwc', '', [rfReplaceAll, rfIgnoreCase]);
    sFormula := StringReplace(sFormula, 'bqwc', '', [rfReplaceAll, rfIgnoreCase]);
    Result := Length(sFormula) < Length(AFormula);
  end;

const
  sCopySql = 'Insert Into %s (' +
             '    ID, PreTotalPrice0, EndTotalPrice0, Formula0, StopCalc' +
             '  ) Select ID, EndTotalPrice%d, EndTotalPrice%d, Formula%d, StopCalc' +
             ' From %s' +
             ' In ''%s''';
var
  sPre, sSql: string;
  i: Integer;
  vRec: TsdDataRecord;
  fValue: Double;
begin
  try
    sSql := Format(sCopySql, [TableName, APreFinalIndex, APreFinalIndex,
      APreFinalIndex, TableName, APreFile]);
    ExecuteSql(TPhaseData(FPhaseData).ADOConnection, sSql);
  finally
    sddPhasePay.Reload;
    for i := 0 to sddPhasePay.RecordCount - 1 do
    begin
      vRec := sddPhasePay.Records[i];
      if (not CheckFormulaWithBase(vRec.ValueByName('Formula0').AsString)) or (GetCalcType(vRec.ValueByName('ID').AsInteger) = 2) then
        vRec.ValueByName('Formula0').AsString := '';
    end;
  end;
end;

function TPhasePayData.GetTableName: string;
begin
  Result := sdpPhasePay.TableName;
end;

end.