Codigo para controlar la pulsacion de una fecha???

19/04/2006 - 09:28 por Técnicos Aydai | Informe spam
Hola a todos!!!

Perdonad, pero teneis alguien el codigo o la regex necesaria para controlar
la pulsacion de una fecha dentro de un textbox.???

Gracias.

Preguntas similare

Leer las respuestas

#1 Leonardo Azpurua [mvp vb]
19/04/2006 - 17:10 | Informe spam
"Técnicos Aydai" escribió en el mensaje
news:
Mostrar la cita
Hola:

Para "controlar la pulsacion" basta con agregar un manejador para el evento
Click :-)
Si lo que quieres es validar una fecha, tienes al menos dos opciones:

La funcion Microsoft.VisualBasic.IsDate
If Not IsDate(TextBox1.Text) Then
msgBox("Fecha Invalida")
End If

Llamar a Date.Parse controlando la excepcion que podria producirse si la
fecha es invalida.
Try
Dim dt As Date = Date.Parse(TextBox1.Text)
TextBox1.Text =
dt.ToString(System.Globalization.CultureInfo.CurrentCulture.DateTimeFormat.ShortDatePattern)
Catch ex As Exception
MsgBox("Fecha Invalida:" & ex.Message)
End Try

Nota que en el segundo ejemplo, adicionalmente se formatea el contenido de
TextBox1 segun el patron definido para la fecha corta en la configuracion
regional del equipo.

Salud!
#2 Técnicos Aydai
20/04/2006 - 09:12 | Informe spam
Hola Leonardo!! Muchas gracias por tu respuesta, pero no es exactamente lo
que busco, ya que lo que yo quiero es que cuando se pulse alguna tecla
dentro del textbox, solo pueda ser con el formato dd/mm/yyyy o dd/mm/yy.

Gracias de todas formas.

"Leonardo Azpurua [mvp vb]" <l e o n a r d o (arroba) m v p s (punto) o r g>
escribió en el mensaje news:
Mostrar la cita
evento
Mostrar la cita
dt.ToString(System.Globalization.CultureInfo.CurrentCulture.DateTimeFormat.S
hortDatePattern)
Mostrar la cita
#3 DosFlores
20/04/2006 - 11:18 | Informe spam
Esta función la saqué de J.P. Leyten que a su vez partió del ActiveX:
effMaskedEdit la URL es:
luego la modifiqué a mi gusto, la utilizo en VB6 por lo que tiene unos
cuantos años. Le pasamos la tecla que se pulsa y nos valida si es correcta.
No solo la uso para fechas, tambíén para números y alguna cosa más.

KeyAscii=Tecla pulsada
eAllowed=Enum de tipos de campos, si vas a controlar fechas no te hace
falta.
Suprimir= Hay campos en los que no me interesa suprimir y bloqueo la tecla.

'Meollo de la cuestión. Aquí se produce toda la validación de
'las teclas pulsadas, no del campo introducido, sólo de la tecla
'que hemos pulsado en el campo en el que estamos situados.
' Original Code produced by TheFrogPrince
Private Function OnKeyPress(ByVal KeyAscii As KeyCodeConstants, ByVal
eAllowed As AllowedKeys, Suprimir As Boolean) As Integer
Dim Dia As String, Mes As String, Anno As String
Dim Paso As String 'Para hacer con ella lo que queramos
Dim Posicion As Integer, PosicionAnt As Integer 'Para saber donde esta
Dim PosAnno As Integer 'el cursor

