Convertire un chiffre en lettre

karim - 15 juil. 2001 à 21:44
 BAK - 19 juil. 2001 à 18:44
je cherche comment ecrire les totaux d une facture en lettreun grand merci a tous ceux qui viennent pour m aider.

1 réponse

unit NombreToLettre;

interface

Function SommeEnChaine(Somme : Extended) : String;

const
NomUnites : Array[0..19] Of String[10]
= ('zéro ','un ','deux ','trois ','quatre ',
'cinq ','six ','sept ','huit ','neuf ',
'dix ','onze ','douze ','treize ','quatorze ',
'quinze ','seize ','dix-sept ','dix-huit ','dix-neuf '
);
NomDizaines : Array[0..9] Of String[13]
= ('','dix ','vingt ','trente ','quarante ','cinquante ',
'soixante ','soixante-dix ','quatre-vingt ','quatre-vingt ');

NomCentaines : String[10] = 'cent';
NomMilliers : String[10] = 'mille';
NomMillions : String[10] = 'million';

LiaisonsDizainesUnites = 'et'; {trente ET un}
LiaisonUnitesCentiemmes = 'et'; {neuf francs ET quarante centimes}

NomMonaie : String = 'franc';
NomCentiemme : String[10] = 'centime';

{Si vous voulez juste convertir un nombre (et pas de l'argent) il suffit de
mettre
LiaisonUnitesCentiemmes = 'virgule';

NomMonaie : String = '';
NomCentiemme : String[10] = '';}

implementation

Function SommeEnChaine(Somme : Extended) : String;
Var
Millions,
Milliers,
Cents : Word;
Fract : Word;
So : Extended;
Chn : String;

Function RecuperePortion(Diviseur : Integer) : Word;
Var
R : Extended;
DV : Extended;
i : Integer;

Begin
DV := 1;
For i := 1 To Diviseur Do
DV := DV*10;
R := Trunc(So / Int(DV));
So := So - (R*Int(DV));
RecuperePortion := Trunc(R);
End;

Function CentsEnChaine(C : Word;ZeroAussi : Boolean) : String;
Var
S : String;
Ce,Di,Un : Byte;
Begin
CentsEnChaine := '';
S := '';
Ce := (C Div 100) Mod 10;
Di := (C Div 10) Mod 10;
Un := (C Mod 10);
If C = 0 Then
If ZeroAussi Then S := NomUnites[0]
Else S := ''
Else
Begin
If Ce > 0 Then
Begin
If ce > 1 Then
Begin
S := S + NomUnites[ce]+NomCentaines;
If (Di > 0) Or (Un > 0) Then S := S + ' '
Else S := S + 's ';
End
Else
If ce = 1 Then S := NomCentaines+' ';
End;
If Di > 0 Then
Begin
Case Di Of
1 : S := S + NomUnites[C Mod 100];
2,3,4,5,6
: Begin
S := S + NomDizaines[Di];
If Un = 1 Then S := S + LiaisonsDizainesUnites+ ' ';
If Un > 0 Then S := S + NomUnites[Un];
End;
8 : Begin
S := S + NomDizaines[DI];
If Un = 0 Then Insert('s',S,Length(S))
Else S := S + NomUnites[Un];
End;
7,9
: Begin
S := S + NomDizaines[Di];
If Un = 1 Then
S := S + LiaisonsDizainesUnites+ ' ';
S := S + NomUnites[Un+10];
End;
End;
End
Else {DI = 0 -> Pas de dizaines}
Begin
If Un > 0 Then
S := S + NomUnites[Un];
End;
End;
CentsEnChaine := S;
End;
function SupprEspace(Str : string) : String;
begin
Result :=Str;
while Pos(' ', result) > 0 do
result := copy(result, 1, Pos(' ', result))+
copy(result, Pos(' ', result)+2,
length(result)-Pos(' ', result)+2);
end;

Begin
SommeEnChaine := '';
Chn := '';
Somme := Abs(Somme);
Fract := Round(Frac(Somme) * 100);
If Fract > 99 Then
Begin
Fract := 0;
Somme := Somme+1;
End;
So := Somme;
Millions := RecuperePortion(6);
Milliers := RecuperePortion(3);
Cents := Trunc(So);
If Millions > 0 Then
Begin
Chn := CentsEnChaine(Millions,False) + NomMillions;
If Millions > 1 Then Chn := Chn + 's';
Chn := Chn + ' ';
End;
If Milliers > 1 Then
Chn := Chn + CentsEnChaine(Milliers,False) + NomMilliers+' '
Else
If Milliers = 1 Then
Chn := Chn + NomMilliers+' ';
Chn := Chn + CentsEnChaine(Cents,(Millions=0) And (Milliers=0))
+ NomMonaie;
If ((Cents > 1) or (Milliers > 1) or (Millions > 1)) and (NomMonaie <>'')
and (NomMonaie[length(NomMonaie)] <>'s') Then
Chn := Chn + 's';
If Fract > 0 Then
Begin
Chn := Chn + ' '+LiaisonUnitesCentiemmes+' ' + CentsEnChaine(Fract,False) + NomCentiemme;
If (Fract > 1) and (NomCentiemme<>'') and (NomCentiemme[length(NomCentiemme)] <>'s') Then Chn := Chn + 's';
End;
SommeEnChaine := SupprEspace(Chn);
End;

end.
0
Rejoignez-nous