Ampliar las posibilidades de los TextBox (VB6)

[Usando sólo un par de clases]

Fecha: 11/Ene/2006 (10 de Enero de 2006)
Autor: Manuel Serrano & Ernesto Loaiza - msrojas@terra.es lupa685@msn.com

Hace algún tiempo se nos ocurrió la posibilidad de ampliar las posibilidades de los textbox que usamos en Visual Basic 6 (sí, sí, algunos todavía lo usamos). Por ejemplo que fueran capaces de filtrar directamente los caracteres de entrada, permitiendo únicamente dígitos o convirtiendo directamente las letras a mayúsculas. También queríamos que se resaltara el textbox activo modificando el color del fondo y del texto. Todo esto debía hacerse de la forma más sencilla posible sin que tuviéramos que modificar o ampliar nuestro código existente.

Fue entonces cuando creamos un objeto llamado "MiTextBox" el cual almacenaría en una de sus propiedades un control TextBox existente en el formulario. Desde MiTextBox capturamos los eventos del textbox original y gracias a las propiedades y métodos que incluimos podemos realizar las acciones que comentamos anteriormente. Para llevar un control de todos los objetos "MiTextBox" existentes creamos una clase llamada "MisTextBoxes" que almacena en una colección todos los objetos "MiTextBox" del formulario.

Basta con crear un objeto MisTextBoxes en cada formulario, llamar al método IniciarTextBox y dar valores a las propiedades que queramos (esto se puede hacer en el evento Load, mejor ver formulario de pruebas).

Como veréis se pueden hacer ampliaciones como facilitar la entrada de fechas y horas validándolas.

El único problema que hemos encontrado es que no funciona con las matrices de controles de textbox. Esto es porque la interfaz de los métodos no coinciden al añadir el parámetro Index que identifica cada miembro de la matriz. A este problema no hemos encontrado solución, si a alguien se le ocurre que por favor nos lo cuente...

A continuación tenéis todo el código :

Código de la clase MiTextBox.cls

'Objeto MiTextBox
'Clase para controlar/ampliar los TextBox de una aplicación.
'(c)Manuel Serrano & Ernesto Loaiza. Octubre 2005

Option Explicit

Dim mBkColorAnt As Long 'Color del fondo antes de tomar el enfoque, para
                        'poder restablecer el mismo color al perderlo.

Dim mFrColorAnt As Long

Public WithEvents TextBox As TextBox 'Cada MiTextBox tiene un objeto TextBox
Public Enum txDatosEntrada
   txTodo = 0
   txSóloNúmeros = 1
   txSóloLetras = 2
   txNúmerosLetras = 3
   txNúmerosComa = 4
   txNúmerosGuión = 5
   txNúmerosBarras = 6
   txNúmerosGuiónComa = 7
End Enum

'Nuevas Propiedades del TextBox
'-------------------------------
Public Mayúsculas As Boolean  'Convertir a mayúsculas lo que se escribe
Public Resalte As Boolean     'Resaltar el fondo cuando tenga el foco
Public FlechasTab As Boolean     'Usar las Flechas del cursor como Tabulador
Public EnterTab As Boolean    'Usar Enter como Tabulador
Public Entrada As txDatosEntrada 'Filtra las pulsaciones según el dato a entrar
Public ColorFondoResalte As Long 'Color del fondo para el resalte
Public ColorLetraResalte As Long 'Color de letra para el resalte
Public Seleccionar As Boolean     'Seleccionar el contenido al recibir el foco.

'Inicialización de la clase

Private Sub Class_Initialize()
   Mayúsculas = False
   Resalte = False
   FlechasTab = False
   Entrada = txTodo
   ColorFondoResalte = vbInfoBackground
   ColorLetraResalte = vbInfoText
   Seleccionar = False
End Sub

'Eventos del textbox
'Atención: Todos los eventos se ejecutan primero en el formulario y luego
'en la clase.

Private Sub TextBox_gotfocus()
   mBkColorAnt = TextBox.BackColor
   mFrColorAnt = TextBox.ForeColor
   If Resalte Then
      TextBox.BackColor = ColorFondoResalte
      TextBox.ForeColor = ColorLetraResalte
   End If
   If Seleccionar Then
      TextBox.SelStart = 0
      TextBox.SelLength = Len(TextBox.Text)
   End If
