Fórum Parcela com data de vencimento fixa #586859

18/10/2017

0

Bom dia, estou com problema de gerar a parcela com data de vencimento fixo, por exemplo sempre no dia 16 de cadas mês, para gerar o pagamento a vista e com vencimento a cada 30 dias, está gerando corretamente, só a data fixa não está, vou colocar o código do botão inteiro abaixo.

procedure TfrmCadastro_Contas_a_Pagar.acGera_ParcelasExecute(Sender: TObject);
var I,Parcelas: Integer;
Dia_Data_Compra, Dia_Vencimento, Mes, Ano, Hoje: Integer;
Data_vencimento, Juncao_Dia_Mes_Ano: string;

begin
i := 0;
Parcelas = 0;
mes := 0;
ano := 0;
hoje := 0;
Dia_Vencimento := 0;
dia_data_compra := 0;
Juncao_Dia_Mes_Ano := '';

if (lbledtNumero_Doc.Text = '') then
begin

Application.MessageBox('Preencha o Campo Número de Documento!','Atenção...', MB_OK + MB_ICONWARNING);
lbledtNumero_Doc.SetFocus;
Abort;

end;

if (edtqtde_parcelas.Text = '') then
begin

Application.MessageBox('Preencha o Campo Qtde Parcelas!','Atenção...', MB_OK + MB_ICONWARNING);
edtqtde_parcelas.SetFocus;
Abort;

end;

if (StrToInt(edtqtde_parcelas.Text) = 0) then
begin

Application.MessageBox('O Campo tem que ser maior que 0 (ZERO)!','Atenção...', MB_OK + MB_ICONWARNING);
edtqtde_parcelas.SetFocus;
Abort;

end;

if (rgrpData_Vencimento.ItemIndex = -1) then
begin

Application.MessageBox('Preencha o Campo Data de Vencimento!','Atenção...', MB_OK + MB_ICONWARNING);
Abort;

end;

if edtDia_Vencimento.Enabled = True then
begin

if edtDia_Vencimento.Text = '' then
begin

Application.MessageBox('Preencha o Campo Dia Vencimento!','Atenção...', MB_OK + MB_ICONWARNING);
edtDia_Vencimento.SetFocus;
Abort;

end;

if StrtoFloat (edtDia_Vencimento.Text) < 1 then
begin

Application.MessageBox('Preencha o Campo Dia Vencimento!','Atenção...', MB_OK + MB_ICONWARNING);
edtDia_Vencimento.SetFocus;
Abort;

end;

end;

if StringParaFloat (edtValor_Compra.Text) < 1 then
begin
Application.MessageBox('Preencha o Campo Valor da parcela, não pode ser 0,00 (ZERO)!','Atenção...', MB_OK + MB_ICONWARNING);
lbledtDescricao.SetFocus;
Abort;
end;


if edtData_Compra.Text = '' then
begin
Application.MessageBox('Preencha o Campo Data Compra!','Atenção...', MB_OK + MB_ICONWARNING);
lbledtDescricao.SetFocus;
Abort;
end;

cdsParcelas.EmptyDataSet;

for I := 1 to StrToInt(edtQtde_Parcelas.Text) do
begin
cdsParcelas.Insert;
cdsParcelasParcelas.AsInteger := i;
cdsParcelasValor.AsCurrency := StringParaFloat(edtValor_Compra.Text) / StrToInt(edtQtde_Parcelas.Text);

if rgrpData_Vencimento.ItemIndex = 0 then
begin

cdsParcelasVencimento.AsDateTime := StrToDate(edtData_Compra.Text);

end;

if rgrpData_Vencimento.ItemIndex = 1 then
begin

cdsParcelasVencimento.AsDateTime := StrToDate(edtData_Compra.Text) + (Variacao * i);

end;

if rgrpData_Vencimento.ItemIndex = 2 then
begin

Dia_Vencimento := StrToInt(edtDia_Vencimento.Text);
Mes := MonthOf(now);
Ano := YearOf(now);
Dia_Data_Compra := (DayOf(StrToDate(edtData_Compra.Text)));
Juncao_Dia_Mes_Ano := IntToStr(dia_vencimento) + '/' + IntToStr(mes) + '/' + IntToStr(ano);

for Parcelas := 1 to StrToInt(edtQtde_Parcelas.Text) do

begin
if Parcelas = 1 then
begin

cdsParcelasVencimento.AsDateTime := IncMonth(StrToDate(Juncao_Dia_Mes_Ano),0);

end
else
begin

cdsParcelasVencimento.AsDateTime := IncMonth(StrToDate(Juncao_Dia_Mes_Ano),1);

end;
end;

end;

cdsParcelas.Post;

end;

end;
Marcelo Duarte

Marcelo Duarte

Responder

Posts

18/10/2017

Luiz Vichiatto

A primeira parcela você está incrementando sem necessidade.
O Vencimento da parcela 1 você já informou, então não tem necessidade de incrementar a parcela.

