TextBox (Solo Fecha)

[ADONAIRAFA]

Saludos a todos !!!

Este es un pequeño aporte de mi parte (si han creado uno parecido mis disculpas de antemano).
Se trata de un TextBox para escribir únicamente fechas.
Pero eso no es todo, este en formato "dd/mm/yyyy", alineado a la izquierda, para el primer dígito(Fecha), solo se podrá escribir del 0 al 3, al escribir el segundo dígito (del 0 al 9 obvio !!! ) automáticamente se añadirá la barra "/". Para el 1er dígito correspondiente al mes, solo se permite escribir del 0 al 1 (a menos que se use en Júpiter, donde un año tendrá más de 40 meses terrestres ), la 2da cifra (del mes) se podrá escribir del 1 al 9 si la primera es 0 (ejem: 01, 03, 04..., 09) y del 0 al 2 si la 1ra es 1 (ejem: 10, 11 y 12). Luego de escribir las dos cifras del mes de forma automática se añadirá la segunda barra "/", y para finalizar se puede escribir el año ("yyyy").

Lo diseñe como un UC, con las propiedades: BackColor, Font, ForeColor, Text entre otras pocas, y unos pocos eventos comunes. Aquí está es código:
Bueno, desde el "rollo" del "difunto" de Megaupload (quien falleció accidentalmente victima de una "SOPA" 'envenenada' ) no encuentro hosting bueno para subir (así que recomiéndeneme uno o unos buenos para subir) de momento pruebo con este para subir el UC diseñado...

(Ver antepenúltimo mensaje publicado por mí en este Post, para ver el código final del UC, así como del link para descargarlo)

[raul338]

No lo probe, pero creo que este codigo

Código: (vb) [Seleccionar]

Private Sub OnlyNumbers0To2(KeyAscii As Integer)
        Select Case Chr(KeyAscii)
                Case "0" To "2"
                Case Chr(8)
                Case Chr(44)
                        KeyAscii = 0
                Case Else
                        KeyAscii = 0
        End Select
End Sub
 
Private Sub OnlyNumbers0To3(KeyAscii As Integer)
        Select Case Chr(KeyAscii)
                Case "0" To "3"
                Case Chr(8)
                Case Chr(44)
                        KeyAscii = 0
                Case Else
                        KeyAscii = 0
        End Select
End Sub
 
Private Sub OnlyNumbers(KeyAscii As Integer)
        Select Case Chr(KeyAscii)
                Case "0" To "9"
                Case Chr(8)
                Case Chr(44)
                        KeyAscii = 0
                Case Else
                        KeyAscii = 0
        End Select
End Sub
 
Private Sub OnlyNumbers1To9(KeyAscii As Integer)
        Select Case Chr(KeyAscii)
                Case "1" To "9"
                Case Chr(8)
                Case Chr(44)
                        KeyAscii = 0
                Case Else
                        KeyAscii = 0
        End Select
End Sub
Se podria mejorar bastante sin necesidad de api ni ninguna magia negra xD

[ADONAIRAFA]

Exacto raul338, por eso puse: "agradezco todas las correcciones y mejoras" eso significa que por favor muestren, suban, lanzen esas correcciones . De paso que claro que no se necesitan API's !!!

Saludos !!!

[ADONAIRAFA]

Se me olvidaba, tiene un pequeño defecto (nada que afecte su funcionalidad) y es que cuando quieren corregir usando 'Back Space', borra todo, Le he dado vueltas y no he encontrado la corrección a este pequeño defecto.

[E N T E R]

Interesante vamos a probar, gracias por compartir man.

Saludos!!!

[Ellesar]

yo tengo una pequeña duda, lei todo el contenido del UC pero no comprendo las líneas marcadas como comentarios
'MappingInfo=UserControl,UserControl,-1,DrawStyle
'MappingInfo=Text1,Text1,-1,Change

he de suponer que se usan para ejecutar los eventos y demás.
tengo 3 preguntas

1° Por que en algunos casos usaste UserControl y en otros Text1
2° Que significa el Valor -1
3° Por la única variable definida es la de m_BackStyle?

