Accueil > > > POINT ET VIRGULE EN VB6
POINT ET VIRGULE EN VB6
Information sur la source
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
- 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.
Sources de la même categorie
Commentaires et avis
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
|
Derniers Blogs
TECHDAYS PARIS 2010 : LA BI DANS SHAREPOINT 2010TECHDAYS PARIS 2010 : LA BI DANS SHAREPOINT 2010 par ROMELARD Fabrice
Animé par: Vincent Bellet et Baptiste Giraudier La BI dans SharePoint 2010, Les nouveaux services d'application dans SP2010 et SQL Server Reporting services 2008 R2. La BI dans SharePoint est généralisée pour tous afin de permettre à tous les coll...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice TECHDAYS PARIS 2010 : PLAN DE MIGRATION VERS SHAREPOINT 2010TECHDAYS PARIS 2010 : PLAN DE MIGRATION VERS SHAREPOINT 2010 par ROMELARD Fabrice
Animé par: Arnault Nouvel et Antoine Dongois Le processus à prendre : Apprendre (découvrir la plateforme) Préparer (documenter l'historique et choisir la méthode de MAJ) Test (Test de MAJ) Implémenter (Effectuer la MAJ) Valid...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice TECHDAYS PARIS 2010 : LA PLEINIèRE DU SECOND JOURTECHDAYS PARIS 2010 : LA PLEINIèRE DU SECOND JOUR par ROMELARD Fabrice
Après un retour sur l'histoire des TechDays de Paris et le fait que ce soit le plus gros event MS au monde (du fait de sa gratuité), le président de MS France (Eric Boustoullier) a fait une présentation de la vision Microsoft pour les années à venir...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Logiciels
DB-MAIN (9.1.0)DB-MAIN (9.1.0)DB-MAIN is a data-modeling and data-architecture tool. It is designed to help developers and anal... Cliquez pour télécharger DB-MAIN Xilisoft DPG Convertisseur (5.1.37.0120)XILISOFT DPG CONVERTISSEUR (5.1.37.0120)Xilisoft DPG Convertisseur offre aux fans de Nintendo DS une bonne solution leur permettant de dé... Cliquez pour télécharger Xilisoft DPG Convertisseur GraphicsGale (2.01.01)GRAPHICSGALE (2.01.01)GraphicsGale est un logiciel de PixelArt avec de nombreuse fonctionnalités permettant de réalisé ... Cliquez pour télécharger GraphicsGale Architecte 3D (Platinum 2010)ARCHITECTE 3D (PLATINUM 2010)Architecte 3D Platinium vous permet de concevoir facilement les plans votre future maison, de l'é... Cliquez pour télécharger Architecte 3D TeamViewer 5 (TeamViewer 5)TEAMVIEWER 5 (TEAMVIEWER 5)Dépanner un ami,expliquer une manipulation devient un jeu d'enfant.
Prise en main d'un autre ord... Cliquez pour télécharger TeamViewer 5
|