Masque de saisie date qui affiche le masque.
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 :
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. @+
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
- Masque de saisie date qui affiche le masque.
- Calcul date a date - Forum Javascript / DHTML
- Date de demain - Forum PHP
- Comparaison date sql - Forum SQL
- Date de c - Forum C
- Sql insert date ✓ - Forum SQL
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.