Fórum Array dinamico erro AV #586523

06/10/2017

0

Delphi

Prezados boa tarde

Tenho uma combobox no meu projeto, no onclick dela executo o seguinte procedimento

procedure TF_Finaliza.cbxParcelasClick(Sender: TObject);
var
myDate : TDate;
i: integer;
dtVencimento: array of string;
v: string;
begin
for I := 1 to cbxParcelas.ItemIndex+1 do
begin
myDate := incMonth(Date,(i));
v := DateToStr(mydate);
dtvencimento[I] := v;
end;
end;

Quando executo, e entro com o debug para visualizar os dados, estoura o seguinte erro no "dtvencimento[I] := v;"
raised exception class $C0000005 with message 'access violation at 0x0040bd7e: write of address 0x00000004'.

O que estou fazendo de errado? Poderiam me ajudar?
Anderson Rosa

Anderson Rosa

Responder

Posts

06/10/2017

Natanael Ferreira

No array dinâmico você precisa ir setando o tamanho dele antes de acrescentar items.

Teste seu código assim (coloquei uma mensagem na tela para você ver o resultado):

procedure TF_Finaliza.cbxParcelasClick(Sender: TObject);
var
  myDate: TDate;
  i, j: integer;
  dtVencimento: array of string;
  v: string;
begin
  for i := 0 to cbxParcelas.ItemIndex do
  begin
    SetLength(dtVencimento, i + 1);
    myDate := incMonth(Date, i + 1);
    v := DateToStr(myDate);
    dtVencimento[i] := v;
  end;

  for j := Low(dtVencimento) to High(dtVencimento) do
    ShowMessage(dtVencimento[j]);
end;
Responder

Gostei + 0

06/10/2017

Anderson Rosa

No array dinâmico você precisa ir setando o tamanho dele antes de acrescentar items.

Teste seu código assim (coloquei uma mensagem na tela para você ver o resultado):

procedure TF_Finaliza.cbxParcelasClick(Sender: TObject);
var
  myDate: TDate;
  i, j: integer;
  dtVencimento: array of string;
  v: string;
begin
  for i := 0 to cbxParcelas.ItemIndex do
  begin
    SetLength(dtVencimento, i + 1);
    myDate := incMonth(Date, i + 1);
    v := DateToStr(myDate);
    dtVencimento[i] := v;
  end;

  for j := Low(dtVencimento) to High(dtVencimento) do
    ShowMessage(dtVencimento[j]);
end;


Beleza Natanael, deu certo, muito obrigado!!!
Responder

Gostei + 0

06/10/2017

Anderson Rosa

Mais uma duvida, no caso eu tenho 6 Tdatetimerpicker
dtVencParcela01.Date := StrToDate(dtvencimento[0]);
dtVencParcela02.Date := StrToDate(dtvencimento[1]);
dtVencParcela03.Date := StrToDate(dtvencimento[2]);
dtVencParcela04.Date := StrToDate(dtvencimento[3]);
dtVencParcela05.Date := StrToDate(dtvencimento[4]);
dtVencParcela06.Date := StrToDate(dtvencimento[5]);

Caso eu escolha duas parcelas, como ficaria a validação para ignorar esses outros campos?

Tentei fazer com o if, mas nao deu certo!
Responder

Gostei + 0

06/10/2017

Natanael Ferreira

Você pode fazer um Loop e ir adicionando aos DateTimePicker's com FindComponent.

Teste este código:

procedure TForm2.cbxParcelasClick(Sender: TObject);
var
  myDate: TDate;
  memo: TMemo;
  i, j: integer;
  dtVencimento: array of string;
  v: string;
begin
  for i := 0 to cbxParcelas.ItemIndex do
  begin
    SetLength(dtVencimento, i + 1);
    myDate := incMonth(Date, i + 1);
    v := DateToStr(myDate);
    dtVencimento[i] := v;
  end;

  for j := Low(dtVencimento) to High(dtVencimento) do
    TDateTimePicker(Self.FindComponent('dtVencParcela0' + IntToStr(j + 1))).Date :=
      StrToDate(dtVencimento[j]);
end;
Responder

Gostei + 0

06/10/2017

Anderson Rosa

Você pode fazer um Loop e ir adicionando aos DateTimePicker's com FindComponent.

Teste este código:

procedure TForm2.cbxParcelasClick(Sender: TObject);
var
  myDate: TDate;
  memo: TMemo;
  i, j: integer;
  dtVencimento: array of string;
  v: string;
begin
  for i := 0 to cbxParcelas.ItemIndex do
  begin
    SetLength(dtVencimento, i + 1);
    myDate := incMonth(Date, i + 1);
    v := DateToStr(myDate);
    dtVencimento[i] := v;
  end;

  for j := Low(dtVencimento) to High(dtVencimento) do
    TDateTimePicker(Self.FindComponent('dtVencParcela0' + IntToStr(j + 1))).Date :=
      StrToDate(dtVencimento[j]);
end;


Valeu Natanel, agora sim, muito obrigado! Tudo Certo
Responder

Gostei + 0

06/10/2017

Raimundo Pereira

Boa tarde!

Reaproveitando o código do Natanael:

Ao invés de uma mensagem para cada vencimento:
var
  myDate: TDate;
  i, j: integer;
  dtVencimento: array of string;
  v: string;
  Vencimentos:tmemo;
