Point et virgule en vb6

Description

Cette démo explicite une routine permettant d'afficher des valeurs numériques quel que soit leur symbole décimal et elle explique comment une saisie peut être testée et convertie dans la configuration des paramètres régionaux et linguistiques de l'utilisateur.

Source / Exemple :


Option Explicit
Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Dim Chemin As String
Dim SymboleTouche As String, SymboleConfigureEnClair As String
'
Private Sub Form_Load()
 Dim Retour As String * 2
 Dim Rep As Long
 On Error GoTo Erreur
 Label1.Caption = "Problématique : Trois fichiers séquentiels en mode texte sont présents dans le répertoire courant. FichierP.txt contient une série de 10 nombres décimaux avec un point comme symbole décimal. FichierV.txt contient les 10 mêmes nombres avec une virgule comme symbole décimal. FichierMixte.txt comporte des valeurs comportant indifféremment point ou virgule. Trois ListBox doivent afficher correctement chacun des contenus. Une tentative de saisie mixte complète le test."
 Chemin = App.Path
 If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
 Rep = GetLocaleInfo(&H400, &HE, Retour, Len(Retour))    ' Symbole décimal system
 SymboleTouche = Left(Retour, Rep - 1)
 If SymboleTouche = "." Then
  SymboleConfigureEnClair = "le Point"
  ElseIf SymboleTouche = "," Then
  SymboleConfigureEnClair = "la Virgule"
 End If
 Exit Sub
Erreur:
 MsgBox "Erreur N° " & Err & " - " & Err.Description, vbCritical + vbOKOnly, "Erreur à l'ouverture"
End Sub
'
Private Sub Command1_GotFocus()
 ' Balayette sur les listes
 List1.Clear: List2.Clear: List3.Clear
End Sub
'
Private Sub Command1_Click()
 ' Ouvrir Fichiers
 Dim Ligne As String
 Dim Marge As String
 On Error GoTo Erreur
 Close #1
 Open Chemin & "FichierP.txt" For Input As #1
 Close #2
 Open Chemin & "FichierV.txt" For Input As #2
 Close #3
 Open Chemin & "FichierMixte.txt" For Input As #3
 
 Do Until EOF(1)
  Line Input #1, Ligne
  Ligne = SymboleDecimal(Ligne)
  Select Case Int(Val(Ligne))
    Case Is < 10: Marge = Space(6)
    Case Is < 100: Marge = Space(6)
    Case Is < 1000: Marge = Space(4)
    Case Is < 10000: Marge = Space(2)
  End Select
  List1.AddItem Marge & Format(Val(Ligne), "00.00")
 Loop
  
 Do Until EOF(2)
  Line Input #2, Ligne
  Ligne = SymboleDecimal(Ligne)
  Select Case Int(Val(Ligne))
   Case Is < 10: Marge = Space(6)
   Case Is < 100: Marge = Space(6)
   Case Is < 1000: Marge = Space(4)
   Case Is < 10000: Marge = Space(2)
  End Select
   List2.AddItem Marge & Format(Val(Ligne), "00.00")
 Loop
 
 Do Until EOF(3)
  Line Input #3, Ligne
  Ligne = SymboleDecimal(Ligne)
  Select Case Int(Val(Ligne))
   Case Is < 10: Marge = Space(6)
   Case Is < 100: Marge = Space(6)
   Case Is < 1000: Marge = Space(4)
   Case Is < 10000: Marge = Space(2)
  End Select
   List3.AddItem Marge & Format(Val(Ligne), "00.00")
 Loop
 Close
 Command2.SetFocus
 Exit Sub
Erreur:
  If Err = 53 Then
   MsgBox "Fichier introuvable. - Trois fichiers doivent se trouver dans l'espace de travail : " & vbCrLf _
   & "FichierP.txt , FichierV.txt, FichierMixe.txt"
   Exit Sub
  End If
  MsgBox Err & "   " & Err.Description
