Tema: Reloj fijo
Ver Mensaje Individual
  #39 (permalink)  
Antiguo 27/07/2010, 23:42
Avatar de XYON126
XYON126
 
Fecha de Ingreso: abril-2006
Mensajes: 272
Antigüedad: 18 años, 9 meses
Puntos: 0
Respuesta: Reloj fijo

Cita:
Iniciado por -rommel_ Ver Mensaje
y mejor posteas tu codigo... o subes tu aplicacion para beneficio de todos... siiii
Por mi parte no hay ningun problema aunque podriamos decir mejor el codigo de erbuson, ya que me lo ha corregido, mejorado y eliminar todo error, dejandolo como de un profesional y no de un autodidacta como hobby como soy yo.

Aqui posteo una imagen de como queda ahora con este codigo, las pictures o todo el paquete si alguien lo quiere se lo remito por E-mail.

Un saludote



aunque la version mejorada sera asi mas o menos(esta en proceso)




Bueno aqui el codigo lo de los Label necesarios, etc. con las fotos se ve, espero.

codigo .:

Option Explicit

'Funcion para cambiar el color del texto
'################################################# ##########
Private Sub AjustaColor(Letrero As Label)
If Letrero.Caption = "ABIERTA" Then
Letrero.ForeColor = vbGreen
ElseIf Letrero.Caption = "CERRADA" Then
Letrero.ForeColor = vbRed
Else
Letrero.ForeColor = vbBlack
End If
End Sub


'Funcion para determinar Abierta/Cerrada
'################################################# ##########
' Ha sido modificada para recibir el Caption del Label que muestra el día y hora
Public Function CloseOpen(LabelHora As Label) As String
Dim Hora As Date, Dia As String
Hora = CDate(Right$(LabelHora.Caption, 8))
Dia = Left$(LabelHora.Caption, 3)
If Hora > CDate("8:29:59") And Hora < CDate("17:29:59") Then
CloseOpen = "ABIERTA"
Else
CloseOpen = "CERRADA"
End If
If Dia = "sáb" Or Dia = "dom" Then CloseOpen = "CERRADA"
End Function


'Funcion para cambiar el color del texto en cada Label
'################################################# ##########
Private Sub ComoEsta_Change(Index As Integer)
AjustaColor ComoEsta(Index)
End Sub

'################################################# ##########
Private Sub HoraActual()
Dim Ahora As Date, Indice As Integer
Ahora = Now
PonerHora 0, Ahora, -1 'Londres
PonerHora 1, Ahora, -6 'NuevaYork
PonerHora 2, Ahora, 7 'Tokyo
PonerHora 3, Ahora, 8 'Sidney
PonerHora 4, Ahora, 0 'Madrid
PonerHora 5, Ahora, 0 'Francfort
PonerHora 6, Ahora, 0 'Zurich
PonerHora 7, Ahora, 10 'Wellington
PonerHora 8, Ahora, -6 'Toronto
End Sub


'################################################# ##########
Private Sub PonerHora(Indice As Integer, LaHora As Date, Diferencia As Integer)
' Pone la Hora en la Etiqueta correspondiente a Indice
QueHora(Indice) = Format(DateAdd("h", Diferencia, LaHora), "ddd hh:mm:ss")
' Después, la misma rutina, efectua el cambio de Abierta/Cerrada
ComoEsta(Indice) = CloseOpen(QueHora(Indice))
End Sub



'################################################# ##########
Private Sub Timer1_Timer()
HoraActual
End Sub

'################################################# ##########
Private Sub Form_Load()
HoraActual
Timer1.Interval = 1000
Timer1.Enabled = True
End Sub

Última edición por XYON126; 29/07/2010 a las 11:36