Disculpe si son preguntas de novato pero estoy empezando a ver el tema de UC y todavía no entiendo mucho.
Si las respuestas a mis preguntas están en alguna guía o similar y me lo pueden facilitar se los agradecería, caso contrario diganme que buscaré dentro del foro y en google


Si estas buscando un host gratuito yo te recomiendo 4shared te da 15 GB de espacio gratuito

Saludos

[ADONAIRAFA]

Saludos Ellesar !!!

yo tengo una pequeña duda, lei todo el contenido del UC pero no comprendo las líneas marcadas como comentarios
'MappingInfo=UserControl,UserControl,-1,DrawStyle
'MappingInfo=Text1,Text1,-1,Change

he de suponer que se usan para ejecutar los eventos y demás.

Bueno, esto surge a raíz de que cuando estaba diseñando el UC , quería agregarle las propiedades BackColor, Font, ForeColor entre otras, (debidamente por supuesto) pero cuando lo hacía, a la hora del usuario escoger un color de fondo, un tipo de fuente, color de la misma, éste, tenía que hacerlo manualmente (o sea colocarle el valor deseado directamente) , fue entonces cuando en otro Post pregunté acerca de las propiedades de un UC y fue uno de los moderadores de este foro, Xkiz, quien me aconcejó el uso del asistente (Wizard) para la creación de un UC.

Al hacer uso del Wizard, este colocó de manera predeterminada los comentarios que viste (por los que me pereguntaste al principio de tu inquietud), y en algunos casos con la advertencia de no modificar y/o quitarlos.

Las subrutinas "OnlyNumbers0To2", "OnlyNumbers0To3", "OnlyNumbers1To9" y "OnlyNumbers" y lo contenido en el método KeyPress del Text1 y Resize del UC, las diseñé. Todo lo demás lo creó el asistente. Las subrutinas definen los números que podrán escribirse según la posición del carácter a colocar. Lo del evento resize, indica al control, que en la medida que cambies el tamaño del UC mientras lo uses una vez ya compilado, el TextBox (Text1) contenido en él, adquiera el mismo tamaño, de otra forma sería un 'desastre' visual.

Contestando tus otras preguntas:
1.- Creo que arriba te la aclaré.
2.- En cuanto al valor -1, como te había mencionado, no lo coloqué yo sino el Wizard
3.- Si te fijas bien, hay otra variable declarada: lng (por longitud, no por 'Long'). Con esta variable podía determinar según el caso, la longitud del String escrito en determinado momento en el Text1.

Y no te disculpes por tus preguntas, eso está bien y más aún cuando estas están bien planteadas. Cuando empecé en esto de los UC (aunque todavía estoy en comienzos ) En este foro, unos de los "Papás" en UC's, es Leandro, Cobein, Xkiz, entre otros (díscúlpenme si no mencioné a alguien(nos) más, porque hay más...).

Creo que Leandro tiene algo en cuanto a creación de UC's, podrías preguntarle.

Mil gracias por la recomendación de '4Shared' ya me voy a poner en él !!!


Saludos !!!

Manuel F. Borrego S.
Barcelona, Venezuela.

[Ellesar]

Manuel ante todo muchas gracias por responder.

Antes de preguntar intente usar el Wizard pero como en esta PC tengo vb6 portable y sólo genera .exe no pude probarlo
Por el tema de la 1° pregunta yo deduzco que el uso de UserControl se refiere a propiedades relacionadas con Windows, por ejemplo .HdC y que las propiedades relacionadas solamente con el control llevan el nombre de text1 (en este caso).

Por otro lado te quería peguntar si el nombre de text1 lo colocaste vos en el Wizard y si se podría, por ejemplo, cambiar por DateTxtBox (por poner un nombre más acorde al uso del UC)

Yo la verdad es que todavía no comence con los UC's estoy viendo y leyendo los que han creados otros para aprender un poco e informarme.
De momento me gustaría poder hacer un TextBox que se pueda transparentar, ya que he intentado con el RichTextBox pero no lo he logrado. Igualmente trataría de hacerlo una vez que halla experimentado con UC's no creo que se pueda hacer de "golpe y tirón" sin saber nada

Saludos

