برنامج تحويل الاعداد- عربي فرنسي-

[nebchadelphi]

السلام عليكم
اليوم اضع برنامج تحويل الأعداد إلى حروف
هذا الاصدار الثاني يدعم كل من اللغة العربية والفرنسية
**** أن ينال إعجابكم
و**** من من لديه أية تعليقات أو إقتراحات أن يكتبها من أجل التحسين
وشكرا

معطرة الرابط هو
وشكرا

**** الردود

[kachwahed]

عمل رائع أخي nebchadelphi وبرنامج جميل.
فقط إحذر فقد يكون جهازك ملوث، تقرير Kaspersky يقول:

كود :

Virus.Win32.Induc.a

وأيضا تقارير المضادات الأخرى من VirusTotal
تم تنظيف المرفق، بالتوفيق.

[I_Tiger]

برنامج جميل و فكرة اجمل ، فاحيانا قد يمتلك المبرمج عضلات برمجية دون منتوج يذكر.

لكن الفكرة المفيدة مهما كانة بسيطة تعطي قيمة للمنتوج.

واصل بارك الله فيك.

[nebchadelphi]

السلام عليكم
أشكركم اخوتي جميعكم
وانا في انتظار أي اقتراحات أو انتقادات
انا الآن في صدد اضافة اللغة الانجليزية
والسلام

[sami2008]

شيء جمبل وبرنامج جميل أين الكود يأخي وإن كنت تبحث على الكود والمصدر أعطيك عنوان delphi fr.com الكود موجود بالعربية وبالفرنسية السلام عليكم

[kachwahed]

الأخ sami2008 مرحبا بك في المنتدى
في قسم "برامج من عمل الأعضاء" لا تطرح الملفات المصدرية (الكود سورس)
راجع: مرحبا بك في منتدى دلفي للعرب

[sami2008]

كود :

function NombreEnLettres(n: Integer): string; Const unite: array [1 .. 19] of string = ('un', 'deux', 'trois', 'quatre', 'cinq', 'six', 'sept', 'huit', 'neuf', 'dix', 'onze', 'douze', 'treize', 'quatorze', 'quinze', 'seize', 'dix sept', 'dix huit', 'dix neuf'); dizaineF: array [2 .. 9] of string = ('vingt', 'trente', 'quarante', 'cinquante', 'soixante', '', 'quatre-vingt', ''); dizaineB: array [2 .. 9] of string = ('vingt', 'trente', 'quarante', 'cinquante', 'soixante', 'septante', 'octante', 'nonante'); coefs: array [0 .. 3] of string = ('cent', 'mille', 'million', 'milliard'); Var temp: String; c, d, u: Integer; coef: Integer; I: Integer; neg: Boolean; Begin Result := ''; // Cas particulier de zéro If n = 0 then begin Result := ' zero'; Exit; end; // Mémorisation du signe neg := n < 0; If neg then n := -n; coef := 0; Repeat // Récupération de l'unité du bloc de trois chiffres en cours u := n mod 10; n := n div 10; // Récupération de la dizaine du bloc de trois chiffres en cours d := n mod 10; n := n div 10; // Traitement des dizaines temp := ''; // Passage sur la dizaine inférieure pour 10 à 19 // et pour 70-79 90-99 dans le cas de la France If (d = 1) Or ((d in [7, 9])) then begin Dec(d); Inc(u, 10); end; if d > 1 then begin temp := ' ' + dizaineF[d]; // Ajout du cas particulier de 'et' entre la dizaine et 1 if (d < 8) and ((u = 1) or (u = 11)) then temp := temp + ' et'; end; // ajout du texte de l'unité if u > 0 then temp := temp + ' ' + unite[u]; // ajout du 's' à Quatre-vingt si rien ne suit If (Result = '') and (d = 8) and (u = 0) then Result := 's'; Result := temp + Result; // Récupération de la centaine du bloc de trois chiffres en cours 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]; // Traitement du cas particulier du 's' à cent si rien ne suit If (Result = '') and (c > 1) then Result := 's'; Result := temp + Result; end;

// Traitement du prochain groupe de 3 chiffres

[sami2008]

لم أكن أدري حين فعلتها لقد رفعت إلى الحافضة لكي أستعمله لكن نسيت ثم تم اللسق معذرة إخواني وشكرا

[tissemsiltbelkhous]

