1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
| ; ------------------------------------------------------------------------
; CODE de la : Convertion de Chiffres en Lettres
; 17-06-2008 V4 J.G. (GeBonet)
; Forme documentée... : Comme cela devrait être pour être compris... :-)
; ----------------------------------------------------------------------
; NOTE : La partie Initialisation et les procédures peuvent faire partie d'un module qui serait
; compilé en DLL et utilisable à partir de n'importe quelle programme qui aurait besoin
; de convertion de chiffres en lettre...
; ======================================================
; Initialisation de la table des nombres à partir de lecture des DATA.... On..
; ; Charge dans deux tableaux qui sont :
Global Dim TableEntier.s(90) ; << Les entiers >>
Global Dim TableDecim.s(14) ; << Les décimales >>
;
Global Nombre.s
Global nb.s
Global Section.s
Global Decode.s
Declare.s LitDansFichierLettres(Section.s, Cle.s)
Declare.s Decodage(nb.s)
Declare.s Conversion(nb.s)
;------------------------------------------------------------------------------------------------------
; * Initialisation des tables de la représentation littérale START PROGRAMME *
;------------------------------------------------------------------------------------------------------
Repeat ; Partie de lecture des DATA qui pourrait -être lus sur disque et donc modifiables
Read.s Numero$ ; sans entrer dans le programme pour un executable par exemple ....
If Numero$<>"FinDecimale" ; Mais la forme sur disque devrait respecter strictement l'ordre ci dessous et
Num=Val(Numero$) ; se terminer absolument par "FinEntier" et "FinDecimale"
If Entier=0 ; A noter que le mot "unité" peut être rempalcer par ce que l'on veut...
If Numero$="FinEntier" ; Exemple : euros ou mètres pour plus d'un...
Entier=1
Else
TableEntier(Num)=Numero$:
EndIf
Else
TableDecim(Num)=Numero$
EndIf
EndIf
Until Numero$="FinDecimale" ; recherche "FinDecimale" qui marque la fin du fichier
;
DataSection
MesChiffres:
Data.s "0=zéro","1=un","2=deux","3=trois","4=quatre","5=cinq","6=six","7=sept","8=huit","9=neuf","10=dix","11=onze"
Data.s "12=douze","13=treize","14=quatorze","15=quinze","16=seize"
Data.s "20=vingt","30=trente","40=quarante","50=cinquante","60=soixante","70=septante","80=quatre-vingt","90=nonante","FinEntier"
;[Decimale]
Data.s "1=dixième","2=centième","3=millième","4=dix-millième","5=cent-millième","6=millionième","7=dix-millionième"
Data.s "8=cent-millionième","9=milliardième","10=dix-milliardième","11=cent-milliardième","FinDecimale"
EndDataSection
;
; *****************************************************************************************
; Début de programme pour l'utilisateur et prise de la valeur à convertir
; *****************************************************************************************
NbrBase.s="251251263,567665" ; Valeur présentée par defaut !!!!!!!
Repeat
; Entré de la valeur à convertir
Nombre= InputRequester("Transformeur","Donnez votre valeur : ",NbrBase)
ReplaceString(Nombre, ".",",",2) ; Vérifie que les points, s'il y a, deviennent virgules...
NbrBase=Nombre
Reponse$=Conversion(Nombre) ; APPEL ICI et REPONSE ICI
; ; PUIS <<< Affichage de la conversion !!!! >>>
Resultat=MessageRequester("Pour : "+Nombre+" Autre cas ? ",Reponse$,#PB_MessageRequester_YesNo)
Until Resultat = 7
;
End
;
; *************************************************************************************************************************************
; NOTE : A la place de l'appel ci-dessus >>> La forme utile à inclure si une DLL à été crée serait celle-ci ........
; ---------------------------------------------------------------------------------------------------------------------------------------------------------------
;1 #Bibliotheque=0 : OpenLibrary(#Bibliotheque,"ChifLettre.dll") ; Donner un Numéro et Ouvrir la DLL
;2 NbrBase=Nombre ; Nombre à convertir sous forme "string" (chaine)
;3 ReplaceString(Nombre, ".",",",2) ; Vérifie que les points, s'il y a, deviennent virgules...
;4 ; >>>>>>> Appel de la Librairie (Dll) <<<<<
;5 *adresse_Reponse=CallFunction(#Bibliotheque,"Conversion",Nombre) ; APPEL ICI et REPONSE ICI
;6 NbrBase = PeekS(*adresse_Reponse) ; REPONSE à l'adresse donnée par "PeekS"
;7 CloseLibrary(#Bibliotheque) ; IMPORTANT : Fermer la librairie !!!
; ***************************************************************************************************************************************
;******************************************************************************************
; <<<<<<<<<< L E S P R O C E D U R E S >>>>>>>>>>>
;******************************************************************************************
; MODULES de lecture dans les tables
;
; Section.s = désigne les entiers ou les décimales
; Cle.s = désigne le numéro de la table ou se trouve la repésentation du nombre
;' --------------------------------------------------------------------------------------------------------------------------------
Procedure.s LitDansFichierLettres(Section.s, Cle.s)
Protected strReturn.s ,Indice.b
Shared TableEntier.s(), TableDecim.s(), EnLettre.s
If Section="Chiffres" : Indice=1: EndIf ; Donne une valeur d'orientation...On pourrait en nettoyant
If Section="Decimale": Indice=2:EndIf ; le programmme supprimer ici une partie de code...
strReturn = Space(255) ; par une affectation directe selon Section et Cle !
Select Indice ; rechercher la valeur donné par la Clef
Case 1
strReturn=TableEntier.s(Val(Cle)) ; C'est la partie entière
Case 2
strReturn=TableDecim.s(Val(Cle)) ; C'est la partie décimale
Default
strReturn="Erreur Table"
Return
EndSelect
Position=FindString(strReturn, "=",1)
EnLettre.s=Mid(strReturn,Position+1)
TableDecim.s(12)=EnLettre ; Memo Pour Debug
ProcedureReturn EnLettre
EndProcedure
;' -------------------------------------------------------------------------------------------------------------------------------
; Décodage et moteur de Conversion a proprement parlé
; système RECURSIF ....
;---------------------------------------------------------------------------------------------------------------------------
Procedure.s Decodage(nb.s)
Protected nb1.s
Protected Precede.s
Shared Decode$
;
Select Len(nb)
Case 0
Decode$ = ""
Case 1
Section.s="Chiffres": Decode$ = LitDansFichierLettres(Section.s, nb.s)
Case 2
If Val(nb) < 17
Section.s="Chiffres":Decode$=""
If TableDecim.s(14)="Mille": Decode$="et ":EndIf
Partie$=LitDansFichierLettres(Section.s, nb.s)
If Val(Partie$)=0:Decode$="":EndIf
Decode$ = Decode$+Partie$
Else
nb1=Str(Int(Val(nb)/10)*10) ; prend la partie dizaine
Section.s="Chiffres":Decode$ = LitDansFichierLettres(Section.s, nb1)
nb1 = Right(nb, 1): Decode$=Decode$+"-"+LitDansFichierLettres(Section.s, nb1)
EndIf
If Right(Decode$, 2)="un" And nb > "20"
Decode$=Left(Decode$, Len(Decode$) - 2)+"et un"
EndIf
If Right(Decode$, 4)="zéro" :Decode$=Left(Decode$, Len(Decode$) - 5):EndIf
; ----------------------------------------------------------------------------------------
Case 3 ; <<< A Partir d'ici on entre dans le domaine de la récursivité >>>
; ; ---------------------------------------------------------------------------------------
If Left(nb, 1)="0" ; Pouvant-être "00x" il faut éliminer au moins un zéro ...
nb = Right(nb, Len(nb) - 1) ; pour le faire entrer dans les "jusqu'au dizaines.... "
Decode$ = Decodage(nb) ;
Else ; Vraiment dans les centaines exprimées / Centièmes ...
If Left(nb, 1)="1"
Decode$ = "cent "+Decodage(Mid(nb, 2))
Else
Decode$ = Decodage(Left(nb, 1))+" cent "+Decodage(Mid(nb, 2))
If Right(Decode$, 6) = " cent " : Decode$ = Left(Decode$, Len(Decode$) - 1)+"s":EndIf
EndIf
EndIf
Case 4 To 6 ; Le domaine des milliers / Millièmes
If Left(nb, 1)="0" ; Pouvant-être "00000x" il faut éliminer au moins un zéro ...
nb = Right(nb, Len(nb) - 1) ; pour le faire entrer dans les "jusqu'au dizaines.... "
TableDecim.s(14)="Mille" ; Origine
Decode$ = Decodage(nb) ;
Else ; Vraiment dans les centaines exprimées / Centièmes ...
Decode$ =Decodage(Left(nb, Len(nb) - 3))+" mille "+Decodage(Right(nb, 3))
If Left(Decode$, 2) = "un" : Decode$ = Mid(Decode$, 4):EndIf
EndIf
Case 7 To 9 ; Le domaine des millions / Millionnièmes
If Left(nb, 1)="0" ; Pouvant-être "00000000x" il faut éliminer les zéro de trop ...
nb = Right(nb, Len(nb) - 1) ; pour le faire entrer dans les "jusqu'au dizaines.... "
TableDecim.s(14)="Mille" ; Origine
Decode$ = Decodage(nb) ;
Else
Decode$ = Decodage(Left(nb, Len(nb) - 6))+" millions "+Decodage(Right(nb, 6))
If Left(Decode$, 2) = "un" : Decode$ = Left(Decode$, 10)+Mid(Decode$, 12):EndIf
EndIf
Case 10 To 12 ; Le domaine des milliards / Milliardièmes...
If Left(nb, 1)="0" ; Pouvant-être "00000000000x" il faut éliminer les zéro de trop ...
nb = Right(nb, Len(nb) - 1) ; pour le faire entrer dans les "jusqu'au dizaines.... "
TableDecim.s(14)="Mille" ; Origine
Decode$ = Decodage(nb) ;
Else
Decode$ = Decodage(Left(nb, Len(nb) - 9))+" milliards "+Decodage(Right(nb, 9))
If Left(Decode$, 2) = "un" : Decode$ = Left(Decode$, 11)+Mid(Decode$, 13):EndIf
EndIf
Default
Decode$="Err"
EndSelect
TableDecim.s(14)=""
ProcedureReturn Decode$
EndProcedure
;---------------------------------------------------------------------------------------------------------------------------
; Conversion de Nb ...
;---------------------------------------------------------------------------------------------------------------------------
Procedure.s Conversion(nb.s)
Protected NbDeci.s ; Préserve quelques données
Protected Affichage.s ; a usage locale...
Protected Entier.s
Protected Decimal.s
; <<<<< Détermination de la partie Entière seule >>>>>>> -------------------------------------
Pos.w=FindString(nb, ",",1) ; Au cas ou "nb" c'est un...
If Pos.w = 0 ; un entier
Affichage =Decodage(nb) ; OU
Affichage=Affichage+Expr$ ; ici Expr$ censé exprimé l'unitée de travail si on l'exprime...
Else ; un décimal ce qui change tout ...
; --------- <<< Il y a la Détermination de la partie Entière seule et décimale à faire >>> -------
Repeat ; suppression des zéros à droite de la partie décimale
If Right(nb, 1) = "0" : nb = Left(nb, Len(nb) - 1):EndIf
Until Right(nb, 1)<>"0"
; ; Puis séparation des deux parties
Entier=Left(nb, FindString(nb, ",",1) - 1) ; Prise de la partie entière
Decimal=Mid(nb, FindString(nb, ",",1) + 1) ; Prise de la partie décimale
; -------------------------<<<<< Décodage de la partie entière >>>>>>> ------------------------
Entier = Decodage(Entier) ; Decodage de la partie entière de nb
; ----------------------------------------------------- ; ICI Définition et usage de l'unité utilisée
If Right(Entier, 2) = "un" : Entier = Entier+"e":EndIf ; CHANGER ICI POUR METTRE DES "EUROS" OU "AUTRE".......
If Entier = "une" :Entier = Entier+" unité ": Else :If Entier <> "" : Entier = Entier+" unités ":EndIf: EndIf
; <<<<< Décodage de la partie Decimale >>>>>>> ---------------------------------------------
NbDeci=Str(Len(Decimal)) ; Nombre de décimales
Decimal = Decodage(Decimal) ; Et enfin, expression du type d'unitée...
Affichage = Entier+Decimal+" " ; Réunion des deux parties
Affichage = Affichage +LitDansFichierLettres("Decimale", NbDeci)
If Decimal<>"un" : Affichage = Affichage +"s":EndIf ; Pour plusieur on ajoute un s aux décimales...
EndIf
If Left(Affichage,3)="Err" : Affichage="Dépassement de capacité (Nombre>que 12 chiffres)":EndIf
ProcedureReturn Affichage
EndProcedure
; ***************************************************************************************************************
; IDE Options = PureBasic 4.30 (Windows - x86)
; Folding = -
; CurrentDirectory = C:\0 01 Pure Basic\PureBasic\
; CompileSourceDirectory
; EnableCompileCount = 67
; EnableBuildCount = 0
; EnableExeConstant |
Encore une conversion de chiffre en lettre Version PB
Répondre avec citation
Partager