End Sub
'
Private Sub LireBits()
 ' Lire les symboles linguistiques et paramètres régionaux.
 Dim FormatDate As String
 Dim SeparateurHoraire As String
 Dim SeparateurEnClair As String
 Dim FormatDateLongue As String
 Dim Pays As String, Langue As String, Monnaie As String, Devise As String
 Dim Tampon As String * 30    ' Place 30 codes ASCII 0
 Dim Rep As Long
 
 Rep = GetLocaleInfo(&H400, &H8, Tampon, Len(Tampon))
 Pays = Left(Tampon, Rep - 1)
 
 Rep = GetLocaleInfo(&H400, &H4, Tampon, Len(Tampon)) ' Langue
 Langue = Left(Tampon, Rep - 1)
 
 Rep = GetLocaleInfo(&H400, &H14, Tampon, Len(Tampon)) ' Monnaie
 Monnaie = Left(Tampon, Rep - 1)
 
 Rep = GetLocaleInfo(&H400, &H15, Tampon, Len(Tampon))  ' Devise
 Devise = Left(Tampon, Rep - 1)
 
 Rep = GetLocaleInfo(&H400, &H1F, Tampon, Len(Tampon))  ' Format Date
 FormatDate = Left(Tampon, Rep - 1)
 
 Rep = GetLocaleInfo(&H400, &H1E, Tampon, Len(Tampon))     ' SeparateurHoraire
 SeparateurHoraire = Left(Tampon, Rep - 1)
 
 If SeparateurHoraire = ":" Then
  SeparateurEnClair = "Deux points :"
  ElseIf SeparateurHoraire = "/" Then
   SeparateurEnClair = "Barre /"
 End If
  
 Rep = GetLocaleInfo(&H400, &H20, Tampon, Len(Tampon))     ' Date Longue
 FormatDateLongue = Left(Tampon, Rep - 1)
 
 Label5.Caption = "Vous vivez en  " & Pays & " et vous parlez le " & Langue & "."
 Label6.Caption = "Votre Symbole décimal est : " & SymboleConfigureEnClair
 Label9.Caption = "Votre Symbole monétaire est : " & Monnaie & "   " & Devise
 Label10.Caption = "Expression du Format de la Date : " & FormatDate & vbCrLf & " Séparateur Horaire   " & SeparateurEnClair _
 & vbCrLf & vbCrLf & " Nous sommes le : " & Format(Date, FormatDateLongue) _
 & vbCrLf & Date & " - Il est " & Time
 
End Sub
'
Private Sub Command2_Click()
 ' Lire les paramètres régionaux et luiguistiques
 LireBits
 Text1.Text = Empty
 Text1.SetFocus
End Sub
'
Private Sub Command3_Click()
 ' Quitter
 Dim Reponse As Long
 Reponse = MsgBox("Voulez-vous vaiment quitter ce Programme ?", vbQuestion + vbYesNo, "Quitter le Programme ?")
 If Reponse = vbYes Then
  Unload Me
  End
  Else
  Command1.SetFocus
  Exit Sub
 End If
End Sub
'
Private Function SymboleDecimal(LigneRecuperee As String)
 ' Conversion
 Do While SymboleTouche = "."
  LigneRecuperee = Replace(LigneRecuperee, ",", ".")
  SymboleDecimal = LigneRecuperee
  Exit Do
 Loop
 Do While SymboleTouche = ","
  LigneRecuperee = Replace(LigneRecuperee, ".", ",")
  SymboleDecimal = LigneRecuperee
  Exit Do
 Loop
End Function
'
Private Sub Text1_KeyPress(KeyAscii As Integer)
 Const Tipe As String = "Double précision."
 If KeyAscii = 13 Then
  If Text1.Text = Empty Then
    MsgBox "Aucune saisie - Revoir", vbOKOnly + vbCritical, " Chaîne vide."
    Text1.SetFocus: Exit Sub
  ElseIf IsNumeric(SymboleDecimal(Text1.Text)) = False Then
   MsgBox "La saisie comporte des caractères non numériques ou parasitaires : " & Text1.Text & vbCrLf & "Revoir", vbOKOnly + vbCritical, " Valeur non numérique détectée."
   Text1.SetFocus
   Text1.SelStart = vbKeyEnd
   Exit Sub
  End If
  Label2 = " Vous avez indiqué une valeur numérique : " & Format(SymboleDecimal(Text1.Text), "0.00") & "  de Type : " & Tipe & "."
  Command3.SetFocus
 End If
End Sub

Conclusion :


Plus de plantages dus aux paramètres régionaux et linguistiques.

Codes Sources

A voir également

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.