Juncao_Dia_Mes_Ano := IntToStr(dia_vencimento) + '/' + IntToStr(mes) + '/' + IntToStr(ano);
for Parcelas := 1 to StrToInt(edtQtde_Parcelas.Text) do
begin
	if Parcelas = 1 then
	begin
		//cdsParcelasVencimento.AsDateTime := IncMonth(StrToDate(Juncao_Dia_Mes_Ano),0);
		cdsParcelasVencimento.AsDateTime := StrToDate(Juncao_Dia_Mes_Ano);
	end
	else
	begin
		cdsParcelasVencimento.AsDateTime := IncMonth(StrToDate(Juncao_Dia_Mes_Ano),1);
	end;
end;
Responder

Gostei + 0

18/10/2017

Marcelo Duarte

Bom dia, fiz a alteração que me solicitou, ainda apresenta erros.

Segue o link do Screenshot da tela do sistema com as parcelas repetidas, ele está apresentando um erro em Verificar a divisão do Valor da Compra pela Quantidade de parcelas, tem resto, pois ele está passando 0,02 Centavos para as parcelas fiz as alterações depois de criar o post, se puder me ajudar também neste erro agradeço, segue abaixo o Projeto do Sistema compactado, ainda é um projeto de estudo.

Screenshot: https://www.dropbox.com/sh/7sr1wqtgzxd79q7/AACIyhzcTRcUylxndOn-WXeka?dl=0
Sistema: https://www.dropbox.com/s/nq34u0fxwbdi95w/Sistema_Financeiro.rar?dl=0
Responder

Gostei + 0

19/10/2017

Antonio Jr

Oi amigo,

quando o IF tiver somente uma linha de comando (não for um bloco), não precisa do begin / end, procure indentar para ficar mais legível.
Responder

Gostei + 0

19/10/2017

Marcelo Duarte

Boa tarde, já vi isto, mais fiquei perdido como ele "enxerga" o código, ele irá processar somente uma linha?

Se x = 1 Então
Escreva "Um";

CODIGO
...
CODIGO

Ele sabe que apenas deve pegar a parte de escrever um?

E sabe me ajudar na parte do dia fixo?
Ele está colocando a data sempre a mesma para todas as ´parcelas, se for pagamento à vista ou 30 Dias está calculando corretamente.

Obrigado pela dica :-)
Responder

Gostei + 0

19/10/2017

Natanael Ferreira

Teste assim o final do seu código abaixo:
    
// Restante do código

// Final do código
if rgrpData_Vencimento.ItemIndex = 2 then
    begin
      Dia_Vencimento := StrToInt(edtDia_Vencimento.Text);
      Mes := MonthOf(now);
      Ano := YearOf(now);
      Dia_Data_Compra := (DayOf(StrToDate(edtData_Compra.Text)));
      Juncao_Dia_Mes_Ano := IntToStr(Dia_Vencimento) + '/' + IntToStr(Mes) + '/' + IntToStr(Ano);

      for Parcelas := 1 to StrToInt(edtqtde_parcelas.Text) do
        if Parcelas = 1 then
          cdsParcelasVencimento.AsDateTime := StrToDate(Juncao_Dia_Mes_Ano)
        else
          cdsParcelasVencimento.AsDateTime := IncMonth(StrToDate(Juncao_Dia_Mes_Ano), Parcelas - 1);
    end;
    cdsParcelas.Post;
Responder

Gostei + 0

20/10/2017

Marcelo Duarte

Bom dia, fiz as alterações conforme mencionadas, mais o mesmo ainda não está conseguindo incrementar os outros meses, ele pega apenas a data da primeira parcela e repete para as outras.
Estou usando a data como sendo dia 16, então ele está colocando todas as parcelas com data 16/11/2017, o código alterado segue abaixo:

if rgrpData_Vencimento.ItemIndex = 2 then
      begin

        Dia_Vencimento := StrToInt(edtDia_Vencimento.Text);
        Mes := MonthOf(now);
        Ano := YearOf(now);
        Dia_Data_Compra := (DayOf(StrToDate(edtData_Compra.Text)));
        Juncao_Dia_Mes_Ano := IntToStr(Dia_Vencimento) +''/''+ IntToStr(Mes) +''/''+ IntToStr(Ano);
        Data := StrToDate(Juncao_Dia_Mes_Ano);

        for Numero_Parcela := 1 to StrToInt(edtQtde_Parcelas.Text) do
          if Numero_Parcela = 1 then
            cdsParcelasVencimento.AsDateTime := Data
          else
            cdsParcelasVencimento.AsDateTime := IncMonth(Data,1);
          end;

    ProgressBarParcela.Position := ProgressBarParcela.Position +1;
    lblContagem.Caption := IntToStr(ProgressBarParcela.Position);

  end;

  cdsParcelas.Post;

end;
Responder

Gostei + 0

20/10/2017

Natanael Ferreira

Seu código está diferente do que postei. Especificamente na linha que incrementa o mês (IncMonth).
Você está incrementando sempre 1 na data atual. Você deve incrementar na variável de controle do loop (Numero_Parcela) menos 1;

