0/5 (4 avis)
Vue 5 782 fois - Téléchargée 562 fois
Option Explicit 'Valeur par défaut Const cStandardValeur = 0 Const cStandardMin = 0 Const cStandardMax = 100 ' Constantes d'erreur Const CPasUnNombre = 1 Const cHorsLimites = 2 'variables des propriétés Private mdblValeur As Double Private mdblMin As Double Private mdblMax As Double ' Evénements Public Event ErreurValeur(fvaleur As Integer) Public Event ErreurChiffre(kascii As Integer) Private Sub txtnombre_GotFocus() txtnombre.SelStart = Len(txtnombre.Text) + 1 End Sub 'positionne les nouveau controles à leur valeur par défaut. Private Sub UserControl_InitProperties() mdblValeur = cStandardValeur mdblMin = cStandardMin mdblMax = cStandardMax End Sub Private Sub UserControl_ReadProperties(PropBag As PropertyBag) 'lit les valeurs des propriétés mdblMin = PropBag.ReadProperty("Minimum", cStandardMin) mdblMax = PropBag.ReadProperty("Maximum", cStandardMax) mdblValeur = PropBag.ReadProperty("Valeur", cStandardValeur) End Sub Private Sub UserControl_Show() 'afficher la valeur continue ds la prop Valeur pour k'elle n'est pas nulle. If mdblValeur = 0 Then txtnombre.Text = "" Else txtnombre.Text = mdblValeur End If End Sub Private Sub UserControl_WriteProperties(PropBag As PropertyBag) 'enregistrer les valeurs des propriétés PropBag.WriteProperty "Minimum", mdblMin, cStandardMin PropBag.WriteProperty "Maximum", mdblMax, cStandardMax PropBag.WriteProperty "Valeur", mdblValeur, cStandardValeur End Sub Private Sub UserControl_Resize() 'ne pas aller au-dessous des dimensions minimales If Height < 420 Or Width < 510 Then Height = 420 Width = 510 End If 'bordure autour de la zone de texte txtnombre.Move 30, 30, Width - 60, Height - 60 End Sub 'Le controle "change" controle si une valeur est vide Private Sub txtnombre_Change() Dim strValeur As String 'si elle contient - ou rien, la propriété de mdblValeur = 0 If txtnombre.Text = "-" Or txtnombre.Text = "" Then mdblValeur = 0 Exit Sub End If strValeur = VirguleParPoint(txtnombre.Text) If Not IsNumeric(strValeur) Then RaiseEvent ErreurValeur(CPasUnNombre) txtnombre.Text = mdblValeur ElseIf Val(strValeur) < mdblMin Then RaiseEvent ErreurValeur(cHorsLimites) txtnombre.Text = mdblMin ElseIf Val(strValeur) > mdblMax Then RaiseEvent ErreurValeur(cHorsLimites) txtnombre.Text = mdblMax Else mdblValeur = Val(strValeur) End If End Sub 'autorise la touche Suppr pour effacer un nbre saisi. Private Sub txtnombre_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyDelete Then KeyCode = 0 End If End Sub 'les var blnVirgule & blnMoins (boolean (vrai ou faux)) vérifient si le nombre saisi 'ne contient qu'une virgule et un signe moins en 1ere position. Private Sub txtnombre_KeyPress(KeyAscii As Integer) Static blnVirgule As Boolean Static blnMoins As Boolean Select Case KeyAscii Case vbKey0 To vbKey9 Case vbKeyRight, vbKeyLeft, vbKeyReturn Case Asc("-") If blnMoins Or txtnombre.SelStart <> 0 Then RaiseEvent ErreurChiffre(KeyAscii) KeyAscii = 0 Else blnMoins = True End If Case Asc(",") If blnVirgule Then RaiseEvent ErreurChiffre(KeyAscii) KeyAscii = 0 Else blnVirgule = True End If Case vbKeyBack If Right$(txtnombre.Text, 1) = "," Then blnVirgule = False ElseIf Right$(txtnombre.Text, 1) = "-" Then blnMoins = False End If Case Else RaiseEvent ErreurChiffre(KeyAscii) KeyAscii = 0 End Select End Sub 'L'échange de ces caractères est réalisé par la procédure VirguleParPoint, 'grace a la fonction replace Private Function VirguleParPoint(strX As String) As String VirguleParPoint = Replace(strX, ",", ".") End Function Public Property Get Valeur() As Double Valeur = mdblValeur End Property Public Property Let Valeur(ByVal dblNouvelleValeur As Double) If dblNouvelleValeur < mdblMin Then mdblValeur = mdblMin ElseIf dblNouvelleValeur > mdblMax Then mdblValeur = mdblMax Else mdblValeur = dblNouvelleValeur End If txtnombre.Text = mdblValeur PropertyChanged "valeur" End Property Public Property Get minimum() As Double minimum = mdblMin End Property Public Property Let minimum(ByVal dblnouveauMin As Double) If dblnouveauMin > mdblMax Then MsgBox "Minimum supérieur au maximum!" Else mdblMin = dblnouveauMin PropertyChanged "Minimum" End If End Property Public Property Get maximum() As Double maximum = mdblMax End Property Public Property Let maximum(ByVal dblnouveauMax As Double) If dblnouveauMax < mdblMin Then MsgBox "Maximum inférieur au minimum!" Else mdblMax = dblnouveauMax PropertyChanged "Maximum" End If End Property
6 août 2002 à 06:24
5 août 2002 à 21:11
5 août 2002 à 21:06
5 août 2002 à 21:03
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.