Masque de saisie date qui affiche le masque.
Soyez le premier à donner votre avis sur cette source.
Vue 15 040 fois - Téléchargée 1 115 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 :
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.
- Date de demain - Forum PHP
- Date de c - Forum C
- Date de naissance age ✓ - Forum Visual Basic 6
- Insert date sql ✓ - Forum SQL
- Date format - Forum Visual Basic
27 juin 2004 à 09:42
Suggestions:
1°)
Il serait intéressant de permettre l'utilisation de / dans les dates.
Exemple: supposons que la date à saisir soit le 1er janvier 2004. Actuellement (sauf erreur de ma part), il faut taper 01012004. Ma proposition est qu'en tapant 1/1/2004, le code complète la zone de texte en 01/01/2004.
2°)
On pourrait imaginer pour l'année qu'à la sortie du textbox, la saisie 11/10/04 soit convertie automatiquement en 11/10/2004.
PS: commente ton code afin de permettre une meilleure compréhension du fonctionnement de celui-ci (j'ai encore du mal avec les modules de classes et je ne dois pas être le seul).
27 juin 2004 à 09:47
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 ?
27 juin 2004 à 09:50
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
27 juin 2004 à 09:53
Bonne continuation...
27 juin 2004 à 13:11
a+++
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.