Edito: El código que agregaste en el edit hay que hacerle una corrección ya que si colocas 0 lo acepta y la fecha queda como 00/xx/xxxx
Con sólo poner un <= ya funciona bien

Código: [Seleccionar]

         If lng = 1 Then
                If KeyAscii <= 48 Or KeyAscii > 49 Then
                        KeyAscii = 0
                        Exit Sub
                End If


[ADONAIRAFA]

En cuanto al VB 6.0 si puedes, instala la versión "Enterprise" (aunque con la "Professional" está más que bien !!!).

Antes que nada, cuando vas a crear el UC, una vez creado el proyecto, sobre el UC colocas el control de tu preferencia, en este caso coloqué un TextBox, el cuan 'por defecto' como ya sabes se llama Text1, ese nombre o el que quieras colocarle (por ejemplo 'JustDateTextBox') solo lo verás en el código que diseñes, pero el usuario final del UC no lo verá. Ahora, al nombre propiamente dicho del UC, si se lo puedes colocar y si se verá al final (espero me entiendas).

Una vez que tengas listo (visualmente hablando) tu UC, haces uso del Wizard (pero entonces como te dije al principio, instálate la versión del VB que te recomendé [y si puedes, si no lo has hecho ya, te recomiendo empieces a dar los primeros pasos en VB 9.0 (.NET 2008) o VB 10.0 (.NET 2010) estoy seguro de que te va a gustar].

En cuanto al TextBox transparente, te sugiero revises los post's, porque creo que ví uno acerca de ese tema, no estoy bien seguro pero creo que sí.

Espero haber podido ayudarte en algo.


Saludos !!!


Manuel F. Borrego S.
Barcelona, Venezuela.

[Ellesar]

Es que esta no es mi PC , es de mis padres, estoy de visita. En mi Pc si tengo instalado vb6 prof. sp6.

ha! Claro ahora entiendo jaja.

Lo que hay en el foro y en muchos lado es el textbox totalmente transparente cosa que no me sirve (yo me expresé mal antes), lo que quiero hacer es que puedas elegir el nivel de transparencia ^^, pero eso es tema para más adelante ahora voy a ver que se me ocurre para ir probando con UC's.

Gracias por Responder, Saludos

[ADONAIRAFA]

Edito: El código que agregaste en el edit hay que hacerle una corrección ya que si colocas 0 lo acepta y la fecha queda como 00/xx/xxxx
Con sólo poner un <= ya funciona bien

Código: [Seleccionar]

         If lng = 1 Then
                If KeyAscii <= 48 Or KeyAscii > 49 Then
                        KeyAscii = 0
                        Exit Sub
                End If


Dejame decirte que el propósito en el caso de arriba es que solo si en el primer dígito de de la fecha "dd/mm/yyyy" es 3 ("3a/mm/yyyy"), el segundo dígito sea 0 o 1 ("30/mm/yyyy" o "31/mm/yyyy") y no sea admitido ningún otro nro.
En ASCII:
48 ---> 0
49 ---> 1

Y no se como no funcionó en tu PC, tal como lo escribí, porque así lo puse en mi PC y en mi Laptop y funciona correctamente, ahí si no me lo explico...!!!

Saludos y un abrazo !!!


Manuel F. Borrego S.
Barcelona, Venezuela

[Ellesar]

Claro me olvidé de ese caso! -.-"

Entonces tendrías que agregar algo así.

Código: [Seleccionar]

If lng = 1 Then
                if keyascii = 0 and Left(text1.text,1) = "0" then
                    KeyAscii = 0
                End if
                If KeyAscii < 48 Or KeyAscii > 49 Then
                        KeyAscii = 0
                        Exit Sub
                End If

Te contesto rápido por que estoy apurado. Saludos

[ADONAIRAFA]

Te insisto, no tienes que agregarle nada

lng = Len(Text1.Text)
        If lng = 1 Then
                If KeyAscii < 48 Or KeyAscii > 49 Then
                        KeyAscii = 0
                        Exit Sub
                End If
                '
                '
        '
        '

Ya lo probé varias veces y en otras PC's y funciona muy bien (repito, sin agregarle más nada). Ahora como mencionaste antes, tenías o tienes el "portable" y no se, nunca lo he usado y no se si será el problema. Pruebalo tal como está en tu PC (Se me olvidaba, el archivo que subí a netload, no tenía esa corrección, ya que el error lo descubrí despues, pero el código mostrado al principio si está corregido).
Ahora si a tí te funciona así, no se diga más, continúa usándolo así (pero insisto...!!!)


Saludos !!!

[Ellesar]

Yo agregué la corrección que me dijiste.

éste es el código que tengo

Código: [Seleccionar]

Private Sub Text1_KeyPress(KeyAscii As Integer)
        If KeyAscii = 8 Then
                Text1.Text = ""
        End If
        lng = Len(Text1.Text)
        If lng = 1 Then
                If KeyAscii < 48 Or KeyAscii > 49 Then
                        KeyAscii = 0
                        Exit Sub
                End If
        ElseIf lng = 2 Then
                If KeyAscii < 48 Or KeyAscii > 49 Then
                        KeyAscii = 0
                        Exit Sub
                End If
                Text1.Text = Text1.Text + "/"
                Text1.SelStart = 3
                Exit Sub
        ElseIf lng = 4 Then
                If Mid(Text1.Text, 4, 1) > 0 Then
                        OnlyNumbers0To2 KeyAscii
                Else
                        OnlyNumbers1To9 KeyAscii
                End If
                Exit Sub
        ElseIf lng = 5 Then
                If KeyAscii < 49 Or KeyAscii > 50 Then
                        KeyAscii = 0
                        Exit Sub
                End If
                Text1.Text = Text1.Text + "/"
                Text1.SelStart = 6
        End If
        '//
        Select Case lng
                Case 0
                        OnlyNumbers0To3 KeyAscii
                Case 1, 4
                        OnlyNumbers KeyAscii
                Case Else
                        OnlyNumbers KeyAscii
        End Select
End Sub

Y éste es el caso que te digo que queda mal, por eso la corrección que te agregue yo.



La línea que agrego yo es para evitar que pongan otro 0 si ya existe un 0 antes.

Saludos

PD: No sé si a vos te sucede o no pero como a mi me pasaba te lo dejo

[ADONAIRAFA]

Saludos a todos !!!

Mis disculpas a todos los que vieron este post, copiaron el código y bajaron el archivo, ya que este contenía un error , que el amigo Ellesar (te mereces un +1 compadre !!! ) me hizo ver: en el control diseñado, a la hora de escribir una fecha, el usuario por error podría tipear "00/mm/yyyy" lo cual es obvio el error !!! gracias a Ellesar que advirtió el defecto, este pudo ser corregido, ahora el usuario si escribe el primer dígito un "0", el segundo dígito aceptado por el UC estará entre el 1 y el 9. Si escribe un "1" o un "2", el segundo dígito podrá estar entre el rango del 0 al 9.
Ahora, si el 1er dígito es "3", el segundo nro validado por el UC estará entre 0 y 1, no admitiendo otro mayor. Ya lo demás lo podrán ver uds mismos al probarlo. Gracias Ellesar !!!

Aquí el código:

Código: (VB) [Seleccionar]

Option Explicit


Private lng As Integer
'Default Property Values:
Const m_def_BackStyle = 0
'Property Variables:
Dim m_BackStyle As Integer
'Event Declarations:
Event Click() 'MappingInfo=Text1,Text1,-1,Click
Event DblClick() 'MappingInfo=Text1,Text1,-1,DblClick
Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=Text1,Text1,-1,KeyDown
Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=Text1,Text1,-1,KeyUp
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Text1,Text1,-1,MouseDown
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Text1,Text1,-1,MouseMove
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=Text1,Text1,-1,MouseUp
Event Change() 'MappingInfo=Text1,Text1,-1,Change



'ADVERTENCIA: NO QUITAR NI MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS
'MappingInfo=Text1,Text1,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
        BackColor = Text1.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
        Text1.BackColor() = New_BackColor
        PropertyChanged "BackColor"
End Property

'ADVERTENCIA: NO QUITAR NI MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS
'MappingInfo=Text1,Text1,-1,ForeColor
Public Property Get ForeColor() As OLE_COLOR
        ForeColor = Text1.ForeColor
End Property

Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
        Text1.ForeColor() = New_ForeColor
        PropertyChanged "ForeColor"
End Property

'ADVERTENCIA: NO QUITAR NI MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS
'MappingInfo=Text1,Text1,-1,Enabled
Public Property Get Enabled() As Boolean
        Enabled = Text1.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
        Text1.Enabled() = New_Enabled
        PropertyChanged "Enabled"
End Property

'ADVERTENCIA: NO QUITAR NI MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS
'MappingInfo=Text1,Text1,-1,Font
Public Property Get Font() As Font
        Set Font = Text1.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
        Set Text1.Font = New_Font
        PropertyChanged "Font"
End Property

'ADVERTENCIA: NO QUITAR NI MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS
'MappingInfo=Text1,Text1,-1,Appearance
Public Property Get Appearance() As Integer
        Appearance = Text1.Appearance
End Property

Public Property Let Appearance(ByVal New_Appearance As Integer)
        Text1.Appearance() = New_Appearance
    PropertyChanged "Appearance"
End Property

'ADVERTENCIA: NO QUITAR NI MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS
'MemberInfo=7,0,0,0
Public Property Get BackStyle() As Integer
        BackStyle = m_BackStyle
End Property

Public Property Let BackStyle(ByVal New_BackStyle As Integer)
        m_BackStyle = New_BackStyle
        PropertyChanged "BackStyle"
End Property

'ADVERTENCIA: NO QUITAR NI MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS
'MappingInfo=Text1,Text1,-1,BorderStyle
Public Property Get BorderStyle() As Integer
        BorderStyle = Text1.BorderStyle
End Property

Public Property Let BorderStyle(ByVal New_BorderStyle As Integer)
        Text1.BorderStyle() = New_BorderStyle
        PropertyChanged "BorderStyle"
End Property

'ADVERTENCIA: NO QUITAR NI MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS
'MappingInfo=Text1,Text1,-1,Refresh
Public Sub Refresh()
        Text1.Refresh
End Sub

Private Sub OnlyNumbers(KeyAscii As Integer)
        Select Case Chr(KeyAscii)
                Case "0" To "9"
                Case Chr(8)
                Case Chr(44)
                        KeyAscii = 0
                Case Else
                        KeyAscii = 0
        End Select
End Sub

Private Sub OnlyNumbers0To1(KeyAscii As Integer)
        Select Case Chr(KeyAscii)
                Case "0" To "1"
                Case Chr(8)
                Case Chr(44)
                        KeyAscii = 0
                Case Else
                        KeyAscii = 0
        End Select
End Sub

Private Sub OnlyNumbers0To2(KeyAscii As Integer)
        Select Case Chr(KeyAscii)
                Case "0" To "2"
                Case Chr(8)
                Case Chr(44)
                        KeyAscii = 0
                Case Else
                        KeyAscii = 0
        End Select
End Sub

Private Sub OnlyNumbers0To3(KeyAscii As Integer)
        Select Case Chr(KeyAscii)
                Case "0" To "3"
                Case Chr(8)
                Case Chr(44)
                        KeyAscii = 0
                Case Else
                        KeyAscii = 0
        End Select
End Sub

Private Sub OnlyNumbers1To9(KeyAscii As Integer)
        Select Case Chr(KeyAscii)
                Case "1" To "9"
                Case Chr(8)
                Case Chr(44)
                        KeyAscii = 0
                Case Else
                        KeyAscii = 0
        End Select
End Sub

Private Sub Text1_Click()
        RaiseEvent Click
End Sub

Private Sub Text1_DblClick()
        RaiseEvent DblClick
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
        RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
        If KeyAscii = 8 Then
                Text1.Text = ""
        End If
        '//
        lng = Len(Text1.Text)
        If lng = 1 Then
                Select Case Text1.Text
                        Case "0"
                                OnlyNumbers1To9 KeyAscii
                        Case "1" To "2"
                                OnlyNumbers KeyAscii
                        Case "3"
                                OnlyNumbers0To1 KeyAscii
                End Select
        ElseIf lng = 2 Then
                If KeyAscii < 48 Or KeyAscii > 49 Then
                        KeyAscii = 0
                        Exit Sub
                End If
                Text1.Text = Text1.Text + "/"
                Text1.SelStart = 3
                Exit Sub
        ElseIf lng = 4 Then
                If Mid(Text1.Text, 4, 1) > 0 Then
                        OnlyNumbers0To2 KeyAscii
                Else
                        OnlyNumbers1To9 KeyAscii
                End If
                Exit Sub
        ElseIf lng = 5 Then
                If KeyAscii < 49 Or KeyAscii > 50 Then
                        KeyAscii = 0
                        Exit Sub
                End If
                Text1.Text = Text1.Text + "/"
                Text1.SelStart = 6
        End If
        '//
        Select Case lng
                Case 0
                        OnlyNumbers0To3 KeyAscii
                Case 1, 4
                        OnlyNumbers KeyAscii
                Case Else
                        OnlyNumbers KeyAscii
        End Select
End Sub

Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer)
        RaiseEvent KeyUp(KeyCode, Shift)
