Ir para conteúdo

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

RaPhALiNuX

[Resolvido] Calculo de Anos, Meses e Dias

Recommended Posts

Segue abaixo uma função para calcular dias, meses e anos em vb.net. Modifiquem a vontade mas seria legal postar aqui as modificações.

 

Function CalculaTempo(ByVal Entrada As Date)
       Dim Anos, Meses, Dias, iAnos, iMeses, iDias As Double
       Dim diasDiff As String
       Anos = DateDiff(DateInterval.Year, Entrada, Date.Today)
       Entrada = DateAdd(DateInterval.Year, Anos, Entrada)
       If Entrada < Date.Today Then
           iMeses = DateDiff(DateInterval.Month, Date.Today, Entrada)
           diasDiff = DatePart(DateInterval.Day, Date.Today) - DatePart(DateInterval.Day, Entrada)
       ElseIf Entrada = Date.Today Then
           iMeses = DateDiff(DateInterval.Month, Entrada, Date.Today)
           diasDiff = DatePart(DateInterval.Day, Date.Today) - DatePart(DateInterval.Day, Entrada)
       ElseIf Entrada > Date.Today Then
           Anos = Anos - 1
           iMeses = 12 - DateDiff(DateInterval.Month, Date.Today, Entrada)
           diasDiff = DatePart(DateInterval.Day, Date.Today) - DatePart(DateInterval.Day, Entrada)
       End If
       Dim diamesDtAdmin As Double = Date.DaysInMonth(DatePart(DateInterval.Year, Date.Today), DatePart(DateInterval.Month, Date.Today))
       If diasDiff = diamesDtAdmin Then
           diasDiff = 0
           iMeses = iMeses + 1
       End If
       If iMeses = 12 Then
           Anos = Anos + 1
       End If
       Dim AnosTexto, MesesTexto, DiasTexto As String
       If CInt(Anos) = 1 Then
           AnosTexto = " Ano, "
       Else
           AnosTexto = " Anos, "
       End If
       If iMeses = 1 Then
           MesesTexto = " mês e "
       Else
           MesesTexto = " meses e "
       End If
       If diasDiff = 1 Then
           DiasTexto = " dia."
       Else
           DiasTexto = " dias."
       End If
       If String.IsNullOrEmpty(txtTempoAdicionalA.Text) Then
           txtTempoAdicionalA.Text = 0
       End If
       lbltempo.Text = CInt(Anos) + txtTempoAdicionalA.Text & AnosTexto & Math.Abs(iMeses) & MesesTexto & Math.Abs(CInt(diasDiff)) & DiasTexto
   End Function

'bY RaPhALiNuX

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.