Funcao - calculo de parcelamento

type

  TParcelas = record

    Data   : TDateTime;

    Valor  : Double;

    Entrada: Boolean;

  end;

  TParcelamento = record

    Parcelas   : array of TParcelas;

    Diferenca  : Double;

    VlrTotal   : Double;

    VlrParcela : Double;

    Taxa       : Double;

    QtdParcelas: Integer;

  end;

function IfFloat(const Condicao: Boolean; const RTrue, RFalse: Double): Double; overload;

begin

  if Condicao then Result := RTrue else Result := RFalse;

end;

{

  === Parametros de entrada

  VlrTotal      = Total geral das compras

  QParcelas     = Quantidade de parcelas (incluindo a entrada)

  PrimeiroVcto  = Data quando vence a primeira parcela

  VEntrada      = Valor da entrada se houver

  Periodicidade = 0 = Mensal, qualquer outro valor = quantidade de dias entre parcelas

  Taxa          = Taxa usada para calculo de juros

  ComEntrada    = Se True os calculos vão considerar ENTRADA a vista

  DataInicio    = Data a partir da qual é calculada juros, geralmente este parametro é Date

  Parcelamento  = Variável de saída que conterá os valores

  === Parametro de saída

  var

    P: TParcelamento;

  if CalculaParcelas(ValorEdit.GetValor  , ParcelasEdit.GetInteger   , PrimeiroVctoEdit.GetDate,

                     EntradaEdit.GetValor, PeriodicidadeEdit.GetValor, TaxaEdit.GetValor       ,

                     ComEntradaCheck.Checked, Now, P) then

  begin

    for I := 0 to P.QtdParcelas-1 do

      ParcelasMemo.Lines.Add(StrZero(I+1,2) + ' ' + IfThen(P.Parcelas[I].Entrada, 'ENTRADA', 'PARCELA') + '  -> ' +

                             FormatDateTime('DD/MM/YYYY DDD', P.Parcelas[I].Data) + ' ' +

                             AlinhaDir(P.Parcelas[I].Valor, 10));

    ParcelasMemo.Lines.Add('N. PARCELAS'        + AlinhaDir(IntToStr(P.QtdParcelas), 29));

    ParcelasMemo.Lines.Add('VALOR DA VENDA'     + AlinhaDir(ValorEdit.GetValor,26));

    ParcelasMemo.Lines.Add('DIF. FINANCIAMENTO' + AlinhaDir(P.Diferenca, 22)  + ' - TAXA: ' + Formata(P.Taxa) + '%');

    ParcelasMemo.Lines.Add('SOMA PARCELAS '     + AlinhaDir(#32 + Formata(P.VlrTotal),26, '.'));

  end;

}

function CalculaParcelas(const VlrTotal     : Double   ; const QParcelas : Integer;

                         const PrimeiroVcto : TDateTime; const VEntrada  : Double;

                         const Periodicidade: Double   ; const Taxa      : Double;

                         const ComEntrada   : Boolean  ; const DataInicio: TDateTime;

                         var Parcelamento: TParcelamento): Boolean;

var

  I, NParcelas : Integer;

  Data         : TDateTime;

  EntradaManual: Boolean;

  VlrEntrada, ValorTotal, ValorParcela, ValorCorrigido,

  TaxaPerioc, DifFinanc, TaxaCarencia: Double;

begin

  // Inicia variaveis

  Result        := False;

  NParcelas     := QParcelas;

  VlrEntrada    := VEntrada;

  ValorParcela  := 0; // só para não dar hint

  EntradaManual := (ComEntrada and (VlrEntrada > 0)); // usuário digitou valor de entrada

  // caso tenha colocado valor da entrada, tem 1 parcela entao arranca tudo

  if EntradaManual and (NParcelas = 1) then

  begin

    EntradaManual := False;

    VlrEntrada    := 0;

  end;

  ValorTotal := VlrTotal - VlrEntrada; // desconta do valor principal a entrada

  // na entrada manual os calculos de juros só se aplicam as parcelas (não na entrada)

  if EntradaManual then Dec(NParcelas);

  Data := PrimeiroVcto;

  // caso tenha entrada calculada pelo programa, é necessário voltar a data para saber a data da entrada

  if ComEntrada and (not EntradaManual) then

    if Periodicidade > 0 then

      Data := PrimeiroVcto - Periodicidade

    else

      Data := IncMonth(PrimeiroVcto,-1);

  // Calcular a taxa do periodo da periocidade

  TaxaPerioc     := ( Power( (Taxa/100) + 1, IfFloat(Periodicidade = 0, 30, Periodicidade)/30 ) -1 ) * 100;

  // Calcular a taxa centesimal at‚ o primeiro pagamento

  if (Periodicidade = 0) and (not ComEntrada) then

    TaxaCarencia := (Taxa / 100) + 1

  else

    TaxaCarencia := Power((Taxa/100) + 1, (Trunc(Data - Date)) / 30);

  // Atualizar o valor até a data do primeiro vcto pela taxa carencia

  ValorCorrigido := Arredonda( ValorTotal * TaxaCarencia, 2 );

  // Parcela

  if TaxaPerioc > 0 then

    ValorParcela := Arredonda( ValorCorrigido/(1+((Power((1+(TaxaPerioc/100)),(NParcelas-1))-1)/

                               (Power((1+(TaxaPerioc/100)),(NParcelas-1))*(TaxaPerioc/100)))),2)

  else

    if NParcelas > 0 then

      ValorParcela := Arredonda( ValorCorrigido / NParcelas, 2 );

  if (NParcelas = 1) and (Trunc(PrimeiroVcto) = Trunc(DataInicio)) then

  begin

    ValorParcela := VlrTotal;

  end;

  if (NParcelas > 0) and (ValorParcela <= 0) then

  begin

    msgErro('O valor das parcelas é inválido');

    Abort;

    Exit;

  end;

  Data := PrimeiroVcto;

  // caso tenha entrada calculada pelo programa, é necessário voltar a data para saber a data da entrada

  if ComEntrada and (not EntradaManual) then

    if Periodicidade > 0 then

      Data := PrimeiroVcto + Periodicidade

    else

      Data := IncMonth(PrimeiroVcto,1);

  DifFinanc := (Arredonda(ValorParcela,2) * NParcelas) - (VlrTotal - VlrEntrada);

  if EntradaManual then Inc(NParcelas); // quando o usuário digitou um valor tem que incrementar o numero de parcelas

  Parcelamento.Diferenca := DifFinanc;

  SetLength(Parcelamento.Parcelas, NParcelas);

  // aqui cria a LISTA de retorno

  for I := 1 to NParcelas do

  begin

    if (I = 1) and (ComEntrada) then Data := DataInicio; // Se a primeira parcela for ENTRADA, então data = hoje

    if (I = 2) and (ComEntrada) then Data := PrimeiroVcto;

    Parcelamento.Parcelas[I-1].Data := Data;

    // se foi passado pra cá SEM ENTRADA, mas a primeira parcela (data) é igual ao datainicio, entao tem entrada!

    if (I = 1) and (not ComEntrada) and (Trunc(Data) = Trunc(DataInicio)) then

    begin

      Parcelamento.Parcelas[I-1].Valor   := ValorParcela;

      Parcelamento.Parcelas[I-1].Entrada := True;

      Continue;

    end;

    if (I = 1) and (ComEntrada) and (VlrEntrada > 0) then

    begin

      Parcelamento.Parcelas[I-1].Valor   := VlrEntrada;

      Parcelamento.Parcelas[I-1].Entrada := True;

      Continue;

    end;

    if (I = 1) and (ComEntrada) and (VlrEntrada = 0) then

    begin

      Parcelamento.Parcelas[I-1].Valor   := ValorParcela;

      Parcelamento.Parcelas[I-1].Entrada := True;

    end

    else

    begin

      Parcelamento.Parcelas[I-1].Entrada := False;

      if (Taxa = 0) and (DifFinanc <> 0) and (I = NParcelas) then

        Parcelamento.Parcelas[I-1].Valor := ValorParcela - DifFinanc

      else

        Parcelamento.Parcelas[I-1].Valor := ValorParcela;

    end;

    // pega próxima data:

    if Periodicidade = 0 then Data := IncMonth(Data,1) else Data := Data + Trunc(Periodicidade);

  end;

  Parcelamento.QtdParcelas := NParcelas;

  if EntradaManual then Dec(NParcelas);

  Parcelamento.Diferenca   := (Arredonda(ValorParcela,2) * NParcelas)-(VlrTotal-VlrEntrada);

  Parcelamento.VlrParcela  := ValorParcela;

  Parcelamento.Taxa        := Taxa;

  Result                   := True;

  Parcelamento.VlrTotal    := 0;

  for I := 0 to Parcelamento.QtdParcelas-1 do

    Parcelamento.VlrTotal := Parcelamento.VlrTotal + Parcelamento.Parcelas[I].Valor;

  if (Taxa = 0) and (Parcelamento.Diferenca <> 0) then

  begin

    Parcelamento.VlrTotal := Parcelamento.VlrTotal - Parcelamento.Diferenca;

    Parcelamento.Diferenca := 0;

  end;

end;

---------------------------------- exemplo de uso ---------------------------

  TParcelasForm = class(TForm)

    ValorEdit: TAValor;

    ParcelasEdit: TAEdit;

    PrimeiroVctoEdit: TAData;

    EntradaEdit: TAValor;

    PeriodicidadeEdit: TAEdit;

    TaxaEdit: TAValor;

    ParcelasMemo: TMemo;

    ComEntradaCheck: TCheckBox;

    procedure FormShow(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure EntradaEditChange(Sender: TObject);

    procedure ComEntradaCheckKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

    procedure ParcelasEditExit(Sender: TObject);

  private

    procedure RecalculaTudo;

  end;

procedure TParcelasForm.RecalculaTudo;

var

  P: TParcelamento;

  I: Integer;

begin

  // Verifica possiveis erros

  msgInformaAbort(ParcelasEdit.GetInteger < 1              , 'Quantidade de pagamentos incorreta', ParcelasEdit);

  msgInformaAbort(EntradaEdit.GetValor > ValorEdit.GetValor, 'Valor de entrada muito alto'       , EntradaEdit);

  ParcelasMemo.Lines.Clear;

  if CalculaParcelas(ValorEdit.GetValor  , ParcelasEdit.GetInteger   , PrimeiroVctoEdit.GetDate,

                     EntradaEdit.GetValor, PeriodicidadeEdit.GetValor, TaxaEdit.GetValor       ,

                     ComEntradaCheck.Checked, Now, P) then

  begin

    for I := 0 to P.QtdParcelas-1 do

      ParcelasMemo.Lines.Add(StrZero(I+1,2) + ' ' + IfThen(P.Parcelas[I].Entrada, 'ENTRADA', 'PARCELA') + '  -> ' +

                             FormatDateTime('DD/MM/YYYY DDD', P.Parcelas[I].Data) + ' ' +

                             AlinhaDir(P.Parcelas[I].Valor, 10));

    ParcelasMemo.Lines.Add('N. PARCELAS'        + AlinhaDir(IntToStr(P.QtdParcelas), 29));

    ParcelasMemo.Lines.Add('VALOR DA VENDA'     + AlinhaDir(ValorEdit.GetValor,26));

    ParcelasMemo.Lines.Add('DIF. FINANCIAMENTO' + AlinhaDir(P.Diferenca, 22)  + ' - TAXA: ' + Formata(P.Taxa) + '%');

    ParcelasMemo.Lines.Add('SOMA PARCELAS '     + AlinhaDir(#32 + Formata(P.VlrTotal),26, '.'));

  end;

end;

// todos os componentes OnExit:  

procedure TParcelasForm.ParcelasEditExit(Sender: TObject);

begin

  RecalculaTudo;

end;