' Allow All System Keys Through
If KeyAscii < 32 Then
' AutoTab
If m_AutoTab And KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{TAB}"
End If
'Las siguientes líneas es para que en la fecha no me borre
'las barras y así queda precioso. Es un coñazo pero queda bien
'Las propiedades del LENGHT son las que
If m_AllowedKeys = OnlyDate And KeyAscii = vbKeyBack Then
'El año lo dejo al libre albedrío
If VariantBox.SelStart > 0 And VariantBox.SelStart < 7 Then
'Si borro y existe la barra me paso al anterior
'si no borro directamente
If Mid(VariantBox, VariantBox.SelStart, 1) = "/" Then
VariantBox.SelStart = VariantBox.SelStart - 2
Else
VariantBox.SelStart = VariantBox.SelStart - 1
End If
VariantBox.SelLength = 1
VariantBox.SelText = " "
VariantBox.SelStart = VariantBox.SelStart - 1
KeyAscii = 0
Else 'Si tengo marcado el campo lo borro
If VariantBox.SelLength > 0 Then
VariantBox = " / / "
VariantBox.SelLength = 0
KeyAscii = 0
End If
End If
End If
OnKeyPress = KeyAscii
Exit Function
End If
'Capturo SUPRIMIR para que no haga cosas raras
If KeyAscii = vbKeyDelete And Suprimir Then
If m_AllowedKeys = OnlyDate Then
Paso = Left(VariantBox, 2) + Mid(VariantBox, 4, 2) +
Mid(VariantBox, 7, 4)
PosicionAnt = VariantBox.SelStart
If VariantBox.SelStart > 0 Then
'Borro el caracter donde estoy situado y me quedo
'para no mover la barra de separción
Select Case VariantBox.SelStart
Case 0 To 1
Posicion = VariantBox.SelStart
Case 3 To 4
Posicion = VariantBox.SelStart - 1
Case 6 To 7
Posicion = VariantBox.SelStart - 2
End Select
Paso = Left(Paso, Posicion) + Mid(Paso, Posicion + 2, 10)
Else
If VariantBox.SelLength > 0 Then
Paso = ""
VariantBox.SelLength = 0
KeyAscii = 0
Else
Paso = Mid(Paso, 2, 10)
End If
End If
Paso = Paso & Space(10 - Len(Paso))
KeyAscii = 0
VariantBox = Mid(Paso, 1, 2) + "/" + Mid(Paso, 3, 2) + "/" +
Mid(Paso, 5, 4)
VariantBox.SelStart = PosicionAnt
Exit Function
End If
End If

'Si esto al final del campo, ya no puedo insertar más
'caracteres a no ser que esté marcado
If Len(RTrim(VariantBox)) = m_LongCampo Then
'RDev. A veces la fecha está, pero no seleccionada
'al meterse en el else borraría la fecha.
'Comento el if.
If VariantBox.SelLength <> m_LongCampo Then
KeyAscii = 0
Exit Function
Else
If m_AllowedKeys = OnlyDate Then VariantBox = " / / "
End If
End If


' Eliminate In-Eligible Keystrokes
Select Case True
Case KeyAllowed(KeyAscii, eAllowed)
Case KeyNotAllowed(KeyAscii, eAllowed)
KeyAscii = 0
Case (eAllowed And OnlyDate) And (KeyAscii < vbKey0 Or KeyAscii >
vbKey9)
KeyAscii = 0
End Select

' Coerce values
Select Case True
Case (eAllowed And Lowercase)
KeyAscii = Asc(LCase(Chr(KeyAscii)))
Case (eAllowed And UpperCase)
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Select

