function NumberToWordsFrCh(lnNumberIn, lcCurrencyName)
*
* Convertit un nombre en lettres, en français (suisse)
*
local lnWordNum, lnLevel
local lcNumber
local lcNumberRoot
local laLevel, lcNumberOut, lcNumberCentOut, laHundreds, laThousands, laExceptions1, laExceptions2
lcCurrencyName = evl(lcCurrencyName, '')
lnNumberIn = abs(lnNumberIn)
lcNumber = ltrim(transform(round(iif(vartype(lnNumberIn) = 'C', val(lnNumberIn), lnNumberIn), 2), '999999999999999.99'))
lcNumberCent = right(lcNumber, 2)
lcNumberRoot = left(lcNumber, len(lcNumber)-3)
* Prépare les mots et les exceptions
dimension laLevel(1, 2), laThousands(5), laCent(1, 2)
dimension laHundreds(9, 3), laExceptions1(14, 2), laExceptions2(2, 2)
lcNumberOut = ''
lcNumberCentOut = ''
laHundreds(1, 1) =[cent ]
laHundreds(1, 2) =[dix ]
laHundreds(1, 3) =[un ]
laHundreds(2, 1) =[deux cents ]
laHundreds(2, 2) =[vingt ]
laHundreds(2, 3) =[deux ]
laHundreds(3, 1) =[trois cents ]
laHundreds(3, 2) =[trente ]
laHundreds(3, 3) =[trois ]
laHundreds(4, 1) =[quatre cents ]
laHundreds(4, 2) =[quarante ]
laHundreds(4, 3) =[quatre ]
laHundreds(5, 1) =[cinq cents ]
laHundreds(5, 2) =[cinquante ]
laHundreds(5, 3) =[cinq ]
laHundreds(6, 1) =[six cents ]
laHundreds(6, 2) =[soixante ]
laHundreds(6, 3) =[six ]
laHundreds(7, 1) =[sept cents ]
laHundreds(7, 2) =[septante ]
laHundreds(7, 3) =[sept ]
laHundreds(8, 1) =[huit cents ]
laHundreds(8, 2) =[huitante ]
laHundreds(8, 3) =[huit ]
laHundreds(9, 1) =[neuf cents ]
laHundreds(9, 2) =[nonante ]
laHundreds(9, 3) =[neuf ]
laThousands(1) = lcCurrencyName
laThousands(2) =[mille]
laThousands(3) =[million]
laThousands(4) =[milliard]
laThousands(5) =[billion]
laExceptions1(1, 1) =[dix un]
laExceptions1(1, 2) =[onze]
laExceptions1(2, 1) =[dix deux]
laExceptions1(2, 2) =[douze]
laExceptions1(3, 1) =[dix trois]
laExceptions1(3, 2) =[treize]
laExceptions1(4, 1) =[dix quatre]
laExceptions1(4, 2) =[quatorze]
laExceptions1(5, 1) =[dix cinq]
laExceptions1(5, 2) =[quinze]
laExceptions1(6, 1) =[dix six]
laExceptions1(6, 2) =[seize]
laExceptions1(7, 1) =[vingt un]
laExceptions1(7, 2) =[vingt et un]
laExceptions1(8, 1) =[trente un]
laExceptions1(8, 2) =[trente et un]
laExceptions1(9, 1) =[quarante un]
laExceptions1(9, 2) =[quarante et un]
laExceptions1(10, 1) =[cinquante un]
laExceptions1(10, 2) =[cinquante et un]
laExceptions1(11, 1) =[soixante un]
laExceptions1(11, 2) =[soixante et un]
laExceptions1(12, 1) =[septante un]
laExceptions1(12, 2) =[septante et un]
laExceptions1(13, 1) =[huitante un]
laExceptions1(13, 2) =[huitante et un]
laExceptions1(14, 1) =[nonante un]
laExceptions1(14, 2) =[nonante et un]
laExceptions2(1, 1) =[vingts]
laExceptions2(1, 2) =[vingt]
laExceptions2(2, 1) =[cents]
laExceptions2(2, 2) =[cent]
* Parcourt les chiffres et prépare le nombre en lettres
lcPluriel = iif(!empty(lcCurrencyName), 's ', '')
lnWordNum = 1
do while .t.
if lnWordNum = 1
laLevel(1, 1) = right(lcNumberRoot, iif(len(lcNumberRoot)>2, 3, len(lcNumberRoot)))
laLevel(1, 2) = ''
laCent(1, 1) = right(lcNumberCent, iif(len(lcNumberCent)>2, 3, len(lcNumberCent)))
laCent(1, 2) = ''
else
dimension laLevel(lnWordNum, 2)
laLevel(lnWordNum, 1) = right(lcNumberRoot, iif(len(lcNumberRoot)>2, 3, len(lcNumberRoot)))
laLevel(lnWordNum, 2) = ''
endif
lnWordNum = lnWordNum+1
lcNumberRoot = left(lcNumberRoot, len(lcNumberRoot)-3)
if len(lcNumberRoot) = 0
exit
endif
enddo
for lnWordNum = 1 to alen(laLevel, 1)
laLevel(lnWordNum, 1) = iif(len(laLevel(lnWordNum, 1))<3, padl(laLevel(lnWordNum, 1), 3, '0'), laLevel(lnWordNum, 1))
for lnLevel = 1 to len(laLevel(lnWordNum, 1))
if substr(laLevel(lnWordNum, 1), lnLevel, 1)<>'0'
laLevel(lnWordNum, 2) = laLevel(lnWordNum, 2)+laHundreds(val(substr(laLevel(lnWordNum, 1), lnLevel, 1)), lnLevel)
endif
next
if lnWordNum = 1
laCent(lnWordNum, 1) = iif(len(laCent(lnWordNum, 1))<2, padl(laCent(lnWordNum, 1), 2, '0'), laCent(lnWordNum, 1))
for lnCent = 1 to len(laCent(lnWordNum, 1))
if substr(laCent(lnWordNum, 1), lnCent, 1)<>'0'
laCent(lnWordNum, 2) = laCent(lnWordNum, 2)+iif(substr(laCent(lnWordNum, 1), 1, 1) = '0', 'zéro ', '')+laHundreds(val(substr(laCent(lnWordNum, 1), lnCent, 1)), lnCent + 1)
endif
next
endif
if lnWordNum>1 and val(laLevel(lnWordNum, 1)) > 0
laLevel(lnWordNum, 2) = laLevel(lnWordNum, 2)+laThousands(lnWordNum)+iif(val(laLevel(lnWordNum, 1))>1.and.lnWordNum>2, lcPluriel, ' ')
endif
next
for lnWordNum = alen(laLevel, 1) to 1 step -1
lcNumberOut = lcNumberOut+laLevel(lnWordNum, 2)
next
for lnWordNum = alen(laCent, 1) to 1 step -1
lcNumberCentOut = lcNumberCentOut +laCent(lnWordNum, 2)
next
* Traite les exceptions
for lnWordNum = 1 to 14
lcNumberOut = strtran(lcNumberOut, laExceptions1(lnWordNum, 1), laExceptions1(lnWordNum, 2))
lcNumberCentOut = strtran(lcNumberCentOut, laExceptions1(lnWordNum, 1), laExceptions1(lnWordNum, 2))
next lnWordNum
* Cas spécial avec mille
lcNumberOut = iif(left(lcNumberOut, 8) = [un mille], right(lcNumberOut, len(lcNumberOut)-3), lcNumberOut)
lcNumberCentOut = iif(left(lcNumberCentOut , 8) = [un mille], right(lcNumberCentOut , len(lcNumberCentOut )-3), lcNumberCentOut )
* Vingt et cent
for lnWordNum = 1 to 2
lcNumberOut = strtran(left(lcNumberOut, len(lcNumberOut)-4), laExceptions2(lnWordNum, 1), laExceptions2(lnWordNum, 2))+right(lcNumberOut, 4)
lcNumberCentOut = strtran(left(lcNumberCentOut , len(lcNumberCentOut )-4), laExceptions2(lnWordNum, 1), laExceptions2(lnWordNum, 2))+right(lcNumberCentOut , 4)
next
* Autres exceptions et pluriel
lcNumberOut = lcNumberOut+iif(len(alltrim(lcNumberOut))>2, ;
laThousands(1)+ ;
lcPluriel, ;
iif(!empty(lcNumberOut), ;
laThousands(1)+' ', [zéro ] + laThousands(1) + ' '))
lcNumberOut = lcNumberOut + lcNumberCentOut
return lcNumberOut
|
Retour à la liste
Suisse
Fiche personnelle
Note des membres
Bonjour,
Bravo !
Voila exemple même de l'esprit fox. Le partage de connaissances.