Masque de saisie date qui affiche le masque.

Soyez le premier à donner votre avis sur cette source.

Vue 14 085 fois - Téléchargée 995 fois

Description

Contenu dans un module de classe pour pouvoir l'intégrer à n'importe quel projet.
Si vous trouvez des bugs...

REV 3.

Exemple d'utilisation :

Source / Exemple :


' ---- PARTIE FORMULAIRE ----'

Private m As New vgMaskEdit
Private m2 As New vgMaskEdit
Private m3 As New vgMaskEdit

Private Sub Form_Load()
    
    m.TextBoxToSubClass = Me.Text1
    m.Mask = "__.__.__.__.__"
    
    m2.TextBoxToSubClass = Me.Text2
    m2.Mask = "__/__/____"
    
    m3.TextBoxToSubClass = Me.Text3
    m3.PromptChar = " "
    m3.IsAlphaNumeric = True
    m3.Mask = "   -     "
End Sub

' ---- PARTIE MODULE DE CLASSE ----'
Option Explicit
'--------------
' -- objet Textbox passé par référence
Private WithEvents m_tbox   As TextBox
' -- tampon gardant les caractères autorisés
Private m_strBuffer         As String
' -- masque de saisie
Private m_strMasqueSaisie   As String
' -- position du curseur
Private m_intPos            As Integer
' -- tableau des caractères du masque
'0 --> position du caractère
'1 --> valeur Ascii du caractère
Private m_specialCharPos()  As Integer
' -- compteur pour incrémenter la
' création du tableau m_specialCharPos
Private m_cpt               As Integer
' -- Caractère indiquant à l'utilisateur
' -- que c'est une zone de saisie
Private m_sPromptChar       As String
' -- permet de n'avoir que des chiffres
' ou bien tout les caractères
Private m_isAlphaNumeric    As Boolean

Public Property Let TextBoxToSubClass(ByRef tbox As TextBox)
    ' -- remarque : BYREF
    Set m_tbox = tbox
End Property

Public Property Let PromptChar(ByVal sPromptChar As String)
    ' -- Propriété non obligatoire car
    ' si non déterminé, sera "_"
    m_sPromptChar = sPromptChar
End Property

Public Property Let IsAlphaNumeric(ByVal bIsAlphaNumeric As Boolean)
    ' -- avoir que des chiffres?
    m_isAlphaNumeric = bIsAlphaNumeric
End Property

Public Property Let Mask(ByVal strMask As String)
    Dim i As Integer, car As String, cpt As Integer
    
    m_strMasqueSaisie = strMask
    m_cpt = 0
    
    If m_sPromptChar = "" Then m_sPromptChar = "_"
    
    For i = 1 To Len(strMask)
        car = Mid(strMask, i, 1)
        ' -- si c'est un caractère non éditable
        ' on mémorise sa position et sa valeur Ascii
        If car <> m_sPromptChar Then
            ReDim Preserve m_specialCharPos(1, m_cpt)
            m_specialCharPos(0, m_cpt) = i
            m_specialCharPos(1, m_cpt) = Asc(car)
            m_cpt = m_cpt + 1
        End If
    Next
    
    ' -- on met le masque de saisie dans la textbox
    m_tbox = m_strMasqueSaisie
    
End Property

Private Sub m_tbox_KeyDown(KeyCode As Integer, Shift As Integer)
    ' -- Empêche l'utilisation de la touche delete
    
    If KeyCode = vbKeyDelete Then
        KeyCode = 0
    End If
    
End Sub