Faça um teste trocando a linha:
cdsParcelasVencimento.AsDateTime := IncMonth(Data,1);

Por:
cdsParcelasVencimento.AsDateTime := IncMonth(Data, Numero_Parcela - 1); // Alterei o "1" por Numero_Parcela - 1
Responder

Gostei + 0

20/10/2017

Marcelo Duarte

Boa tarde, da forma como está:
for Numero_Parcela := 1 to StrToInt(edtQtde_Parcelas.Text) do
          if Numero_Parcela = 1 then
            cdsParcelasVencimento.AsDateTime := Data
          else
            cdsParcelasVencimento.AsDateTime := IncMonth(Data,1);


Ele mostra as datas 16/11/2017 em todas as parcelas.

 for Numero_Parcela := 1 to StrToInt(edtQtde_Parcelas.Text) do
          if Numero_Parcela = 1 then
            cdsParcelasVencimento.AsDateTime := Data
          else
            cdsParcelasVencimento.AsDateTime := IncMonth(Data,Numero_Parcela - 1);


Já alterando para o que me pediu para realizar o teste ele altera a data para 16/03/2018, se desse para dar uma olhada no sistema eu agradeceria, já estou perdido quanto onde está o erro, mesmo depurando ele no passo a passo não entendi, obrigado.

Link mega: https://mega.nz/#!1FBgDAbA!w0veVbDMCunPw3CH44glNlkjWEvoQ_79NoUgaBI8vlg

Marcelo F. Duarte
Paranaíba-MS
Responder

Gostei + 0

20/10/2017

Marcelo Duarte

Boa tarde complementando a resposta anterior, criei um botão de alto preenchimento quando clico ele deve preencher 6 parcelas com valor da compra de R$ 1.000,00, onde o mesmo deve começar a descontar no próximo mês 16/11/2017 à 16/04/2018, só que ele está repetindo para a forma anterior do primeiro código 16/11/2017 para todos, já da forma como colocou acredito que ele esteja colocando a ultima parcela 16/04/2018 -1 (Mês), e colocando o valor das parcelas 16/03/2018, observando o passo a passo ele coloca na variavel os meses, mais pq ele não preenche com o valor correto?
Como funciona cdsParcelas.Post? Ele guarda as variaveis todas as 6 e depois escreve com o Post? Ou deveria ler e escrever no passo a passo? Será que coloquei estes comando no local errado?
Mandei Junto um componente que estou usando nas caixas textm já preparado para formatação da mesma, que me foi fornecido junto ao curso.

Depois se puderem me dar uma ajuda indicando os erros e como corrigir agradeço.

Marcelo F. Duarte
Responder

Gostei + 0

23/10/2017

Luiz Vichiatto

Então vamos lá.
Li o seu código inicial atentamente e constatei que você não incrementa a variável "Juncao_Dia_Mes_Ano", ela é sempre a mesma.
A função, "IncMonth", como está escrita não incrementa uma variável do tipo texto e sim do tipo data, portanto se você colocar o incremento com a parcela isso irá adiantar.
Juncao_Dia_Mes_Ano := IntToStr(dia_vencimento) + '/' + IntToStr(mes) + '/' + IntToStr(ano);
for Parcelas := 1 to StrToInt(edtQtde_Parcelas.Text) do
begin
	cdsParcelasVencimento.AsDateTime := IncMonth(StrToDate(Juncao_Dia_Mes_Ano),Parcelas);
end;

Todas as vezes que você a chama a variável não é incrementada.

http://www.delphibasics.co.uk/RTL.asp?Name=IncMonth
Responder

Gostei + 0

23/10/2017

Marcelo Duarte

Bom dia, no link anterior tem o código, não estou conseguindo achar o erro,
Responder

Gostei + 0

23/10/2017

Luiz Vichiatto

O link é a página do comando IncMonth, é este é o erro que está comentando?

E o código funcionou?

Segue o link da página que costumo consultar para funções e procedures "básicos" do delphi http://www.delphibasics.co.uk/
Responder

Gostei + 0

23/10/2017

Marcelo Duarte

Boa tarde, a parte do botão que faz este processo é este, no final do código, ele mostra da data 16/04/2018, acho que há um erro nos loops for na linha 88 e 191, estas mudanças não estavam antes no código, já havia convertido Juncao_Dia_Mes_Ano em Data conforme a linha 95 e 96, abaixo segue o código e o executavel:

001 procedure TfrmCadastro_Contas_a_Pagar.acGera_ParcelasExecute(Sender: TObject);
002 var
003   I, Conta_Diferenca_Valor_Parcela, Parcela, Dia_Data_Compra, Dia_Vencimento, Quociente, Mes, Ano, Hoje: Integer;
004   Valor_Total_Parcela, Valor_Compra, Valor_Parcela, Qtde_Parcelas,Dividendo, Divisor, Resto: Double;
005   Data : TDate;
006   Data_vencimento, Juncao_Dia_Mes_Ano: string;

