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);
  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 GetAllowTotalPrice(AID: Integer; ATotalPrice: Double): Double;
    procedure UpdateTotalPrice(AID: Integer; ATotalPrice: Double);

    function GetStartedPrice(AID: Integer): Double;

    procedure CalcStarted_RangePrice;

    procedure ResetPhaseLink;
    procedure LockedData;

    property ProjectData: TObject read FProjectData;

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

implementation

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

{$R *.dfm}

{ TDealPaymentData }

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

constructor TDealPaymentData.Create(AProjectData: TObject);
begin
  inherited Create(nil);
  FProjectData := AProjectData;
  FPayFormula := TPayFormula.Create(FProjectData);
end;

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

function TDealPaymentData.GetAllowTotalPrice(AID: Integer;
  ATotalPrice: 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 - Rec.ValueByName('TotalPrice').AsFloat;
  Result := Min(fAllowPrice, ATotalPrice);
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);
  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
      Text := AValue.AsString;
      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
    AID: Integer;
    sTPField, sFField: string;
    fTotalPrice: Double;
  begin
    sTPField := 'TotalPrice' + IntToStr(TProjectData(FProjectData).PhaseData.StageIndex);
    sFField := 'Formula' + IntToStr(TProjectData(FProjectData).PhaseData.StageIndex);
    if CheckNumeric(ANewText) then
      APayRec.ValueByName(sTPField).AsString := ANewText
    else
    begin
      AID := ARecord.ValueByName('ID').AsInteger;
      APayRec.ValueByName(sFField).AsString := ANewText;
      ARecord.ValueByName('Formula').AsString := ANewText;
      fTotalPrice := FPayFormula.Calculate(ANewText);
      if CheckStartedPrice(AID) then
        APayRec.ValueByName(sTPField).AsFloat := GetAllowTotalPrice(AID, fTotalPrice);
    end;
  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 := 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 <> '') 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
    AID: Integer;
    sFField: string;
    fTotalPrice: Double;
    Rec: TsdDataRecord;
  begin
    Rec := 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 := '';
    end
    else
    begin
      Rec.ValueByName('Formula').AsString := Text;
      AValue.Owner.ValueByName(sFField).AsString := Text;
      AID := ARecord.ValueByName('ID').AsInteger;
      fTotalPrice := FPayFormula.Calculate(Text) - AValue.AsFloat;
      if CheckStartedPrice(AID) then
        Text := FloatToStr(AValue.AsFloat + GetAllowTotalPrice(AID, fTotalPrice))
      else
        Text := '';
    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;
  CheckLockedData;
  if not Allow then Exit;
  if SameText('StartedPrice', AValue.FieldName) then
    DoStartedPriceChanged;
  if SameText('RangePrice', AValue.FieldName) then
    DoRangePriceChanged;
  if Pos('TotalPrice', AValue.FieldName) = 1 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
  if TProjectData(FProjectData).ProjProperties.PhaseCount > 0 then Exit;
  for I := 0 to sddDealPayment.RecordCount - 1 do
  begin
    Rec := sddDealPayment.Records[I];
    if Rec.ValueByName('CalcType').AsInteger <> 0 then Continue;
    Rec.ValueByName('StartedPrice').AsFloat := FPayFormula.Calculate(Rec.ValueByName('SFormula').AsString);
    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;

end.