Private Sub m_tbox_KeyPress(KeyAscii As Integer)
    Dim i As Integer, j As Integer, bFoundSpCar As Boolean
    
    ' -- position du curseur
    m_intPos = m_tbox.SelStart
    
    If KeyAscii = 8 Then
        ' -- BackSpace
        If m_tbox.SelLength >= Len(m_strBuffer) Then
            ' -- on veut tout effacer
            m_tbox = m_strMasqueSaisie
            m_strBuffer = ""
            KeyAscii = 0
            Exit Sub
        End If
        
        If m_tbox.SelLength = 0 Then
            ' -- si pas de sélection
            For j = 0 To m_cpt - 1
                If m_intPos = m_specialCharPos(0, j) Then i = 1
            Next
            
            If Len(m_strBuffer) = 0 Then Exit Sub
            
            m_strBuffer = Mid(m_strBuffer, _
                        1, Len(m_strBuffer) - 1 - i)
            
            If m_intPos < 2 Then        ' -- on est revenu au début
                m_tbox = m_strMasqueSaisie
                m_strBuffer = ""
            Else
                m_tbox = m_strBuffer & _
                Mid(m_strMasqueSaisie, m_intPos - 1 - i)
                
                m_tbox.SelStart = m_intPos - i
            End If
        Else
            ' -- on a sélectionné du texte : Annulation frappe
            KeyAscii = 0
        End If
    Else
        ' -- autre touche que BackSpace
        If Len(m_strBuffer) = Len(m_strMasqueSaisie) Then
            ' -- on est arrivé à la taille maximale du champ
            KeyAscii = 0
            Exit Sub
        End If
        
        ' -- que des chiffres ?
        If m_isAlphaNumeric = False Then
            If (KeyAscii < 48) Or _
                (KeyAscii > 58) Then
                    ' -- annule la frappe
                    KeyAscii = 0
                    Exit Sub
            End If
        End If
        
        ' -- on ajoute le caractère au tempon
        m_strBuffer = m_strBuffer _
            + Chr(KeyAscii)
        
        ' -- annule la frappe
        KeyAscii = 0
            
        ' -- on ajout le contenu du tempon +
        ' -- le reste du masque de saisie à la textbox
        m_tbox = m_strBuffer & _
        Mid(m_strMasqueSaisie, m_intPos + 2)
        
        ' -- recherche la position d'un caractère
        ' -- non éditable (masque)
        For j = 0 To m_cpt - 1
            If m_intPos = (m_specialCharPos(0, j) - 2) Then
                bFoundSpCar = True
                Exit For
            End If
        Next
        
        ' -- si on a trouvé ce caractère
        ' -- on positionne le curseur après.
        If bFoundSpCar Then
            m_strBuffer = m_strBuffer + _
              Chr(m_specialCharPos(1, j)) '"/"
            
            m_tbox.SelStart = m_intPos + 2
        Else
            ' -- le curseur avance de 1
            m_tbox.SelStart = m_intPos + 1
        End If
    
    End If
End Sub

Private Sub m_tbox_MouseDown(Button As Integer, _
                            Shift As Integer, _
                            X As Single, Y As Single)
    
    ' -- bloque le déplacement du curseur
    m_tbox.SelStart = m_intPos
End Sub

Conclusion :


Il resterait à permettre de spécifier si c'est un chiffre ou une lettre par rapport à la position du mask... un peu plus coton !!

À voir pour + Tard. @+

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cs_dox
Messages postés
8
Date d'inscription
jeudi 17 août 2000
Statut
Membre
Dernière intervention
21 janvier 2008
-
C'est un bon exercice autour de l'intégration d'un composant au niveau d'une classe; ceci étant il existe un composant Microsoft qui s'appelle MaskEdBox qui^permet de faire la même chose et de plus la modification est possible. Pour pouvoir l'utiliser il faut charger le composant Microsoft Masked Edit Control 6.0 (SP3).

Je met une note de 8 pour l'aspect pédagogique de ton exemple
cs_chouchou123
Messages postés
33
Date d'inscription
mercredi 18 décembre 2002
Statut
Membre
Dernière intervention
6 avril 2006
-
Moi je dit Bravo, fallait y penser et je trouve ca tres utile et à la fois simple à utiliser je met 10/10
a+++
cs_PROGRAMMIX
Messages postés
1134
Date d'inscription
mercredi 2 octobre 2002
Statut
Membre
Dernière intervention
24 juillet 2011
-
C'est ce qu'on appelle du service rapide...

Bonne continuation...
VicoLaChips2
Messages postés
439
Date d'inscription
dimanche 20 janvier 2002
Statut
Membre
Dernière intervention
2 février 2010
1 -
J'ai suivi tes conseils et j'ai commenté le code -;)

En ce moment je travail surtout à la possibilité d'éffacer un caractère à n'importe quel endroit du masque en gardant le masque en place et en permettant l'ajout du caractère de remplacement...

Les bugs de la version d'avant :
- si on laisse appuyer la touche (zéro par exemple), la variable m_intPos n'est pas incrémenté car il n'y apas d'évènement KEYUP !!

- D'autres bug lié à l'effacement d'un ou plusieurs caractères que j'ai bloqué dans cette version... (cf KeyDown et vbKeyDelete)

- D'autres à venir !! yen a toujours de ces chtites bêtes.

@+, VIC
cs_PROGRAMMIX
Messages postés
1134
Date d'inscription
mercredi 2 octobre 2002
Statut
Membre
Dernière intervention
24 juillet 2011
-
Je crois que j'ai posté trop vite...
Il y a des commentaires mais il est dommage que ceux que tu as mis ci-dessus ne soient pas repris dans la source.

Pour l'utilisation de /, je crois voir que tu as prévu ce cas, mais chez moi, ça ne marche pas... Serait-là un des bugs que tu signalais ?

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.