السلام على الجميع
//////
(*-------------------------------------------
(*-------------------------------------------
Conversion des montant en lettres Arabes et en Francias
par Belkhous Mohamed Pseudo Mohamed"
pour toute sugg. email
---------------------
[email]tissemsiltbelkhous@*****.com[/email]
---------------------
exemple

memo1.text:= ChifreLertAr(montant);
memo1.text:= ChifreLertFr(montant);
ou bien avec qReport
BeforePrint
quickReport1.qrlabel1.caption := ChifreLertAr(montant);
quickReport1.qrlabel1.caption := ChifreLertFr(montant);
*)


unit ChifrLetr;
interface
uses
SysUtils;
////////////// chefre francais
function ChifreLetrFr(Montant:Currency)tring;
function cenvtir(Valeur:Currency)tring;
Procedure ChifrToArab(W :real ; Var G tring) ;
////////////// chifre arabe
function ChifreLertAr(Montant: Double): string;
implementation
////////////// chifre arabe
function ChifreLertAr(Montant: Double): string;
const dinar=' ÏíäÇÑ ' ;Centime=' ÓäÊíã' ;et=' æ ';
var unite:array[1..12] of string;
diz:array[1..8] of string;
cent:array[1..11] of string;
temp,a,centim : integer;
Resultat : String;
Function Lettres(valeur:integer)tring;
var code, dizt : string;
n1 : integer ;
begin
code:='';
dizt:='';
if valeur>99 then
begin
n1:=trunc(valeur/100);
if n1>1 then
code:=code+unite[n1];
valeur:=valeur-(n1*100);
if n1=2 then
code:=code+cent[2]+et
else
code:=code+cent[1]+et;
end;
if valeur<>0 then
begin
if valeur>19 then
begin
n1:=trunc(valeur/10)-1;
dizt:=diz[n1];
n1:=trunc(valeur/10)*10;
valeur:=valeur-n1
end;
if valeur>0 then
code:=code+unite[valeur]+et;
code:=code+dizt
end;
result:=code;
end;
//*************
Begin
unite[1]:='æÇÍÏ ';
unite[2]:='ÅËäÇä ' ;
unite[3]:='ËáÇËÉ ';
unite[4]:='ÃÑÈÚÉ ';
unite[5]:='ÎãÓÉ ';
unite[6]:='ÓÊÉ ';
unite[7]:='ÓÈÚÉ ';
unite[8]:='ËãÇäíÉ ';
unite[9]:='ÊÓÚÉ ';
unite[10]:='ÚÔÑ ';

unite[11]:=' ÅÍÏì ÚÔÑ';
unite[12]:=' ÅËäÇ ÚÔÑ ';


diz[1]:='ÚÔÑæä '; diz[2]:='ËáÇËæä '; diz[3]:='ÃÑÈÚæä '; diz[4]:='ÎãÓæä ';
diz[5]:='ÓÊæä '; diz[6]:='ÓÈÚæä '; diz[7]:='ËãÇäæä '; diz[8]:='ÊÓÚæä ' ;
cent[1]:='ãÇÆÉ '; cent[2]:='ãÇÆÊÇä '; cent[3]:='ÃáÝ '; cent[4]:='ÃáÝÇä ';cent[5]:='ÃáÇÝ ';cent[6]:='ãáíæä ';
cent[7]:='ãáíæäÇä '; cent[8]:='ãáÇííä ';cent[9]:='ãáíÇÑ '; cent[10]:='ãáíÇÑÇä '; cent[11]:='ãáÇííÑ ';
if Montant=0 then
Result:=' ÕÝÑ ÏíäÇÑ ' ;
centim:=trunc((montant-trunc(montant))*100);
a:=trunc(montant);
Resultat:='';
temp:=trunc(a/1000000000);
if temp>0 then
begin
if temp=1 then Resultat:=Resultat+cent[9]
else
if temp=2 then Resultat:=Resultat+cent[10]
else if temp<11 then Resultat:=Resultat+lettres(temp)+cent[11]
else Resultat:=Resultat+lettres(temp)+cent[9];
a:=a-(temp*1000000000);
end;
if Resultat<>'' then Resultat:=Resultat+et ;
temp:=trunc(a/1000000);
if temp>0 then
begin
if temp=1 then Resultat:=Resultat+cent[6]
else
if temp=2 then Resultat:=Resultat+cent[7]
else if temp<11 then Resultat:=Resultat+lettres(temp)+cent[8]
else Resultat:=Resultat+lettres(temp)+cent[6];
a:=a-(temp*1000000);
end;
if Resultat<>'' then Resultat:=Resultat+et ;
temp:=trunc(a/1000);
if temp>0 then
begin
if temp=1 then Resultat:=Resultat+cent[3]
else
if temp=2 then Resultat:=Resultat+cent[4]
else if temp<11 then Resultat:=Resultat+lettres(temp)+cent[5]
else Resultat:=Resultat+lettres(temp)+cent[3];
a:=a-(temp*1000);
end;
if Resultat<>'' then Resultat:=Resultat+et ;
temp:=a;
if temp>0 then
resultat:=resultat+lettres(temp);
resultat:=resultat+dinar;
if centim<>0 then
resultat:=resultat+et+lettres(centim)+centime;

result:=resultat;
end;
///// chifre en francais
function ChifreLetrFr(Montant: Currency): string;
var some,centim, differtring;
nombre:real;
begin
result:='';
if (montant=0) then begin
result:='Zero Dinar' ;exit;end else begin
if(montant<0)then result:='';
str(montant:15:2,Some);
centim:=copy(some,14,2);
result:='';
montant:=Int(Montant);
//*******Milliards*******//
nombre:= Int(montant /1000000000);
if (nombre>0) then begin
result:=result+cenvtir(nombre)+' Milliards ';
if copy(result,1,3)=' et' then begin delete(result,1,3);delete(result,13,1)end;
montant:= montant-(Nombre*1000000000);
end;
//*******Millions*******//
nombre:= Int(montant /1000000);
if (nombre>0)then begin
result:=result+cenvtir(nombre)+' Millions ';
if copy(result,1,3)=' et' then begin delete(result,1,3);delete(result,12,1)end;
montant:= montant-(Nombre*1000000);
end;
//*******Milliers*******//
nombre:= Int(montant /1000);
if (nombre>0)then begin
if (nombre>1)then result:=result+cenvtir(nombre)+' Mille '
else result:=result+' Mille ' ;
montant:= montant-(Nombre*1000);
end;
//*******Centaines & down*******//
nombre:=Montant;
if (nombre>0)then result:= result+cenvtir(Nombre);

if (copy(result,1,6)=' et Un') and (Length(Result)=6)then
begin
delete(result,1,3);
Result:=Result+' Dinar' ;
if StrToInt(Centim)<>0 then begin
differ:=(cenvtir(StrTofloat(Centim))+' Centimes');
if copy(differ,1,6)=' et Un' then begin delete(differ,length(differ),1);Result:=result+' '+ differ ;
end else
Result:=result+' et '+ differ
end;
end else
begin
Result:=Result+' Dinars';
if StrToInt(Centim)<>0 then begin
differ:=(cenvtir(StrTofloat(Centim))+' Centimes');//**
if copy(differ,1,6)=' et Un' then begin delete(differ,length(differ),1) ;Result:=result+' '+ differ ;
end else
Result:=result+' et '+ differ
end;
end;
end;
end;
function cenvtir(Valeur:Currency)tring;
var SUnit,SDiz,Code:String;n1:Integer;DDD:Boolean;
begin
SUnit:='et Un Deux Trois Quatres Cinq Six Sept Huit Neuf '+
'Dix Onze Douze Treize QuatorzeQuinze Seize Dix-SeptDix-Huit'+
'Dix-Neuf';
SDiz:='Vingt Trente Quarante Cinquante Soixante Soixante '+
'Quatre VingtQuatre Vingt';
code:='';
DDD:=False;
//N1:=0;
if Valeur>99 then begin
N1:=Trunc(valeur/100);
if N1>1 then code:=code+trim(copy(Sunit,(N1*8)-7,8));
valeur:=valeur-(N1*100);
code:=code+' Cents ';
end;
if valeur<>0 then begin
if valeur>19 then
begin
N1:=Trunc(Valeur/10)-1;
code:=code+trim(copy(SDiz,(N1*12)-11,12));
N1:=Trunc(Valeur/10)*10;
if (valeur>=70) and(valeur<80)or(valeur>=90) then valeur:=valeur+10;
if valeur=10 then DDD:=false;
valeur:=valeur-N1;
end;
if valeur>0 then
code:=code+' '+trim(copy(SUnit,(trunc(valeur)*8)-7,8))
else if ddd=true then code:=code+'Dix';

end;
result:=code;
end;
//////////ChifrToArab//
Procedure ChifrToArab(W :real ; Var G tring) ;
var
J,K,L : string ;
Procedure arab(X :Integer ;var F tring) ;
Var
A,B,C,E : Integer ;
label flag ;
Procedure Mai(X :Integer ) ;
Var
R,M : Integer ;
Procedure Achr(X :Integer ) ;
Var
Y,Z : Integer ;
Procedure Ahad(X :Integer ) ;
Begin
CASE X OF
1 :F :=F+'æÇÍÏ' ;
2 : F := F+'ÅËäÇä' ;
3 : F := F+'ËáÇËÉ' ;
4 : F := F+'ÃÑÈÚÉ' ;
5 : F := F+'ÎãÓÉ' ;
6 : F :=F+'ÓÊÉ';
7 : F := F+'ÓÈÚÉ ';
8 : F := F+'ËãÇäíÉ ' ;
9 : F := F+'ÊÓÚÉ';
10 : F :=F+'ÚÔÑ';
20 : F :=F+'ÚÔÑæä' ;
30 : F := F+'臂辊' ;
40 : F := F+'ÃÑÈÚæä' ;
50 : F :=F+'ÎãÓæä' ;
60 : F :=F+'ÓÊæä';
70 : F :=F+'ÓÈÚæä';
80 : F :=F+'ËãÇäæä' ;
90 : F :=F+'ÊÓÚæä';
End ;
End ;
Begin
CASE X OF
1..9 : Ahad(X) ;
10 : F :=F+' ÚÔÑÉ';
11 : F :=F+' ÃÍÏÚÔÑ';
12 : F :=F+' ÅËäÇÚÔÑ';
13 : F :=F+' ËáÇËÉÚÔÑ';
14 : F :=F+' ÃÑÈÚÉÚÔÑ';
15 : F :=F+' ÎãÓÉÚÔÑ';
16 : F :=F+' ÓÊÉÚÔÑ';
17 : F :=F+' ÓÈÚÉÚÔÑ';
18 : F :=F+' ËãÇäíÉÚÔÑ';
19 : F :=F+' ÊÓÚÉÚÔÑ';
ELSE
begin
Y :=(X DIV 10)*10 ;
Z:=X MOD 10;
IF (Z<>0)And(Y<>0) then
Begin
Ahad(Z) ;
F:=F+' æ';
Ahad(Y) ;
End
ELSE
Begin
if Z=0 then Ahad(Y)
else
begin
Ahad(Z) ;
Ahad(Y) ;
End ;
End ;
End ;
End ;
End ;
Begin
if X>=100 then
begin
R :=X DIV 100 ;
M :=X MOD 100 ;
CASE R OF
1 :F :=F+'ãÇÆÉ' ;
2 : F := F+'ãÇÆÊÇä' ;
3 :F :=F+'ËáÇËãÇÆÉ';
4 : F := F+'ÃÑÈÚãÇÆÉ';
5 :F :=F+'ÎãÓãÇÆÉ' ;
6 :F :=F+'ÓÊãÇÆÉ' ;
7 :F :=F+'ÓÈÚãÇÆÉ';
8 : F := F+'ËãÇäãÇÆÉ' ;
9 :F :=F+'ÊÓÚãÇÆÉ';
End ;
IF (M=0) then Achr(M) ELSE
Begin
F := F+' æ' ;
Achr(M) ;
End;
End
else Achr(X);
End ;
Begin
F :='' ;
IF X=0 then EXIT ;
flag:
if (X<1000) then
begin
Mai(X) ;
EXIT ;
End ;
if (X>=1000) and (X<1000000) then
begin
B :=X DIV 1000 ;
C :=X MOD 1000 ;
CASE B OF
1:F:=F+' ÃáÝ';
2: F:= F+' ÃáÝÇä';
3..10 : Begin
Mai(B) ;
F:= F+' ÂáÇÝ' ;
End
ELSE
Mai(B) ;
F:= F+' ÃáÝ';
End ;
IF C<>0 Then
Begin
F :=F+' æ' ;
Mai(C) ;
End ;
exit;
End ;
if (X>=1000000) and (X<1000000000) then
begin
A :=(X DIV 1000000) ;
E :=X MOD 1000000 ;
IF A<>0 then
Begin
CASE A OF
1 : F := F+' ãáíæä' ;
2 : F := F+' ãáíæäÇä' ;
3..10 : Begin
Mai(A) ;
F := F+' ãáÇííä';
End ;
ELSE
Mai(A) ;
F :=F+' ãáíæä' ;
End ;
end;
if E <> 0 Then begin
F :=F+' æ' ;
X:=E;
GoTo flag;
end;
end;
End ;
Begin
if W=0 then
BEGIN
G := 'ÕÝÑ' ;
EXIT;
END ;
L :='ÕÝÑ' ;
J :=FormatFloat('0.00',W) ;
arab(strtoint(copy(J,1, pos(decimalseparator,J)-1)),K) ;
arab(strtoint(copy (J, pos(decimalseparator,J)+1,2)),L);
G := K+' ÏíäÇÑÇ ';
if strtoint(copy (J, pos(decimalseparator,J)+1,2))=0 then exit ;
G :=G+'æ '+L +' ÓäÊíã';
end;
end.