
08/02/2009, 02:42
|
| | Fecha de Ingreso: octubre-2008
Mensajes: 188
Antigüedad: 16 años, 6 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. |