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
| unit Unit1;
//***********************************************************************//
//** modifié d'après http://www.angelfire.com/nt/elatlas **//
//***********************************************************************//
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ShellApi, Buttons;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Label8: TLabel;
Label13: TLabel;
BitBtn1: TBitBtn;
Function EnLettres(N:Integer):String;
procedure Button1Click(Sender: TObject);
//procedure Label12Click(Sender: TObject);
//procedure Label13Click(Sender: TObject);
procedure Edit1Click(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
n : integer;
S : String;
implementation
{$R *.DFM}
Function TForm1.EnLettres(N:Integer):String;
Const
Unite: Array[1..16] of String=('un','deux','trois','quatre','cinq','six',
'sept','huit','neuf','dix','onze','douze',
'treize','quatorze','quinze','seize');
Dizaine: Array[2..8] of String=('vingt','trente','quarante','cinquante',
'soixante','','quatre-vingt');
Coefs:Array[0..3] of String=('cent','mille','million','milliard');
Var
Temp: String;
C,D,U: Byte;
Coef: Byte;
I: Word;
Neg: Boolean;
begin
If N = 0 then
begin
Result := ' Zéro';
Exit;
end;
Result := '';
Neg := N <0;
If Neg then N := -N;
Coef := 0;
Repeat
U := N mod 10; N := N div 10; {Récupère unité et dizaine}
D := N mod 10; N := N div 10; {Récupère dizaine}
If D in [1,7,9] then
begin
Dec(D);
Inc(U, 10);
end;
Temp := '';
If D > 1 then
begin
Temp := ' ' + Dizaine[D];
If (D < 8) and ((U = 1) or (U = 11)) then
Temp := Temp + ' et';
end;
If U > 16 then
begin
Temp := Temp + ' ' + Unite[10];
Dec(U,10);
end;
If U > 0 then Temp := Temp + ' ' + Unite[U];
If (Result = '') and (D = 8) and (U = 0) then Result := 's';
Result := Temp + Result;
C := N mod 10; N := N div 10; {Récupère centaine}
If C > 0 then
begin
Temp := '';
If C > 1 then Temp := ' ' + Unite[C] + Temp;
Temp := Temp + ' ' + Coefs[0];
If (Result = '') and (C > 1) then Result := 's';
Result := Temp + Result;
end;
If N > 0 then
begin
Inc(Coef);
I := N mod 1000;
If (I > 1) and (Coef > 1) then Result := 's' + Result;
If I > 0 then Result := ' ' + Coefs[Coef] + Result;
If (I= 1) and (Coef = 1) then Dec(N);
end;
until N = 0;
If Neg then Result := 'Moins' + Result
else
Result[2] := UpCase (Result[2]);
end;
Procedure TForm1.Button1Click(Sender: TObject);
var
C, D, sous, dollards : string;
car : array [1..3] of string;
I, Y, Z : integer;
begin
S:=Edit1.text;
If (S='') then // si la chaine S est vide Erreur
begin
Application.MessageBox('Veuillez Saisir une somme d''abord.', 'Erreur: Rien à convertir !',mb_IconError+mb_Ok);
exit;
end;
i:=0;// connaitre la position du separateur decimale
While not((S[i]='.') or(i > length(S))) do
begin
i:=i+1;
end;
C:=copy(S,i,1);
if C='.' then // s'il y a un nombre decimale
begin
D:=copy(S,1,(i-1));
dollards:=enLettres(StrToInt(d));
sous:=copy(S, i+1, (Length(S)-i));
// remplir un tableau car par des chaines vides
for y:=1 to 3 do // Le nombre de Zero permit et de 3 maxi !
begin
car[y]:='';
end;
y:=0; // Y represente le nombre de Zero apres le separateur decimale
z:=i+1;
While (S[z]='0') or(z > length(S)) do
begin
y:=y+1;
z:=z+1;
car[y]:='Zero ';
end;
//s'il y a des Zero apres le separateur decimale
if y>0 then
// il faut l'ecrire -- maxi 3 nombres ont la valeur egal à 0, soit permit
sous:=' et '+car[1]+car[2]+car[3]+enLettres(StrToInt(sous))+' sous'
else // sinon il n'y a pas de zero à ecrire
sous:=' et'+enLettres(StrToInt(sous))+' sous';
label8.caption:=dollards+' dollards '+sous;
end
else // sinon lire la partie entiere
begin
D:=copy(S,1,(length(S)));
dollards:=enLettres(StrToInt(D));
label8.caption:=dollards+' dollards';
end; // else
end;
//procedure TForm1.Label12Click(Sender: TObject);
//begin
//
//end;
//procedure TForm1.Label13Click(Sender: TObject);
//begin
//
//end;
procedure TForm1.Edit1Click(Sender: TObject);
begin
Edit1.Clear;
Edit1.SetFocus;
end;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in [#8,#13,'.','-','0'..'9']) Then Key := #0;
end;
end. |
Partager