007 begin
008   ProgressBarParcela.Min := 0;
009   ProgressBarParcela.Max := StrToInt(edtQtde_Parcelas.Text);
010   dbgParcelas.DataSource.DataSet.Active := False;
011   dbgParcelas.DataSource.DataSet.Active := True;
012
013   if (lbledtNumero_Doc.Text = '') then
014     begin
015
016       Application.MessageBox('Preencha o Campo Número de Documento!', 'Atenção...', MB_OK + MB_ICONWARNING);
017       lbledtNumero_Doc.SetFocus;
018       Abort;
019
020     end;
021 
022   if (edtqtde_parcelas.Text = '') then
023     begin
024 
025       Application.MessageBox('Preencha o Campo Qtde Parcelas!', 'Atenção...', MB_OK + MB_ICONWARNING);
026       edtqtde_parcelas.SetFocus;
027       Abort;
028 
029     end;
030
031   if (StrToInt(edtqtde_parcelas.Text) = 0) then
032     begin
033
034       Application.MessageBox('O Campo tem que ser maior que 0 (ZERO)!', 'Atenção...', MB_OK + MB_ICONWARNING);
035       edtqtde_parcelas.SetFocus;
036       Abort;
037 
038     end;
039 
040   if (rgrpData_Vencimento.ItemIndex = -1) then
041     begin
042 
043       Application.MessageBox('Preencha o Campo Data de Vencimento!', 'Atenção...', MB_OK + MB_ICONWARNING);
044       Abort;
045 
046     end;
047 
048   if edtDia_Vencimento.Enabled = True then
049     begin
050 
051       if edtDia_Vencimento.Text = '' then
052         begin
053 
054           Application.MessageBox('Preencha o Campo Dia Vencimento!', 'Atenção...', MB_OK + MB_ICONWARNING);
055          edtDia_Vencimento.SetFocus;
056          Abort;
057
058         end;
059
060       if StrtoFloat(edtDia_Vencimento.Text) < 1 then
061         begin
062
063            Application.MessageBox('Preencha o Campo Dia Vencimento!', 'Atenção...', MB_OK + MB_ICONWARNING);
064            edtDia_Vencimento.SetFocus;
065            Abort;
066
067         end;
068 
069      end;
070
071    if StringParaFloat(edtValor_Compra.Text) <= 0 then
072      begin
073         Application.MessageBox('Preencha o Campo Valor da parcela, não pode ser igual a 0,00 (ZERO), ou negativo!', 'Atenção...',MB_OK + MB_ICONWARNING);
074        lbledtDescricao.SetFocus;
075        Abort;
075      end;
076
077    if edtData_Compra.Text = '' then
078      begin
079  
080        Application.MessageBox('Preencha o Campo Data Compra!', 'Atenção...', MB_OK + MB_ICONWARNING);
081        lbledtDescricao.SetFocus;
082        Abort;
083
084      end;
085
086     cdsParcelas.EmptyDataSet;
087
088     for I := 1 to StrToInt(edtQtde_Parcelas.Text) do
089       begin
090  
091         Dia_Vencimento := StrToInt(edtDia_Vencimento.Text);
092         Mes := MonthOf(now);
093         Ano := YearOf(now);
094         Dia_Data_Compra := (DayOf(StrToDate(edtData_Compra.Text)));
095        Juncao_Dia_Mes_Ano := IntToStr(Dia_Vencimento) +'/'+ IntToStr(Mes) +'/'+ IntToStr(Ano);
096        Data := StrToDate(Juncao_Dia_Mes_Ano);
097 
098        //Valor_Compra := StrToCurr(edtValor_Compra.Text);
099        Valor_Compra := StrToFloat(edtValor_Compra.Text);
100        Dividendo := Valor_Compra;
101
102        Qtde_Parcelas := StrToInt(edtQtde_Parcelas.Text);
103        Divisor := Qtde_Parcelas;
104
105        //Valor_Parcela := StringParaFloat(edtValor_Compra.Text) / StrToInt(edtQtde_Parcelas.Text);
106        Valor_Parcela := Trunc (Dividendo / Divisor);
107
108        Valor_Total_Parcela := Valor_Parcela * StrToInt(edtQtde_Parcelas.Text);
109 
110        Quociente := Trunc(valor_Parcela);
111
112        Resto := Dividendo - Divisor * Quociente;
113
114        //Resto := Valor_Compra mod  Qtde_Parcelas;
115
116        cdsParcelas.Insert;
117        cdsParcelasParcelas.AsInteger := I;
118 
119        if Valor_Total_Parcela = Valor_Compra then
120          begin
121
122            cdsParcelasValor.AsCurrency := Valor_Parcela;
123
124          end
124       else
125          begin
126
127          if Resto > 0 then
128            begin
129
130                for Conta_Diferenca_Valor_Parcela := 1 to StrToInt(edtQtde_Parcelas.Text) do
131                  begin
132
133                      if Parcela = 0 then
134                        begin
135
136                           Parcela := 1;
137
138                         end;
139
140                     if Parcela = 1 then
141                       begin
142
143                          cdsParcelasValor.AsCurrency := Valor_Parcela + Resto;
144
145                       end
146                    else
147                      begin
148
149                        cdsParcelasValor.AsCurrency := Valor_Parcela;
150
151                     end;
152
153                end;
154
155               end
156            else
157               begin
158
159                  cdsParcelasValor.AsCurrency := Valor_Parcela;
160
161               end;
162
163        end;
164
165        if rgrpData_Vencimento.ItemIndex = 0 then
166           begin
167
168              cdsParcelasVencimento.AsDateTime := StrToDate(edtData_Compra.Text);
169              ProgressBarParcela.Position := ProgressBarParcela.Position +1;
170
171           end;
172
173        if rgrpData_Vencimento.ItemIndex = 1 then
174          begin
175  
176            cdsParcelasVencimento.AsDateTime := StrToDate(edtData_Compra.Text) + (Variacao * I);
177            ProgressBarParcela.Position := ProgressBarParcela.Position +1;
178
179          end;
180  
181        if rgrpData_Vencimento.ItemIndex = 2 then
182          begin
183  
184            Dia_Vencimento := StrToInt(edtDia_Vencimento.Text);
185            Mes := MonthOf(now);
186            Ano := YearOf(now);
187            Dia_Data_Compra := (DayOf(StrToDate(edtData_Compra.Text)));
188            Juncao_Dia_Mes_Ano := IntToStr(Dia_Vencimento) +'/'+ IntToStr(Mes) +'/'+ IntToStr(Ano);
189            Data := StrToDate(Juncao_Dia_Mes_Ano);
190
191            for Parcela := 1 to StrToInt(edtQtde_Parcelas.Text) do
192              if Parcela = 1 then
193                cdsParcelasVencimento.AsDateTime := Data
194              else
195                cdsParcelasVencimento.AsDateTime := IncMonth(Data,Parcela);
196              end;
197
198        ProgressBarParcela.Position := ProgressBarParcela.Position +1;
199        lblContagem.Caption := IntToStr(ProgressBarParcela.Position);
200
201      end;
202
203    cdsParcelas.Post;
204  
205    btnLimpar_Parcelas.Enabled := True;
206    btnGerar_Parcelas.Enabled := False;
207  
208  end;

