Tema: Reloj fijo
Ver Mensaje Individual
  #29 (permalink)  
Antiguo 25/07/2010, 06:00
Avatar de erbuson
erbuson
 
Fecha de Ingreso: noviembre-2009
Mensajes: 701
Antigüedad: 15 años
Puntos: 53
Respuesta: Reloj fijo

Hola Xyon:

He corregido parcialmente tu código . Cuando se van a utilizar muchos Labels o controles iguales con una función mas o menos parecida es muchos mas simple y facil utilizar arrays de Controles.

En este caso he creado lo necesario, tu puedes crear el resto para la imagen del programa.

Un Array llamado QueHora con los indices QueHora(0) a QueHora(8)
Un Array llamado ComoEsta con los indices ComoEsta(0) a ComoEsta(8)

Se corresponden de o a 8 con las Poblaciones que utilizas.

Este sería el código del programa

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


La siguiente ha sido modificada para evitar el error y recibe el Label que contiene ddd hh:mm:ss por lo que efectúa la separación y conversión necesaria.

'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


La siguiente rutina es el Change del Label, con la ventaja de que SOLO necesitas una por muchos Labels que tengas ya que el Index determina que Label ha cambiado.

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


Modificada la siguiente para llamar a una nueva PonerHora, que al tenerlo de este modo tiene la ventaja de que puede muy facilmente cambiar el formato de visualización ya que debes hacerlo sólo en un sitio.

'################################################# ##########
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


La siguiente de poner hora, que como ves se encarga ella misma de llamar a la que modificará el texto de ABIERTA/CERRADA al tener los indices es muy facil ya que QueHora(Indice) se corresponde con ComoEsta(Indice)

'################################################# ##########
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", -1, 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


Bueno, espero no haberte confundido, la única intención como muy bien sabes por otros contactos que hemos tenido es que simplifiques tus futuaras aplicaciones.

Saludos
__________________
Agradecer a quien te enseñó, es enseñar lo que de él aprendiste.
Recuerda: Decir gracias, poco cuesta y mucho vale ...