begin process at 2012 02 13 19:02:32
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

Divers

 > POINT ET VIRGULE EN VB6

POINT ET VIRGULE EN VB6


 Description

Cliquez pour voir la capture en taille normale
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

  • 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
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.

 Fichier Zip

Les Membres Club peuvent télécharger directement un fichier contenu dans le zip sans télécharger le zip en entier !

Télécharger le zip


 Sources de la même categorie

Source avec Zip TEXTBOX EN NUMÉRIQUE par 320C
Source avec Zip DÉCIMAL TO HEXDECIMAL par loulou27200
SOUS-TITRES : INCRÉMENTATION DE TOUTES LES CHAÎNES DE CARACT... par ALMIRA
Source avec Zip Source avec une capture EVALUER UN NOMBRE D'OBJETS AVEC UNE BALANCE ET DEUX ÉCHANTIL... par lexsty
Source avec Zip Source avec une capture PETIT LOGICIEL DE DEVIS SANS BD par lololilizozo

 Sources en rapport avec celle ci

RETROUVER UN POINT À PARTIR D'UN AUTRE POINT ET D'UNE DISTAN... par michael59330
Source avec Zip Source avec une capture INFO POINT DE COURBE DE GRAPHIQUE EXCEL, QUI FONCTIONNE COMM... par bigfish_le vrai
UN CDBL QUI GERE LES OPTIONS REGIONAL CONCERANT LE SEPARATEU... par Nic0s
Source avec Zip Source avec une capture EQUATION TRACER par dabala
Source avec Zip VIRGULES <=> POINTS, REMPLACE DANS FICHIER PAR DLL par BruNews

Commentaires et avis

Commentaire de Renfield le 19/11/2008 15:24:50 administrateur CS

code pour le moins étrange, qui s'interesse néanmoins a un probleme qui me tient a coeur.

Do While SymboleTouche = "."
  LigneRecuperee = Replace(LigneRecuperee, ",", ".")
  SymboleDecimal = LigneRecuperee
  Exit Do
Loop

pourquoi ne pas utiliser un simple 'If' ?


Commentaire de Renfield le 19/11/2008 15:29:01 administrateur CS

d'autre part, il est faux de faire un Replace(",", ".")
c'est bien trop radical, et ne tiens pas compte du séparateur des milliers.

63,450.2 est un nombre tout ce qu'il y a de plus convenable, en format US.

ton Replace provoquerait : 63.450.2 ce qui ne signifie plus rien...

ton code manque de tests utilisant IsNumeric
(Cette fonction se fie aux regional settings)

Commentaire de MPi le 20/11/2008 11:16:04

Ça m'intéresse aussi ce genre de code puisque j'y suis confronté régulièrement...

Cette partie devrait être revue
#  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

1- tu fermes les fichiers avant de les ouvrir, mais tu ne les fermes pas par la suite...
2- #1 pourrait être le seul utilisé dans ce cas-ci.
3- pense à utiliser FreeFile.

 Ajouter un commentaire


Discussions en rapport avec ce code source dans le forum

Recup texte par Input et pb avec la virgule [ par fens ] Bonjour,Lorsque je récupére une ligne dans un fichiers texte et qu'il y a une virgule dedans, je ne récupére pas toute ma ligne.Mais que se passe t'il pb saisie de texte dans textbox [ par footyak ] bonjour, j'ai un pb: lorsque je saisis la valeur numérique d'un résultat et qu'il ya une virgule , le prog ne prend que la première valeur avant la vi Comment augmenter le nombre de chiffres après la virgule? [ par Olisoft ] Je cherche comment je peux augmenter le nombre de chiffres après la virgule dans un "label" ou un "text" après un calcul. J'arrive seulement à avoir Calcul de chiffres à virgule [ par WareG ] Je doit calculer des sommes à virgule, mais le probleme est le suivant, lorsque je fais la somme par le code suivant j'ai un nombre à virgule beaucoup calcul a virgule [ par WareG ] J'ai bien reç votre code pour le calcul de chiffre à virguleDim Var1, Var2 As SingleVar1 = Text1.TextVar2 = Text2.TextText2.Text = (Int((Var1 + Var2) formattage d'un single [ par stef ] Je cherche a formatter en String une variable de type Single, avec les contraintes suivantes : - 2 chiffres significatifs maxi après la virgule.- si p decimale et sauvegarde [ par blindman ] salutpeut tu m'aiderje voudrais conserveru une valeur du style 14.568 dans un fichier texte ou la base de registre pour que mon appli la lise lors de Additionner des textbox avec virgule ? pour presseb [ par néo ] Pour additionner des textbox on applique la formule suivante.TextBox3.Text = CInt(TextBox1.Text) + CInt(TextBox2.Text)cependant comment faire pour les Caractère ! [ par Ed ] Dans mon application, j'ai besoin de saisir une virgule dans un nombre écrit dans un textbox, le problème c'est que le point ne fonctionne pas dans mo calculatrice [ par petit prince ] j'ai un problème avec la virgule et le zéro.je n'arrive pas à mettre de 0 après la virgule


Nos sponsors


Sondage...

Comparez les prix

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 2,527 sec (3)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales