Ecrire des nombres en toutes lettres (multi-language)

Télécharger le projet
Commenter

Description

ce code permet de transformer un nombre (double) en son interpretation en toutes lettres (string).
on peut ajouter des unites principales (euros, kilos, patates) et decimales (centimes, grammes, etc).
une section "dictionary" permet de parametrer le module afin qu'il interprete les nombres dans differentes langues (mais ca ne marche que dans une certaine limite et en tout cas pas pour l'allemand).
exemples d'utilisation :
NumberToWords(-12.583) = "MOINS DOUZE VIRGULE CINQ CENT QUATRE-VINGT TROIS"
NumberToWords(362.43, "euro", "cent") = "TROIS CENT SOIXANTE DEUX EURO QUARANTE TROIS CENT"
NumberToWords(73.5, "kilo") = "SOIXANTE TREIZE VIRGULE CINQ KILO"

Source / Exemple : 


'----------------------------   PROPERTIES   ----------------------------'
'Author = Santiago Diez
'Date = 27 AUGUST 2005  16:54
'Version = 1.2
'---------------------------   DESCRIPTION   ----------------------------'
'Convert any number (Double) in words (String) with the ability to add
'units (like Euros or potatoes) and decimal units (like Cents). Easyly
'adapt to any language by modifying the dictionary section.
'-----------------   PUBLIC PROCEDURES AND FUNCTIONS   ------------------'
'String = NumberToWords(Number As Double, [MainUnit], [DecUnit])
'-------------------------   CALLED LIBRARIES   -------------------------'
'msvbvm60.dll
'VB6.OLB
'VB6FR.DLL
'-----------------------------   OPTIONS   ------------------------------'
Option Explicit
Option Base 1

'+----------------------------------------------------------------------+'
'+                              DICTIONARY                              +'
'+----------------------------------------------------------------------+'

Private Const KWMinus As String = "moins"       'How do you say minus ?
Private Const KWZero As String = "zéro"         'How do you say zero ?
Private Const KWDot As String = "virgule"       'How do you say dot ?
Private Const KWAnd As String = "et"            'How do you say and ?
Private Const KWHundred As String = "cent"      'How do you say hundred ?
Private Const KWThousand As String = "mille"    'How do you say thousand ?
Private Const KWMillions As String = "million"  'How do you say million ?
Private Const KWBillions As String = "milliard" 'How do you say billion ?
Private Function KWOnes(N As Byte) As String
    'How do you say one, two, three, four, five, six, seven, height... ?
    KWOnes = Array("un", "deux", "trois", "quatre", "cinq", "six", _
        "sept", "huit", "neuf")(N)
End Function
Private Function KWTens(N As Byte) As String
    'How do you say ten, twenty, thrirty, fourty, fivty, sixty... ?
    KWTens = Array("dix", "vingt", "trente", "quarante", "cinquante", _
        "soixante", "soixante-dix", "quatre-vingt", "quatre-vingt-dix")(N)
End Function
Private Function KWSpecialNumbers(Number As Double) As String
    'How do you say numbers that do not fit usual rules ?
    Select Case Number
        Case 11: KWSpecialNumbers = "onze"
        Case 12: KWSpecialNumbers = "douze"
        Case 13: KWSpecialNumbers = "treize"
        Case 14: KWSpecialNumbers = "quatorze"
        Case 15: KWSpecialNumbers = "quinze"
        Case 16: KWSpecialNumbers = "seize"
    End Select
End Function
Private Function KWUseOne(Unit As String) As Boolean
    'Do you say "one" before the folowing units ?
    Select Case Unit
        Case KWHundred: KWUseOne = False
        Case KWThousand: KWUseOne = False
        Case KWMillions: KWUseOne = True
        Case KWBillions: KWUseOne = True
    End Select
End Function

'+----------------------------------------------------------------------+'
'+                            MAIN FUNCTION                             +'
'+----------------------------------------------------------------------+'
'This function handles the minus numbers and splits a number in integer _
    and decimal parts.
Public Function NumberToWords(ByVal Number As Double, Optional ByVal _
                            MainUnit, Optional ByVal DecUnit) As String
    'Case Number is negative.
    If (Number < 0) Then
        NumberToWords = (KWMinus & " " & NumberToWords(-Number, MainUnit _
            , DecUnit))
    'General case.
    Else
        NumberToWords = UnitsToWords(Int(Number), Dec(Number), MainUnit, _
            DecUnit)
    End If
End Function
'This function compose an ordered sentence with integer part, decimal _
    part, units and subunits.
