ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

Conversion d'un nombre en lettre (FrCh)   



L'auteur

dargone
Suisse Suisse
Membre Simple
# 0000003058
enregistré le 02/03/2011

Fiche personnelle


Note des membres
pas de note

Contributions > 01 - PRG : Programmation > Conversions

Conversion d'un nombre en lettre (FrCh)
# 0000000786
ajouté le 02/03/2011 15:36:13 et modifié le 02/03/2011
consulté 7488 fois
Niveau initié

Version(s) Foxpro :
VFP 9.0
VFP 8.0
VFP 7.0
VFP 6.0

Description

C'est une fonction qui permet de transformer une nombre en lettre.

Elle a été repris et adapté pour le francais suisse et avoir les centimes en lettre :

ericleissler
http://www.atoutfox.org/articles.asp?ACTION=FCONSULTER&ID=0000000067

Paramètre :

lnNumberIn : nombre à convertir (p.exemple 54.04)

lcCurrencyName : monnaie (franc)

Exemple : 54.04 => cinquante quatre francs zéro quatre

Code source :
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
Commentaires
le 09/03/2011, eric leissler a écrit :
Bonjour,
Bravo !
Voila exemple même de l'esprit fox. Le partage de connaissances.


www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2024.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0-SP2-HF3