Ver Mensaje Individual
  #1 (permalink)  
Antiguo 08/02/2009, 02:42
truskyvb
 
Fecha de Ingreso: octubre-2008
Mensajes: 188
Antigüedad: 15 años, 7 meses
Puntos: 3
Calendario Lunar

Buen día a todos!. Una vez más recurro a vosotros. Gracias de antemano. Se trata de un calendario lunar, pero creo que no tiene en cuenta los años bisiestos y no se como arreglarlo. El código lo encontré en la red y no dice de quien es pero pide respetar los comentarios del autor y así lo hago. Utiliza el control Microsoft Windows Common Controls 2 6.0 (SP6).
El código es:

Fecha = 0
aux = 0
Anno = DTFecha.Year
Mes = DTFecha.Month
Dia = DTFecha.Day
'1. Sumar las 4 cifras del año
For i = 1 To 4
Fecha = Fecha + Val(Mid(Anno, i, 1))
Next
'2. multiplicar por 11
Fecha = Fecha * 11
'3. restar el mayor multiplo de 30 posible
aux = Fecha \ 30
If aux >= 1 Then
aux = aux * 30
Fecha = Fecha - aux
End If
'4. sume el numero del mes, si mes es enero o febrero sumar 1 digito mas
If (Mes = 1) Or (Mes = 2) Then
Mes = Mes + 1
End If
Fecha = Fecha + Mes
'5. restar el mayor multiplo de 30 posible
aux = Fecha \ 30
If aux >= 1 Then
aux = aux * 30
Fecha = Fecha - aux
End If
'6. sume el dia del mes
Fecha = Fecha + Dia
'7. restar el mayor multiplo de 30 posible
aux = Fecha \ 30
If aux >= 1 Then
aux = aux * 30
Fecha = Fecha - aux
End If
txtFase.Caption = " "
If ((Fecha = 0) Or (Fecha < 7) Or (Fecha >= 29)) Then
txtFase.Caption = "LUNA NUEVA"
Image5.Visible = True
ElseIf ((Fecha = 7) Or (Fecha < 14)) Then
txtFase.Caption = "CUARTO CRECIENTE"
Image3.Visible = True
ElseIf ((Fecha = 15) Or (Fecha < 22)) Then
txtFase.Caption = "LUNA LLENA"
Image2.Visible = True
ElseIf ((Fecha = 22) Or (Fecha < 29)) Then
txtFase.Caption = "CUARTO MENGUANTE"
Image4.Visible = True
End If

'------------

Private Sub Form_Load()
DTFecha.Value = Now
End Sub


Un saludo y gracias.