Arquivo: https://mega.nz/#!5VAhgIwZ!-Hg_MtiyCv8ujvUYZTu2wTCZhpGJ1p3zSZcSyzMiMVA
Responder

Gostei + 0

23/10/2017

Marcelo Duarte

Boa tarde, a parte do botão que faz este processo é este, no final do código, ele mostra da data 16/04/2018, acho que há um erro nos loops for na linha 88 e 191, estas mudanças não estavam antes no código, já havia convertido Juncao_Dia_Mes_Ano em Data conforme a linha 95 e 96, abaixo segue o código e o executavel:

001 procedure TfrmCadastro_Contas_a_Pagar.acGera_ParcelasExecute(Sender: TObject);
002 var
003   I, Conta_Diferenca_Valor_Parcela, Parcela, Dia_Data_Compra, Dia_Vencimento, Quociente, Mes, Ano, Hoje: Integer;
004   Valor_Total_Parcela, Valor_Compra, Valor_Parcela, Qtde_Parcelas,Dividendo, Divisor, Resto: Double;
005   Data : TDate;
006   Data_vencimento, Juncao_Dia_Mes_Ano: string;

007 begin
008   ProgressBarParcela.Min := 0;
009   ProgressBarParcela.Max := StrToInt(edtQtde_Parcelas.Text);
010   dbgParcelas.DataSource.DataSet.Active := False;
011   dbgParcelas.DataSource.DataSet.Active := True;
012
013   if (lbledtNumero_Doc.Text = '''') then
014     begin
015
016       Application.MessageBox(''Preencha o Campo Número de Documento!'', ''Atenção...'', MB_OK + MB_ICONWARNING);
017       lbledtNumero_Doc.SetFocus;
018       Abort;
019
020     end;
021 
022   if (edtqtde_parcelas.Text = '''') then
023     begin
024 
025       Application.MessageBox(''Preencha o Campo Qtde Parcelas!'', ''Atenção...'', MB_OK + MB_ICONWARNING);
026       edtqtde_parcelas.SetFocus;
027       Abort;
028 
029     end;
030
031   if (StrToInt(edtqtde_parcelas.Text) = 0) then
032     begin
033
034       Application.MessageBox(''O Campo tem que ser maior que 0 (ZERO)!'', ''Atenção...'', MB_OK + MB_ICONWARNING);
035       edtqtde_parcelas.SetFocus;
036       Abort;
037 
038     end;
039 
040   if (rgrpData_Vencimento.ItemIndex = -1) then
041     begin
042 
043       Application.MessageBox(''Preencha o Campo Data de Vencimento!'', ''Atenção...'', MB_OK + MB_ICONWARNING);
044       Abort;
045 
046     end;
047 
048   if edtDia_Vencimento.Enabled = True then
049     begin
050 
051       if edtDia_Vencimento.Text = '''' then
052         begin
053 
054           Application.MessageBox(''Preencha o Campo Dia Vencimento!'', ''Atenção...'', MB_OK + MB_ICONWARNING);
055          edtDia_Vencimento.SetFocus;
056          Abort;
057
058         end;
059
060       if StrtoFloat(edtDia_Vencimento.Text) < 1 then
061         begin
062
063            Application.MessageBox(''Preencha o Campo Dia Vencimento!'', ''Atenção...'', MB_OK + MB_ICONWARNING);
064            edtDia_Vencimento.SetFocus;
065            Abort;
066
067         end;
068 
069      end;
070
071    if StringParaFloat(edtValor_Compra.Text) <= 0 then
072      begin
073         Application.MessageBox(''Preencha o Campo Valor da parcela, não pode ser igual a 0,00 (ZERO), ou negativo!'', ''Atenção...'',MB_OK + MB_ICONWARNING);
074        lbledtDescricao.SetFocus;
075        Abort;
075      end;
076
077    if edtData_Compra.Text = '''' then
078      begin
079  
080        Application.MessageBox(''Preencha o Campo Data Compra!'', ''Atenção...'', MB_OK + MB_ICONWARNING);
081        lbledtDescricao.SetFocus;
082        Abort;
083
084      end;
085
086     cdsParcelas.EmptyDataSet;
087
088     for I := 1 to StrToInt(edtQtde_Parcelas.Text) do
089       begin
090  
091         Dia_Vencimento := StrToInt(edtDia_Vencimento.Text);
092         Mes := MonthOf(now);
093         Ano := YearOf(now);
094         Dia_Data_Compra := (DayOf(StrToDate(edtData_Compra.Text)));
095        Juncao_Dia_Mes_Ano := IntToStr(Dia_Vencimento) +''/''+ IntToStr(Mes) +''/''+ IntToStr(Ano);
096        Data := StrToDate(Juncao_Dia_Mes_Ano);
097 
098        //Valor_Compra := StrToCurr(edtValor_Compra.Text);
099        Valor_Compra := StrToFloat(edtValor_Compra.Text);
100        Dividendo := Valor_Compra;
101
102        Qtde_Parcelas := StrToInt(edtQtde_Parcelas.Text);
103        Divisor := Qtde_Parcelas;
104
105        //Valor_Parcela := StringParaFloat(edtValor_Compra.Text) / StrToInt(edtQtde_Parcelas.Text);
106        Valor_Parcela := Trunc (Dividendo / Divisor);
107
108        Valor_Total_Parcela := Valor_Parcela * StrToInt(edtQtde_Parcelas.Text);
109 
110        Quociente := Trunc(valor_Parcela);
111
112        Resto := Dividendo - Divisor * Quociente;
113
114        //Resto := Valor_Compra mod  Qtde_Parcelas;
115
116        cdsParcelas.Insert;
117        cdsParcelasParcelas.AsInteger := I;
118 
119        if Valor_Total_Parcela = Valor_Compra then
120          begin
121
122            cdsParcelasValor.AsCurrency := Valor_Parcela;
123
124          end
124       else
125          begin
126
127          if Resto > 0 then
128            begin
129
130                for Conta_Diferenca_Valor_Parcela := 1 to StrToInt(edtQtde_Parcelas.Text) do
131                  begin
132
133                      if Parcela = 0 then
134                        begin
135
136                           Parcela := 1;
137
138                         end;
139
140                     if Parcela = 1 then
141                       begin
142
143                          cdsParcelasValor.AsCurrency := Valor_Parcela + Resto;
144
145                       end
146                    else
147                      begin
148
149                        cdsParcelasValor.AsCurrency := Valor_Parcela;
150
151                     end;
152
153                end;
154
155               end
156            else
157               begin
158
159                  cdsParcelasValor.AsCurrency := Valor_Parcela;
160
161               end;
162
163        end;
164
165        if rgrpData_Vencimento.ItemIndex = 0 then
166           begin
167
168              cdsParcelasVencimento.AsDateTime := StrToDate(edtData_Compra.Text);
169              ProgressBarParcela.Position := ProgressBarParcela.Position +1;
170
171           end;
172
173        if rgrpData_Vencimento.ItemIndex = 1 then
174          begin
175  
176            cdsParcelasVencimento.AsDateTime := StrToDate(edtData_Compra.Text) + (Variacao * I);
177            ProgressBarParcela.Position := ProgressBarParcela.Position +1;
178
179          end;
180  
181        if rgrpData_Vencimento.ItemIndex = 2 then
182          begin
183  
184            Dia_Vencimento := StrToInt(edtDia_Vencimento.Text);
185            Mes := MonthOf(now);
186            Ano := YearOf(now);
187            Dia_Data_Compra := (DayOf(StrToDate(edtData_Compra.Text)));
188            Juncao_Dia_Mes_Ano := IntToStr(Dia_Vencimento) +''/''+ IntToStr(Mes) +''/''+ IntToStr(Ano);
189            Data := StrToDate(Juncao_Dia_Mes_Ano);
190
191            for Parcela := 1 to StrToInt(edtQtde_Parcelas.Text) do
192              if Parcela = 1 then
193                cdsParcelasVencimento.AsDateTime := Data
194              else
195                cdsParcelasVencimento.AsDateTime := IncMonth(Data,Parcela);
196              end;
197
198        ProgressBarParcela.Position := ProgressBarParcela.Position +1;
199        lblContagem.Caption := IntToStr(ProgressBarParcela.Position);
200
201      end;
202
203    cdsParcelas.Post;
204  
205    btnLimpar_Parcelas.Enabled := True;
206    btnGerar_Parcelas.Enabled := False;
207  
208  end;

Arquivo: https://mega.nz/#!5VAhgIwZ!-Hg_MtiyCv8ujvUYZTu2wTCZhpGJ1p3zSZcSyzMiMVA
Responder

Gostei + 0

30/10/2017

Marcelo Duarte

Bom dia, consegui resolver o problema corrigindo os loop''s, ele estava colocando os valores errados repetindo o processo novamente, refiz o mesmo do zero testando e corrigi o problema.

088 - Inicio do Loop para o pagamento

procedure TfrmCadastro_Contas_a_Pagar.acGera_ParcelasExecute(Sender: TObject);
var
  I, Conta_Diferenca_Valor_Parcela, Parcela, Qtde_Dias_Variacao, Dia_Data_Compra, Dia_Vencimento, Quociente, Mes, Ano, Hoje: Integer;
  Valor_Total_Parcela, Valor_Compra, Valor_Parcela, Qtde_Parcelas,Dividendo, Divisor, Resto: Double;
  Data : TDate;
  Data_vencimento, Juncao_Dia_Mes_Ano: string;

begin
  //Valor padrao ao Iniciar o Fomulario
  cdsParcelas.EmptyDataSet;
  ProgressBarParcela.Position := 0;
  lblContagem.Caption := IntToStr(ProgressBarParcela.Position);

  ProgressBarParcela.Min := 0;
  ProgressBarParcela.Max := StrToInt(edtQtde_Parcelas.Text);
  dbgParcelas.DataSource.DataSet.Active := False;
  dbgParcelas.DataSource.DataSet.Active := True;

  //Ao pressionar F11 sem estar com foco no botão apresenta erro
  btnGerar_Parcelas.SetFocus;

  //Verifica se os campos estão preenchidos
  if (lbledtNumero_Doc.Text = '''') then
    begin

      Application.MessageBox(''Preencha o Campo Número de Documento!'', ''Atenção...'', MB_OK + MB_ICONWARNING);
      lbledtNumero_Doc.SetFocus;
      Abort;

    end;

  if (edtqtde_parcelas.Text = '''') then
    begin

      Application.MessageBox(''Preencha o Campo Qtde Parcelas!'', ''Atenção...'', MB_OK + MB_ICONWARNING);
      edtqtde_parcelas.SetFocus;
      Abort;

    end;

  if (StrToInt(edtqtde_parcelas.Text) = 0) then
    begin

      Application.MessageBox(''O Campo tem que ser maior que 0 (ZERO)!'', ''Atenção...'', MB_OK + MB_ICONWARNING);
      edtqtde_parcelas.SetFocus;
      Abort;

    end;

  if (rgrpData_Vencimento.ItemIndex = -1) then
    begin

      Application.MessageBox(''Preencha o Campo Data de Vencimento!'', ''Atenção...'', MB_OK + MB_ICONWARNING);
      Abort;

    end;

  if edtDia_Vencimento.Enabled = True then
    begin

      if edtDia_Vencimento.Text = '''' then
      begin

        Application.MessageBox(''Preencha o Campo Dia Vencimento!'', ''Atenção...'', MB_OK + MB_ICONWARNING);
        edtDia_Vencimento.SetFocus;
        Abort;

      end;

      if StrtoFloat(edtDia_Vencimento.Text) < 1 then
      begin

        Application.MessageBox(''Preencha o Campo Dia Vencimento!'', ''Atenção...'', MB_OK + MB_ICONWARNING);
        edtDia_Vencimento.SetFocus;
        Abort;

      end;

    end;

  if StringParaFloat(edtValor_Compra.Text) <= 0 then
    begin
      Application.MessageBox(''Preencha o Campo Valor da parcela, não pode ser igual a 0,00 (ZERO), ou negativo!'', ''Atenção...'', MB_OK + MB_ICONWARNING);
      lbledtDescricao.SetFocus;
      Abort;
    end;

  if edtData_Compra.Text = '''' then
    begin

      Application.MessageBox(''Preencha o Campo Data Compra!'', ''Atenção...'', MB_OK + MB_ICONWARNING);
      lbledtDescricao.SetFocus;
      Abort;

    end;

  cdsParcelas.EmptyDataSet;

  //Verifica se o campo vencimento está habilitado
  if edtDia_Vencimento.Enabled = true then
    Dia_Vencimento := StrToInt(edtDia_Vencimento.Text)
  else
    Dia_Vencimento := (DayOf(StrToDate(edtData_Compra.Text)));

  Mes := MonthOf(now);
  Ano := YearOf(now);
  Dia_Data_Compra := (DayOf(StrToDate(edtData_Compra.Text)));
  Juncao_Dia_Mes_Ano := IntToStr(Dia_Vencimento) +''/''+ IntToStr(Mes) +''/''+ IntToStr(Ano);
  Data := StrToDate(Juncao_Dia_Mes_Ano);

  Valor_Compra := StrToFloat(edtValor_Compra.Text);
  Dividendo := Valor_Compra;

  Qtde_Parcelas := StrToInt(edtQtde_Parcelas.Text);
  Divisor := Qtde_Parcelas;

  Valor_Parcela := Trunc (Dividendo / Divisor);

  Valor_Total_Parcela := Valor_Parcela * StrToInt(edtQtde_Parcelas.Text);

  Quociente := Trunc(valor_Parcela);

  Resto := Dividendo - Divisor * Quociente;

  //Calculo das parcelas de acordo com o TIPO de pagamento se À Vista, 30 Dias
  //Fixo ou com Variação de prazo de pagamento.
  for I := 1 to StrToInt(edtQtde_Parcelas.Text) do
    begin
      cdsParcelas.Insert;
      cdsParcelasParcelas.AsInteger := I;

      if rgrpData_Vencimento.ItemIndex = 0 then
        begin

          cdsParcelasValor.AsCurrency := Valor_Parcela;
          Data := StrToDate(edtData_Compra.Text);
          cdsParcelasVencimento.AsDateTime := Data;
          edtQtde_Parcelas.Text := ''1'';

        end;

      if rgrpData_Vencimento.ItemIndex = 1 then
        begin

          if Valor_Total_Parcela = Valor_Compra then
            begin

               cdsParcelasValor.AsCurrency := Valor_Parcela;
               Data := IncDay(StrToDate(edtData_Compra.Text),variacao);
               cdsParcelasVencimento.AsDateTime := Data;


            end
          else
            begin

              if I = 1 then
                begin

                   cdsParcelasValor.AsCurrency := Valor_Parcela + Resto;
                   Data := IncDay(StrToDate(edtData_Compra.Text),variacao);
                   cdsParcelasVencimento.AsDateTime := Data;

                end
              else
                begin

                  cdsParcelasValor.AsCurrency := Valor_Parcela;
                  Data := IncDay(StrToDate(edtData_Compra.Text),I * variacao);
                  cdsParcelasVencimento.AsDateTime := Data;

                end;

            end;

        end;

      if rgrpData_Vencimento.ItemIndex = 2 then
        begin
          if (StrToDate(edtData_Compra.Text)) > (StrToDate((edtDia_Vencimento.Text) + ''/'' + IntToStr(Mes) +''/''+ IntToStr(Ano))) then
            begin
              if Valor_Total_Parcela = Valor_Compra then
                begin

                  if I = 1 then
                    begin

                      cdsParcelasValor.AsCurrency := Valor_Parcela;
                      Data := IncMonth(Data,1);
                      cdsParcelasVencimento.AsDateTime := Data;

                    end
                  else
                    begin

                      cdsParcelasValor.AsCurrency := Valor_Parcela;
                      Data := IncMonth(Data,1);
                      cdsParcelasVencimento.AsDateTime := Data;

                    end;

                end
              else
                begin

                  if I = 1 then
                    begin

                      cdsParcelasValor.AsCurrency := Valor_Parcela + Resto;
                      Data := IncMonth(Data,1);
                      cdsParcelasVencimento.AsDateTime := Data;

                    end
                  else
                    begin

                      cdsParcelasValor.AsCurrency := Valor_Parcela;
                      Data := IncMonth(Data,1);
                      cdsParcelasVencimento.AsDateTime := Data;

                    end;

                end;

            end
          else
            begin

              if Valor_Total_Parcela = Valor_Compra then
                begin

                  if I = 1 then
                    begin

                      cdsParcelasValor.AsCurrency := Valor_Parcela;
                      Data := IncMonth(Data,0);
                      cdsParcelasVencimento.AsDateTime := Data;

                    end
                  else
                    begin

                      cdsParcelasValor.AsCurrency := Valor_Parcela;
                      Data := IncMonth(Data,1);
                      cdsParcelasVencimento.AsDateTime := Data;

                    end;

                end
              else
                begin

                  if I = 1 then
                    begin

                      cdsParcelasValor.AsCurrency := Valor_Parcela + Resto;
                      Data := IncMonth(Data,0);
                      cdsParcelasVencimento.AsDateTime := Data;

                    end
                  else
                    begin

                      cdsParcelasValor.AsCurrency := Valor_Parcela;
                      Data := IncMonth(Data,1);
                      cdsParcelasVencimento.AsDateTime := Data;

                    end;
Responder

Gostei + 0

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar