Activex ( ocx ) zone de saisie numérique + test de l'ocx

Télécharger le projet
Commenter

Description

C'est mon 1er ocx, en gros Cet ActiveX est basé sur une zone de saisie qui ne doit
accepter que des chiffres et qui doit comporter des propriété définissant les limites supérieur et inférieure autorisées pour la valeur à saisir.

Il interdit la virgule et le point.

Comment please!!!

Source / Exemple : 


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

Conclusion :


Vous pouver telecharger le zip dans lequel y a les sources de l'ocx, et un test pour celui ci + l'activeX compilé.

sinon v'la mon site web http://www.steven007.fr.st

(pour max12, je répond bientot a ton message concernant le jeux de carte...)
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (cs_steven007)