End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
        RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub

Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub

Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
        RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

'ADVERTENCIA: NO QUITAR NI MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS
'MappingInfo=Text1,Text1,-1,Alignment
Public Property Get Alignment() As Integer
        Alignment = Text1.Alignment
End Property

Public Property Let Alignment(ByVal New_Alignment As Integer)
        Text1.Alignment() = New_Alignment
        PropertyChanged "Alignment"
End Property

'ADVERTENCIA: NO QUITAR NI MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS
'MappingInfo=UserControl,UserControl,-1,AutoRedraw
Public Property Get AutoRedraw() As Boolean
        AutoRedraw = UserControl.AutoRedraw
End Property

Public Property Let AutoRedraw(ByVal New_AutoRedraw As Boolean)
        UserControl.AutoRedraw() = New_AutoRedraw
        PropertyChanged "AutoRedraw"
End Property

Private Sub Text1_Change()
        RaiseEvent Change
End Sub

'ADVERTENCIA: NO QUITAR NI MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS
'MappingInfo=UserControl,UserControl,-1,ClipBehavior
Public Property Get ClipBehavior() As Integer
        ClipBehavior = UserControl.ClipBehavior
End Property

Public Property Let ClipBehavior(ByVal New_ClipBehavior As Integer)
        UserControl.ClipBehavior() = New_ClipBehavior
        PropertyChanged "ClipBehavior"
