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 2012 : WINDOWS SERVER "8" QUOI DE 9 !TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 ! par ROMELARD Fabrice
Speakers: Fabrice Meillon et Stanislas Quastana Cette session est basée entièrement sur celle donnée lors de la BUILD cet hiver. Il n'y a pas d'ajout d'information en rapport avec cet évènement passé. Windows 8 Server sera intégralem...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice [HTML5] AUTOUR DU W3C : NOUVEAUX STANDARDS ET WEB MOBILE (LILLE)[HTML5] AUTOUR DU W3C : NOUVEAUX STANDARDS ET WEB MOBILE (LILLE) par Gio
Je m'y prends un peu tard je sais, mais bon je suis développeur web et donc hyper fainéant ! Toujours dans le cadre des technologies émergentes, ici HTML5, parce qu'on aime HTML5 chez Wyg , nous seront présent, le vieux ( Aurélien V.) et moi, pour pr...
Cliquez pour lire la suite de l'article par Gio [WP7] DYNAMICALLY CHANGE STARTUP PAGE[WP7] DYNAMICALLY CHANGE STARTUP PAGE par KooKiz
Let's say that you want to allow the user to customize the startup page of your application. You can easily change the startup page by editing the 'NavigationPage' attribute in the manifest file. But the manifest cannot be modified once the applicatio...
Cliquez pour lire la suite de l'article par KooKiz SESSION SILVERLIGHT 5 3D : SLIDES ET DEMOSSESSION SILVERLIGHT 5 3D : SLIDES ET DEMOS par Groc
Durant les techdays, j'ai eu le plaisir d'animer une session sur Silverlight 5 et la 3D avec Simon Ferquel. Comme promis, voici nos slides et mes démos (celles avec le viper BSG) ici et là. Pour mémoire, les démos utilisent toutes le viper BSG...
Cliquez pour lire la suite de l'article par Groc
Logiciels
DocTranslate (V3.1.0.0)DOCTRANSLATE (V3.1.0.0)DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom... Cliquez pour télécharger DocTranslate Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System
|