extrair meses no delphi

Delphi

27/03/2004

Não estou encontrando nenhuma função que me retorne a quantidade de meses mediante a duas datas informadas, se alguém tiver dicas vai me ajudar bastante. Estou utilizando esse meio de extração da quantidade de meses para efetuar cálculos de juros mensais, se alguém puder me ajudar vou agradecer muito.

Valeu gente!!!


Universodosoftware

Universodosoftware

Curtidas 0

Melhor post

Aroldo Zanela

Aroldo Zanela

28/03/2004

Colegas,

O fontes da função MonthsBetween da DateUtils da RxLib é este aqui:


function MonthsBetween(Date1, Date2: TDateTime): Double;
var
  D, M, Y: Word;
begin
  DateDiff(Date1, Date2, D, M, Y);
  Result := 12 * Y + M;
  if (D > 1) and (D < 7) then Result := Result + 0.25
  else if (D >= 7) and (D < 15) then Result := Result + 0.5
  else if (D >= 15) and (D < 21) then Result := Result + 0.75
  else if (D >= 21) then Result := Result + 1;
end;

procedure DateDiff(Date1, Date2: TDateTime; var Days, Months, Years: Word);
{ Corrected by Anatoly A. Sanko (2:450/73) }
var
  DtSwap: TDateTime;
  Day1, Day2, Month1, Month2, Year1, Year2: Word;
begin
  if Date1 > Date2 then begin
    DtSwap := Date1;
    Date1 := Date2;
    Date2 := DtSwap;
  end;
  DecodeDate(Date1, Year1, Month1, Day1);
  DecodeDate(Date2, Year2, Month2, Day2);
  Years := Year2 - Year1;
  Months := 0;
  Days := 0;
  if Month2 < Month1 then begin
    Inc(Months, 12);
    Dec(Years);
  end;
  Inc(Months, Month2 - Month1);
  if Day2 < Day1 then begin
    Inc(Days, DaysPerMonth(Year1, Month1));
    if Months = 0 then begin
      Dec(Years);
      Months := 11;
    end
    else Dec(Months);
  end;
  Inc(Days, Day2 - Day1);
end;