'VALIDACIÓN DE LA ENTRADA DE LA FECHA
'Si hay FALLOS arreglarlo por aquí. TRATO la fecha en 3 partes
'Día, MES y AÑO, y valido la tecla pulsada si corresponde
'con el campo, es decir, no se puede meter día 40, por lo que
'el primer dígito del día no puede ser 4. Si el primero es
'3, el segundo no puede ser 2, etc..
If m_AllowedKeys = OnlyDate Then
Dia = Space(2)
Mes = Space(2)
Anno = Space(4)
Mid(Dia, 1) = RTrim(Left(VariantBox, 2))
Mid(Mes, 1) = RTrim(Mid(VariantBox, 4, 2))
Mid(Anno, 1) = Trim(Mid(VariantBox, 7, 4))
'If funcG.EsNull(Mes) Then Mes = Month(funcG.FechaActual)
'If funcG.EsNull(Anno) Then Anno = Year(funcG.FechaActual)
'Posición es para situarme dónde corresponda. Hace
'que el cursor se pase dónde yo quiera. Nunca dejo que
'se ponga en "/"
Posicion = VariantBox.SelStart
Select Case VariantBox.SelStart
Case 0 To 1 'DIA
'Dígito 1
If Len(RTrim(Dia)) = 0 And KeyAscii < vbKey4 Then
Dia = Chr$(KeyAscii) & " "
Posicion = Posicion + 1
'Dígito 2
ElseIf Len(RTrim(Dia)) = 1 And RTrim(Dia) & Chr(KeyAscii) >
0 And RTrim(Dia) & Chr(KeyAscii) < 32 Then
Dia = RTrim(Dia) & Chr$(KeyAscii)
Posicion = Posicion + 2
'dígito 2 en inserción para introducirlo si
'hemos borrado algo con suprimir.
ElseIf Len(RTrim(Dia)) = 2 And Len(RTrim(Anno)) < 4 Then
Anno = Right(Mes, 1) + Anno
Mes = Right(Dia, 1) & Left(Mes, 1)
If VariantBox.SelStart = 0 Then
Mid(Dia, VariantBox.SelStart + 1) = Chr(KeyAscii) +
Left(Dia, 1)
Posicion = 1
Else
Mid(Dia, VariantBox.SelStart + 1) = Chr(KeyAscii)
Posicion = 3
End If
' Else
' funcG.Mensaje msgDia & RTrim(Dia) & Chr(KeyAscii),
MensajeInformacion
End If
Case 3 To 4 'MES
If Len(RTrim(Mes)) = 0 And KeyAscii < vbKey2 Then
Mes = Chr$(KeyAscii) & " "
Posicion = Posicion + 1
'A continuación valido el mes según el
'día introducido.
ElseIf Len(RTrim(Mes)) = 1 And RTrim(Mes) & Chr(KeyAscii) >
0 And RTrim(Mes) & Chr(KeyAscii) < 13 Then
Select Case (RTrim(Mes) & Chr(KeyAscii))
Case "02" 'Febrero
If Dia < "30" Then
Mes = RTrim(Mes) & Chr(KeyAscii)
Posicion = Posicion + 2
End If
Case "04", "06", "09", "11" '30 días
If Dia < "31" Then
Mes = RTrim(Mes) & Chr$(KeyAscii)
Posicion = Posicion + 2
End If
Case Else '31 días
Mes = RTrim(Mes) & Chr$(KeyAscii)
Posicion = Posicion + 2
End Select
ElseIf Len(RTrim(Mes)) = 2 And Len(RTrim(Anno)) < 4 Then
Anno = Right(Mes, 1) + Anno
If VariantBox.SelStart = 3 Then
Mid(Mes, 1) = Chr(KeyAscii) & Left(Mes, 1)
Posicion = 4
Else
Mid(Mes, 2) = Chr(KeyAscii)
Posicion = 6
End If
End If
Case 6 To 9 'AÑO
PosAnno = VariantBox.SelStart - 6
Anno = Left(Anno, PosAnno) & Chr(KeyAscii) & Mid(Anno,
PosAnno + 1, 4)
Posicion = Posicion + 1
End Select
KeyAscii = 0 'Pongo el nuevo valor en TEXT
VariantBox = Dia & "/" & Mes & "/" & Anno
VariantBox.SelStart = Posicion
VariantBox.SetFocus
End If

OnKeyPress = KeyAscii
End Function


Un saludo
Oscar Montesinos
"Técnicos Aydai" escribió en el mensaje
news:uHB%
Mostrar la cita
#4 DosFlores
20/04/2006 - 11:38 | Informe spam
La URL que no la copié en el mensaje anterior es:
http://www.planet-source-code.com/x...owCode.htm
Un saludo
Oscar Montesinos
"DosFlores" escribió en el mensaje
news:%
Mostrar la cita
#5 Técnicos Aydai
20/04/2006 - 13:54 | Informe spam
Muchisimas gracias, todo perfecto
"DosFlores" escribió en el mensaje
news:
Mostrar la cita
http://www.planet-source-code.com/x...owCode.htm
Mostrar la cita
esta
Mostrar la cita
+
Mostrar la cita
dd/mm/yy.
Mostrar la cita
r
Mostrar la cita
la
Mostrar la cita
dt.ToString(System.Globalization.CultureInfo.CurrentCulture.DateTimeFormat.S
Mostrar la cita
contenido
Mostrar la cita
Ads by Google
Search Busqueda sugerida