Parcela com data de vencimento fixa
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;
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
Curtidas 0
Respostas
Luiz Vichiatto
18/10/2017
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.
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;
GOSTEI 0
Marcelo Duarte
18/10/2017
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
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
GOSTEI 0
Antonio Jr
18/10/2017
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.
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.
GOSTEI 0
Marcelo Duarte
18/10/2017
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 :-)
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 :-)
GOSTEI 0
Natanael Ferreira
18/10/2017
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;GOSTEI 0
Marcelo Duarte
18/10/2017
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:
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;
GOSTEI 0
Natanael Ferreira
18/10/2017
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:
Por:
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
GOSTEI 0
Marcelo Duarte
18/10/2017
Boa tarde, da forma como está:
Ele mostra as datas 16/11/2017 em todas as parcelas.
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
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
GOSTEI 0
Marcelo Duarte
18/10/2017
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
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
GOSTEI 0
Luiz Vichiatto
18/10/2017
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.
Todas as vezes que você a chama a variável não é incrementada.
http://www.delphibasics.co.uk/RTL.asp?Name=IncMonth
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
GOSTEI 0
Marcelo Duarte
18/10/2017
Bom dia, no link anterior tem o código, não estou conseguindo achar o erro,
GOSTEI 0
Luiz Vichiatto
18/10/2017
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/
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/
GOSTEI 0
Marcelo Duarte
18/10/2017
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:
Arquivo: https://mega.nz/#!5VAhgIwZ!-Hg_MtiyCv8ujvUYZTu2wTCZhpGJ1p3zSZcSyzMiMVA
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
GOSTEI 0
Marcelo Duarte
18/10/2017
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:
Arquivo: https://mega.nz/#!5VAhgIwZ!-Hg_MtiyCv8ujvUYZTu2wTCZhpGJ1p3zSZcSyzMiMVA
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
GOSTEI 0
Marcelo Duarte
18/10/2017
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;
GOSTEI 0
Marcelo Duarte
18/10/2017
CONTINUAÇÃO:
end;
end;
end;
ProgressBarParcela.Position := ProgressBarParcela.Position +1;
lblContagem.Caption := IntToStr(ProgressBarParcela.Position);
cdsParcelas.Post;
end;
end;
end;
end;
end;
ProgressBarParcela.Position := ProgressBarParcela.Position +1;
lblContagem.Caption := IntToStr(ProgressBarParcela.Position);
cdsParcelas.Post;
end;
end;
GOSTEI 0