End Property

'ADVERTENCIA: NO QUITAR NI MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS
'MappingInfo=UserControl,UserControl,-1,ClipControls
Public Property Get ClipControls() As Boolean
        ClipControls = UserControl.ClipControls
End Property

Public Property Let ClipControls(ByVal New_ClipControls As Boolean)
        UserControl.ClipControls() = New_ClipControls
        PropertyChanged "ClipControls"
End Property

'ADVERTENCIA: NO QUITAR NI MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS
'MappingInfo=UserControl,UserControl,-1,Cls
Public Sub Cls()
        UserControl.Cls
End Sub

'ADVERTENCIA: NO QUITAR NI MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS
'MappingInfo=UserControl,UserControl,-1,ContainerHwnd
Public Property Get ContainerHwnd() As Long
        ContainerHwnd = UserControl.ContainerHwnd
End Property

'ADVERTENCIA: NO QUITAR NI MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS
'MappingInfo=UserControl,UserControl,-1,DrawMode
Public Property Get DrawMode() As Integer
        DrawMode = UserControl.DrawMode
End Property

Public Property Let DrawMode(ByVal New_DrawMode As Integer)
        UserControl.DrawMode() = New_DrawMode
        PropertyChanged "DrawMode"
End Property

'ADVERTENCIA: NO QUITAR NI MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS
'MappingInfo=UserControl,UserControl,-1,DrawStyle
Public Property Get DrawStyle() As Integer
        DrawStyle = UserControl.DrawStyle