End Sub

Private Sub TextBox_lostfocus()
   If Resalte Then
      TextBox.BackColor = vbWhite
      TextBox.ForeColor = mFrColorAnt
      TextBox.BackColor = mBkColorAnt
   End If
End Sub

Private Sub TextBox_KeyPress(KeyAscii As Integer)
   If Mayúsculas Then
      KeyAscii = Asc(UCase(Chr(KeyAscii)))
   End If
   Select Case Entrada
      Case txTodo
         'No hacemos nada, se permiten todos los caracteres
      Case txSóloNúmeros
         If (Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9") And _
             Chr(KeyAscii) <> vbBack Then
         
             KeyAscii = 0
         End If
      
      Case txSóloLetras
         If (UCase(Chr(KeyAscii)) < "A" Or UCase(Chr(KeyAscii)) > "Z") And _
             Chr(KeyAscii) <> vbBack Then
         
             KeyAscii = 0
         End If
      
      Case txNúmerosLetras
         If (UCase(Chr(KeyAscii)) < "A" Or UCase(Chr(KeyAscii)) > "Z") And _
            (Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9") And _
             Chr(KeyAscii) <> vbBack Then
         
             KeyAscii = 0
         End If
      
      Case txNúmerosComa
         If (Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9") And _
             Chr(KeyAscii) <> vbBack And _
             Chr(KeyAscii) <> "," And _
             Chr(KeyAscii) <> "." Then
         
             KeyAscii = 0
         Else
             If Chr(KeyAscii) = "." Then KeyAscii = Asc(",")
             If Chr(KeyAscii) = "," And InStr(1, TextBox.Text, ",") > 0 Then KeyAscii = 0
         End If
      
      Case txNúmerosGuión
         If (Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9") And _
             Chr(KeyAscii) <> vbBack And _
             Chr(KeyAscii) <> "-" Then
         
             KeyAscii = 0
         Else
             If Chr(KeyAscii) = "-" And InStr(1, TextBox.Text, "-") > 0 Then KeyAscii = 0
         End If
         
      Case txNúmerosBarras
         If (Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9") And _
             Chr(KeyAscii) <> vbBack And _
             Chr(KeyAscii) <> "/" Then
         
             KeyAscii = 0
        End If
        
      Case txNúmerosGuiónComa
         If (Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9") And _
             Chr(KeyAscii) <> vbBack And _
             Chr(KeyAscii) <> "-" And _
             Chr(KeyAscii) <> "," And _
             Chr(KeyAscii) <> "." Then
         
             KeyAscii = 0
         Else
             If Chr(KeyAscii) = "." Then KeyAscii = Asc(",")
             If Chr(KeyAscii) = "-" And InStr(1, TextBox.Text, "-") > 0 Then KeyAscii = 0
             If Chr(KeyAscii) = "," And InStr(1, TextBox.Text, ",") > 0 Then KeyAscii = 0
         End If
      
   End Select
End Sub

Private Sub TextBox_KeyDown(KeyCode As Integer, Shift As Integer)
   If FlechasTab Then
      Select Case KeyCode
         Case vbKeyDown
             SendKeys "{TAB}"
             
         Case vbKeyUp
             SendKeys "+{TAB}"
         
         Case vbKeyReturn
            If EnterTab Then
               KeyCode = 0
               SendKeys "{TAB}"
            End If
      End Select
   End If
End Sub

Código de la clase MisTextBoxes.cls

'MisTextBoxes
'Almacena una colección de objetos MiTextBox
'Clase para controlar/ampliar los TextBox de una aplicación.
'(c)Manuel Serrano & Ernesto Loaiza. Octubre 2005

Option Explicit

Private Col_TextBoxes As Collection

Private Sub Class_Initialize()

   Set Col_TextBoxes = New Collection
   
End Sub

Private Sub Class_Terminate()
   
   Set Col_TextBoxes = Nothing

End Sub

'Llamar a este procedimiento para inicializar la clase, pasar como parámetro el formulario
Public Sub IniciarTextBox(Formulario As Form)
   Dim mMiTextBox As MiTextBox
   Dim xControl As Control

   For Each xControl In Formulario.Controls
   
      If TypeOf xControl Is TextBox Then
         Set mMiTextBox = New MiTextBox
         Set mMiTextBox.TextBox = xControl
         Col_TextBoxes.Add mMiTextBox, xControl.Name
      End If
      
   Next

End Sub

'Activa o Desactiva el resalte en todos los TextBox
Public Sub ResaltarTextBox(Optional Valor As Boolean = True)
   Dim mMiTextBox As Variant
   
   For Each mMiTextBox In Col_TextBoxes
     mMiTextBox.Resalte = Valor
   Next

End Sub

'Aparece en mayúsculas las pulsaciones del textbox que se pase como parámetro.
Property Let MayúsculasTextBox(CualTextBox As TextBox, Valor As Boolean)
   
   Col_TextBoxes(CualTextBox.Name).Mayúsculas = Valor
   
End Property

'Todos los textBox en mayúsculas
Public Sub TodosMayúsculas(Optional Valor As Boolean = True)
   Dim mMiTextBox As Variant
   
   For Each mMiTextBox In Col_TextBoxes
      mMiTextBox.Mayúsculas = Valor
   Next

End Sub

'Permite la navegación usando flechas
Public Sub FlechasTextBox(Optional Valor As Boolean = True)
   Dim mMiTextBox As Variant
   
   For Each mMiTextBox In Col_TextBoxes
     mMiTextBox.FlechasTab = Valor
   Next

End Sub

'Permite la navegación usando Enter
Public Sub EnterTextBox(Optional Valor As Boolean = True)
   Dim mMiTextBox As Variant
   
   For Each mMiTextBox In Col_TextBoxes
      mMiTextBox.EnterTab = Valor
   Next

End Sub

'Filtra la entrada de un textbox permitiendo sólo algunos caracteres
Public Property Let Entrada(CualTextBox As TextBox, Valor As txDatosEntrada)
   
   Col_TextBoxes(CualTextBox.Name).Entrada = Valor

End Property

'Especifica el color de fondo para resaltar en todos los textbox
Public Property Let ColorFondoResalte(Valor As ColorConstants)
   Dim mMiTextBox As Variant
   
   For Each mMiTextBox In Col_TextBoxes
      mMiTextBox.ColorFondoResalte = Valor
   Next

End Property

'Especifica el color de letra para resaltar en todos los textbox
Public Property Let ColorLetraResalte(Valor As ColorConstants)
   Dim mMiTextBox As Variant
   
   For Each mMiTextBox In Col_TextBoxes
      mMiTextBox.ColorLetraResalte = Valor
   Next

End Property

'Permite que se seleccione el contenido de un textbox al tomar el focus
Public Property Let Seleccionar(CualTextBox As TextBox, Valor As Boolean)
   
   Col_TextBoxes(CualTextBox.Name).Seleccionar = Valor

End Property

Y ahora el formulario de pruebas ...

'Formulario de Demostración de las Clases MisTextBoxes y MiTextBox
'Manuel Serrano. Enero 2006

Dim mTextBoxes As MisTextBoxes


Private Sub Form_Load()
   Set mTextBoxes = New MisTextBoxes
   
   With mTextBoxes
      .IniciarTextBox Me 'Iniciamos los textbox
      
      .ColorFondoResalte = vbYellow 'Color de Fondo de resalte
      .ColorLetraResalte = vbBlue 'Color de Letra de resalte
      .ResaltarTextBox True 'Activamos el resalte
      
      .EnterTextBox True 'Permite cambiar de textbox con Enter
      .FlechasTextBox True 'Permite el uso de las flechas
   
      .Entrada(Text1) = txSóloNúmeros 'Sólo deja entrar números
      .Seleccionar(Text1) = True 'Se selecciona el contenido al tomar el focus
      
      .Entrada(Text2) = txSóloLetras 'Sólo permite letras
      .Entrada(Text3) = txSóloLetras 'Sólo permite letras ...
      .MayúsculasTextBox(Text3) = True '... y en mayúsculas
      .Entrada(Text4) = txNúmerosComa
      
   End With

End Sub

Private Sub Form_Unload(Cancel As Integer)
   Set mTextBoxes = Nothing
End Sub

Private Sub Command1_Click()
   Unload Me
End Sub

Esperamos que os guste y lo disfrutéis.

Fichero con el código de ejemplo: msr_lupa689_AmpliarTextBox.zip - 5 KB

(MD5 checksum: [3F2FB862498D71B55B32115E94F80CE4])