begin
Vencimentos:=TMemo.Create(self);
Vencimentos.Visible:=false;
Vencimentos.Parent:=F_Finaliza;
Vencimentos.Clear;

  for i := 0 to cbxParcelas.ItemIndex do
  begin
    SetLength(dtVencimento, i + 1);
    myDate := incMonth(Date, i + 1);
    v := DateToStr(myDate);
    dtVencimento[i] := v;
  end;


  for j := Low(dtVencimento) to High(dtVencimento) do
    Vencimentos.Lines.Add((dtVencimento[j]));
    Application.MessageBox(pchar(Vencimentos.Text),'Vencimentos');

end;
Responder

Gostei + 0

06/10/2017

Anderson Rosa

Boa tarde!

Reaproveitando o código do Natanael:

Ao invés de uma mensagem para cada vencimento:
var
  myDate: TDate;
  i, j: integer;
  dtVencimento: array of string;
  v: string;
  Vencimentos:tmemo;
begin
Vencimentos:=TMemo.Create(self);
Vencimentos.Visible:=false;
Vencimentos.Parent:=F_Finaliza;
Vencimentos.Clear;

  for i := 0 to cbxParcelas.ItemIndex do
  begin
    SetLength(dtVencimento, i + 1);
    myDate := incMonth(Date, i + 1);
    v := DateToStr(myDate);
    dtVencimento[i] := v;
  end;


  for j := Low(dtVencimento) to High(dtVencimento) do
    Vencimentos.Lines.Add((dtVencimento[j]));
    Application.MessageBox(pchar(Vencimentos.Text),'Vencimentos');

end;


Valeu P2
Responder

Gostei + 0

06/10/2017

Anderson Rosa

Tenho uma nova duvida,

Nesse trecho do codigo

vr_ := SimpleRoundTo(Xtotal/Xparcelas);
parcela := FormatCurr(''#,##0.00'', vr_);

pego o valor total e divido pelo numero de parcelas, depois utilizo o SimpleRoundTo para a questao de arredondamentos.

Se o total for R$ 35,00 divido em 3 parcelas
35/3 = 11,66666666666667 = 11,67

Só que preciso que no parcelamento fique o valor exato para fechar com o total

parcela 01 - 01/10/2017 - 16,67
parcela 02 - 01/11/2017 - 16,67
parcela 03 - 01/12/2017 - 16,66

Como resolver esse problema?
Responder

Gostei + 0

06/10/2017

Natanael Ferreira

Veja se a função abaixo ajuda:

procedure Apure_Parcelas(fValor: Double; iNum_Parcs: Integer);
var
  i: Integer;
  fTot: Double;
begin
  SetLength(rParcs, iNum_Parcs);
  fTot := 0;
  for i := 0 to High(rParcs) do
  begin
    rParcs[i] := Trunc(fValor * 100 / iNum_Parcs) / 100;
    fTot := fTot + rParcs[i];
  end;
  rParcs[0] := rParcs[0] + fValor - fTot;
end;


Exemplo:

Variável global:
rParcs: array of Double;


Uso:
var
  i: Integer;
begin
  Apure_Parcelas(50.00, 3);

  for i := Low(rParcs) to High(rParcs) do
    ShowMessage(FloatToStr(rParcs[i]));
end;
Responder

Gostei + 0

06/10/2017

Anderson Rosa

Ajuda sim, muito obrigado vou implementar aqui!
Responder

Gostei + 0

06/10/2017

Anderson Rosa

Natanael,

Seguindo aquela sua função, como eu faço para o meu array vrparcelas receber o rParcs?

procedure TF_Finaliza.cbxParcelasClick(Sender: TObject);
var
myDate: TDate;
i, j: integer;
dtVencimento, vrparcelas: array of string;
begin
RedimensionaComponentes;

for i := 0 to cbxParcelas.ItemIndex do
begin
SetLength(dtVencimento, i + 12);
myDate := incMonth(Date, i + 1);
dtVencimento[i] := DateToStr(myDate);
end;

//funcao para gerar corretamente as parcelas
Apure_Parcelas(Xtotal, parcelas);

for j := Low(rParcs) to High(rParcs) do
begin
SetLength(vrparcelas, j + 12);
vrparcelas[j] := rParcs[j];
end;
end;

Nessa parte sou meio leigo!
Responder

Gostei + 0

06/10/2017

Anderson Rosa

Natanael,

Seguindo aquela sua função, como eu faço para o meu array vrparcelas receber o rParcs?

procedure TF_Finaliza.cbxParcelasClick(Sender: TObject);
var
myDate: TDate;
i, j: integer;
dtVencimento, vrparcelas: array of string;
begin
RedimensionaComponentes;

for i := 0 to cbxParcelas.ItemIndex do
begin
SetLength(dtVencimento, i + 12);
myDate := incMonth(Date, i + 1);
dtVencimento[i] := DateToStr(myDate);
end;

//funcao para gerar corretamente as parcelas
Apure_Parcelas(Xtotal, parcelas);

for j := Low(rParcs) to High(rParcs) do
begin
SetLength(vrparcelas, j + 12);
vrparcelas[j] := rParcs[j];
end;
end;

Nessa parte sou meio leigo!


Achei o meu erro, obrigado pela ajuda!!!!
Responder

Gostei + 0

06/10/2017

Natanael Ferreira

Disponha, amigo.
Responder

Gostei + 0

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

Aceitar