End Property

Public Property Let DrawStyle(ByVal New_DrawStyle As Integer)
        UserControl.DrawStyle() = New_DrawStyle
        PropertyChanged "DrawStyle"
End Property

'ADVERTENCIA: NO QUITAR NI MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS
'MappingInfo=UserControl,UserControl,-1,DrawWidth
Public Property Get DrawWidth() As Integer
        DrawWidth = UserControl.DrawWidth
End Property

Public Property Let DrawWidth(ByVal New_DrawWidth As Integer)
        UserControl.DrawWidth() = New_DrawWidth
        PropertyChanged "DrawWidth"
End Property

'ADVERTENCIA: NO QUITAR NI MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS
'MappingInfo=UserControl,UserControl,-1,HasDC
Public Property Get HasDC() As Boolean
        HasDC = UserControl.HasDC
End Property

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
        Text1.BackColor = PropBag.ReadProperty("BackColor", &H80000005)
        Text1.ForeColor = PropBag.ReadProperty("ForeColor", &H80000008)
        Text1.Enabled = PropBag.ReadProperty("Enabled", True)
        Set Text1.Font = PropBag.ReadProperty("Font", Ambient.Font)
        Text1.Appearance = PropBag.ReadProperty("Appearance", 1)
        m_BackStyle = PropBag.ReadProperty("BackStyle", m_def_BackStyle)
        Text1.BorderStyle = PropBag.ReadProperty("BorderStyle", 1)
        Text1.Alignment = PropBag.ReadProperty("Alignment", 0)
        UserControl.AutoRedraw = PropBag.ReadProperty("AutoRedraw", False)
        UserControl.ClipBehavior = PropBag.ReadProperty("ClipBehavior", 1)
        UserControl.ClipControls = PropBag.ReadProperty("ClipControls", True)
        UserControl.DrawMode = PropBag.ReadProperty("DrawMode", 13)
        UserControl.DrawStyle = PropBag.ReadProperty("DrawStyle", 0)
        UserControl.DrawWidth = PropBag.ReadProperty("DrawWidth", 1)
        Text1.Text = PropBag.ReadProperty("Text", "")
