Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: ADONAIRAFA en Enero 28, 2012, 09:32:25 pm
-
Saludos a todos !!! ;D
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 ;D), 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' :P ) 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)
-
No lo probe, pero creo que este codigo
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
-
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 !!! ;D
-
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.
-
Interesante vamos a probar, gracias por compartir man.
Saludos!!!
-
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
-
Saludos Ellesar !!! ;D
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 :o, 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) :P, 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 !!! ;D
Manuel F. Borrego S. 8)
Barcelona, Venezuela.
-
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
If lng = 1 Then
If KeyAscii <= 48 Or KeyAscii > 49 Then
KeyAscii = 0
Exit Sub
End If
-
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. 8)
Barcelona, Venezuela.
-
Es que esta no es mi PC :P, 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
-
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
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
-
Claro me olvidé de ese caso! -.-"
Entonces tendrías que agregar algo así.
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
-
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 !!!
-
Yo agregué la corrección que me dijiste.
éste es el código que tengo
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.
(http://img9.imageshack.us/img9/6914/txtbox.jpg) (http://imageshack.us/photo/my-images/9/txtbox.jpg/)
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 :)
-
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 !!! :o) 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:
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
(http://www.4shared.com/zip/xXFTmmFY/SoloFechaEnTextBox_IV.html)
Saludos !!!
Manuel F. Borrego S. 8)
Barcelona, Venezuela
-
Pero eso no es un error!!! yo nací el día 00 del mes de setiembre!!! por eso me dicen doblegg!!! jaja
No doc, ta bien, no me había percatado de eso, lo voy a bajar de nuevo, ¿Que fue del backspace? que borra todo y no solo el carácter anterior, sino esta voy a practicar como resolverlo.
Un abrazo.
-
Bueno Yvan !!! viejo te agradezco si puedes, me eches una mano con lo del 'BackSpace', que eso no he podido resolverlo aún, porque cada vez que pruebo algo, tengo que "reacomodar" el bendito código, y entonces los errores que no tenía, vuelven a aparecer !!!
Por lo tanto decidí dejarlo así, corrigiendo lo del "00/" por lo menos hasta que "se me enfríe un poco el cerebro" ::)
Saludos y un abrazo hermano !!!
PD: Ta' bueno lo del día de tu nacimiento: el "00/.." Je, Je, je !!!
-
Actualiza tambien el codigo del primer post, para que la gente que venga de google y eso no tenga el mismo error n.n
-
Tienes toda la razón !!! gracias por el recordatorio man !!! :o
-
Por el tema de borrar no podia ir algo cutre dentro de las teclas que precionamos? Algo como esto.
If asciikey = 8 then
Text1.text = left(text1.text, len(text1.text) - 1)
End if
Perdon que sea algo cutre pero estoy del celular con una antena que no es 3G y tarda muchisimo en cargar.
Saludos
PD: creo que el valor de backspace en ascii era 8 verificadlo por las dudas
-
Bueno con lo del 'BackSpace' le había dado muchas vueltas y no le he atinado aún. Será cuestión de que me ponga a probar la solución que propones.
Y sí, el valor ASCII de 'BackSpace' es 8.
Despues te digo como resulta la vaina esta !!!
Saludos !!!