Private Function UnitsToWords(IntPart As Double, DecPart As Double, _
                            Optional MainUnit, Optional DecUnit) As String
    If IsMissing(MainUnit) Then
        UnitsToWords = UnitsToWords(IntPart, DecPart, "", DecUnit)
    ElseIf IsMissing(DecUnit) Then
        UnitsToWords = UnitsToWords(IntPart, DecPart, MainUnit, "")
    Else
        UnitsToWords = Trim( _
            IIf((IntPart > 0) Or (DecUnit = ""), _
                IntToWords(IntPart) & _
                IIf((DecUnit = ""), "", " " & CStr(MainUnit)), "") & _
            IIf(DecPart > 0, _
                IIf((DecUnit = ""), " " & KWDot, "") & _
                " " & IntToWords(DecPart) & _
                IIf((DecUnit = ""), "", " " & CStr(DecUnit)), "") & _
            IIf((MainUnit <> "") And (DecUnit = ""), _
                " " & CStr(MainUnit), ""))
    End If
End Function
'This function transforms a positive integer number into words.
Private Function IntToWords(Number As Double) As String
    'Case Number = 0.
    If (Number = 0) Then
        IntToWords = KWZero
    'Case Number is a special number.
    ElseIf (KWSpecialNumbers(Number) <> "") Then
        IntToWords = KWSpecialNumbers(Number)
    'Case Number is greater than a billion.
    ElseIf (Len(CStr(Number)) > 9) Then
        IntToWords = SplitNumber(Number, 9, KWBillions)
    'Case Number is between a million and a billion.
    ElseIf (Len(CStr(Number)) > 6) Then
        IntToWords = SplitNumber(Number, 6, KWMillions)
    'Case Number is between a thousand and a million.
    ElseIf (Len(CStr(Number)) > 3) Then
        IntToWords = SplitNumber(Number, 3, KWThousand)
    'Case Number is between a hundred and a thousand.
    ElseIf (Len(CStr(Number)) > 2) Then
        IntToWords = SplitNumber(Number, 2, KWHundred)
    'Case Number is between ten and a hundred.
    ElseIf (Len(CStr(Number)) > 1) Then
        IntToWords = (KWTens(CByte(LeftPart(Number, 1))) & _
                         RightPartToWords(RightPart(Number, 1)))
    'Case Number is lesser than ten.
    Else
        IntToWords = KWOnes(CByte(Number))
    End If
End Function

'+----------------------------------------------------------------------+'
'+                           OTHER FUNCTIONS                            +'
'+----------------------------------------------------------------------+'
Private Function SplitNumber(Number As Double, CutPos As Byte, CutWord _
                                                    As String) As String
    SplitNumber = (LeftPartToWords(LeftPart(Number, CutPos), CutWord) & _
                   CutWord & _
                   RightPartToWords(RightPart(Number, CutPos)))
End Function
Private Function LeftPartToWords(Number As Double, CutWord As String) As _
                                                                    String
    If ((Number > 1) Or KWUseOne(CutWord)) _
        Then LeftPartToWords = (IntToWords(Number) & " ")
End Function
Private Function LeftPart(Number As Double, CutPos As Byte) As Double
    LeftPart = CDbl(Left(CStr(Number), Len(CStr(Number)) - CutPos))
End Function
Private Function RightPartToWords(Number As Double) As String
    If (Number > 0) Then RightPartToWords = (" " & IntToWords(Number))
End Function
Private Function RightPart(Number As Double, CutPos As Byte) As Double
    RightPart = CDbl(Right(CStr(Number), CutPos))
End Function

'+----------------------------------------------------------------------+'
'+                            MATH FUNCTIONS                            +'
'+----------------------------------------------------------------------+'
'Returns the decimal part of a double as an integer value (e.g. _
    Dec(46.514) returns 514).
Private Function Dec(Value As Double) As Double
    Dec = CDbl(DecString(CStr(Value)))
End Function
Private Function DecString(Value As String) As String
    DecString = "0"
    On Error Resume Next
    If (InStr(1, Value, ".", vbTextCompare) > 0) Then _
        DecString = Mid(Value, InStr(1, Value, ".", vbTextCompare) + 1)
End Function

Conclusion :


je vous le dis tout de suite, y'a des fautes :
pour l'instant, la fonction ne gere pas le "et" de "vingt et un" ou "trente et un" ;
elle ne gere pas non plus les "-" comme dans "vingt-deux" (parait il qu'il y en a) ;
elle ne connait pas les pluriel "un euro" ou "douze euro".
voila, si vous trouvez des bugs autres que ceux-la sur lesquels je travaille, ca m'interesse.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_santiago69)