End Sub

Private Sub UserControl_Resize()
        Text1.Height = UserControl.Height
        Text1.Width = UserControl.Width
End Sub

'ADVERTENCIA: NO QUITAR NI MODIFICAR LAS SIGUIENTES LINEAS CON COMENTARIOS
'MappingInfo=Text1,Text1,-1,Text
Public Property Get Text() As String
        Text = Text1.Text
End Property

Public Property Let Text(ByVal New_Text As String)
        Text1.Text() = New_Text
        PropertyChanged "Text"
End Property

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
        Call PropBag.WriteProperty("BackColor", Text1.BackColor, &H80000005)
        Call PropBag.WriteProperty("ForeColor", Text1.ForeColor, &H80000008)
        Call PropBag.WriteProperty("Enabled", Text1.Enabled, True)
        Call PropBag.WriteProperty("Font", Text1.Font, Ambient.Font)
        Call PropBag.WriteProperty("Appearance", Text1.Appearance, 1)
        Call PropBag.WriteProperty("BackStyle", m_BackStyle, m_def_BackStyle)
        Call PropBag.WriteProperty("BorderStyle", Text1.BorderStyle, 1)
        Call PropBag.WriteProperty("Alignment", Text1.Alignment, 0)
        Call PropBag.WriteProperty("AutoRedraw", UserControl.AutoRedraw, False)
        Call PropBag.WriteProperty("ClipBehavior", UserControl.ClipBehavior, 1)
        Call PropBag.WriteProperty("ClipControls", UserControl.ClipControls, True)
        Call PropBag.WriteProperty("DrawMode", UserControl.DrawMode, 13)
        Call PropBag.WriteProperty("DrawStyle", UserControl.DrawStyle, 0)
        Call PropBag.WriteProperty("DrawWidth", UserControl.DrawWidth, 1)
        Call PropBag.WriteProperty("Text", Text1.Text, "")
End Sub

'Inicializar propiedades para control de usuario
Private Sub UserControl_InitProperties()
        m_BackStyle = m_def_BackStyle
End Sub

He aquí el link para bajarlo:

http://www.4shared.com/zip/xXFTmmFY/SoloFechaEnTextBox_IV.html


Saludos !!!


Manuel F. Borrego S.
Barcelona, Venezuela