function DaysPerMonth(AYear, AMonth: Integer): Integer;
const
  DaysInMonth: array[1..12] of Integer =
    (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
  Result := DaysInMonth[AMonth];
  if (AMonth = 2) and IsLeapYear(AYear) then Inc(Result); { leap-year Feb is special }
end;
function IsLeapYear(AYear: Integer): Boolean;
begin
  Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
end;



GOSTEI 1

Mais Respostas

Aroldo Zanela

Aroldo Zanela

27/03/2004

Colega,

Veja este tópico: http://delphiforum.icft.com.br/forum/viewtopic.php?t=36022&highlight=monthsbetween


GOSTEI 0
Marco Salles

Marco Salles

27/03/2004

citação Aroldo Zanela:
Veja este tópico: http://delphiforum.icft.com.br/forum/viewtopic.php?t=36022&highlight=monthsbetween


O Problema Aroldo, Que Neste Tópico o :idea: Emerson Sugeriu Uma Rotina Muito Interressante :P Para Definir A Quantidade De Meses Entre Duas Datas,[size=14:9d3e26b314] Mas Ate o Momento :cry: :cry: as Mensagems Do Emerson Sumiram Do Forum...[/size:9d3e26b314]Se O Nosso Amigo ´universodosoftware´ Ler Este Tópico, Ele Vai Ficar Meio Confuso :?: Quem é Este Ermerson :?: Qual é a Rotina Que Ele Sugeriu..etc... :?: :?: Falndo Nisso Aroldo, Não Dá Para Voltar Com as Mensagems Do Nosso Amigo, :?: Ainda Bem Que Não Foram as Minhas Mensagems Estã Em Cima :P :P :P


GOSTEI 0
Aroldo Zanela

Aroldo Zanela

27/03/2004

[quote:b5f7cb8391=´Marco Salles´]citação Aroldo Zanela:
Veja este tópico: http://delphiforum.icft.com.br/forum/viewtopic.php?t=36022&highlight=monthsbetween


O Problema Aroldo, Que Neste Tópico o :idea: Emerson Sugeriu Uma Rotina Muito Interressante :P Para Definir A Quantidade De Meses Entre Duas Datas,[size=14:b5f7cb8391] Mas Ate o Momento :cry: :cry: as Mensagems Do Emerson Sumiram Do Forum...[/size:b5f7cb8391]Se O Nosso Amigo ´universodosoftware´ Ler Este Tópico, Ele Vai Ficar Meio Confuso :?: Quem é Este Ermerson :?: Qual é a Rotina Que Ele Sugeriu..etc... :?: :?: Falndo Nisso Aroldo, Não Dá Para Voltar Com as Mensagems Do Nosso Amigo, :?: Ainda Bem Que Não Foram as Minhas Mensagems Estã Em Cima :P :P :P[/quote:b5f7cb8391]

Muito estranho! Não havia percebido isso, mas vou investigar pra ver se descrubo o que está acontecendo.


GOSTEI 0
Marco Salles

Marco Salles

27/03/2004

Existe Uma Funçao: MonthsBetween Se Não Me Engano Da Unit DateUtils; Esta Função Trabalha Com Uma Média...Aparentemente Em Determinadas Aplicacoes o Retorno Dela Da Um Valor Indesejado...Isto Pode Ser Mais Esclarecido Ao Ler O Tópico Que Nosso Amigo Aroldo Citou... Neste Tópico Surge Uma Outra Rotina ( Confesso Ser Mais Intuitiva Do Que a Função MonthsBetween, No Que Se Refere a Noção De Diferença De Meses)...Esta Rotina Foi Postada Pelo Também Nosso Amigo Emerson, So Que Infelizmente As Mensagems Do Emerson Ate o Momento Não Se Encontra Disponível... Porem Posso Passar A Idéia Do Que Seja Esta Rotina.... Voce Deve Tentar Definir Qual Das Duas Se Enquadra Melhor No Seu Aplicativo...
function MesesEntreDatas(dDataInicial, dDataFinal: TDate): integer;
var 
    Anosi, Mesesi, Diasi: integer;
    Anosf, Mesesf, Diasf: integer;
    Anos, Meses, Dias: Word;
begin
DecodeDate(dDataInicial,Anos,Meses,Dias);
anosi:=Anos;
Mesesi:=Meses;
DiasI:=Dias;
Decodedate(dDataFinal,Anos,Meses,Dias);
anosF:=Anos;
MesesF:=Meses;
DiasF:=Dias;
AnosF:=Abs(AnosF-AnosI);
MesesF:=(MesesF-Mesesi);
DiasF:=(DiasF-Diasi);
if MesesF < 0 Then
  begin
    Dec(AnosF);
    Inc(MesesF,12);
  end;
if DiasF < 0 then
   Dec(MesesF);
Result :=abs(MesesF + (AnosF * 12));
end;


Experimente:
Var
 DiferencaDeMeses:Integer;
begin
DiferencaDeMeses:=MonthsBetween(01/02/2003,01/03/2003);
ShowMessage(IntToStr(DiferencaDeMeses));
DiferencaDeMeses:=MesesEntreDatas(01/02/2003,01/03/2003);
ShowMessage(IntToStr(DiferencaDeMeses));
end;



GOSTEI 0
Marco Salles

Marco Salles

27/03/2004

Acabei De Entrar Em Contato Com O Emerson.Em E Passo a Sua Função Original:
function MesesEntreDatas(dDataInicial, dDataFinal: TDate): integer; 
var AnoI, MesI, DiaI, AnoF, MesF, DiaF: word; 
    Anos, Meses, Dias: integer; 
    dDataIni, dDataFim: TDate; 
begin 
  if dDataInicial < dDataFinal then 
  begin 
    dDataIni := dDataInicial; 
    dDataFim := dDataFinal; 
  end 
  else 
  begin 
    dDataIni := dDataFinal; 
    dDataFim := dDataInicial; 
  end; 

  DecodeDate(dDataIni,AnoI,MesI,DiaI); 
  Decodedate(dDataFim,AnoF,MesF,DiaF); 

  Anos := AnoF - AnoI; 
  Meses := MesF - MesI; 
  Dias := DiaF - DiaI; 

  if Meses < 0 then 
  begin 
     Inc(Meses,12); 
     Dec(Anos); 
  end; 

  if Dias < 0 then Dec(Meses); 

  Result := Meses + (Anos * 12); 
end;



GOSTEI 0
POSTAR