+- delphi4arab منتديات دلفي للعرب (https://delphi4arab.net/forum)
+-- قسم : منتديات دلفي الأخرى (https://delphi4arab.net/forum/forumdisplay.php?fid=4)
+--- قسم : برامج دلفي من عمل الأعضاء (https://delphi4arab.net/forum/forumdisplay.php?fid=27)
+--- الموضوع : برنامج تحويل الاعداد- عربي فرنسي- (/showthread.php?tid=1429)
برنامج تحويل الاعداد- عربي فرنسي- - nebchadelphi - 23-12-2009
السلام عليكم
اليوم اضع برنامج تحويل الأعداد إلى حروف
هذا الاصدار الثاني يدعم كل من اللغة العربية والفرنسية
**** أن ينال إعجابكم
و**** من من لديه أية تعليقات أو إقتراحات أن يكتبها من أجل التحسين
وشكرا
معطرة الرابط هو
وشكرا
اليوم اضع برنامج تحويل الأعداد إلى حروف
هذا الاصدار الثاني يدعم كل من اللغة العربية والفرنسية
**** أن ينال إعجابكم
و**** من من لديه أية تعليقات أو إقتراحات أن يكتبها من أجل التحسين
وشكرا
معطرة الرابط هو
وشكرا
**** الردود
برنامج تحويل الاعداد- عربي فرنسي- - kachwahed - 23-12-2009
عمل رائع أخي nebchadelphi وبرنامج جميل.
فقط إحذر فقد يكون جهازك ملوث، تقرير Kaspersky يقول:
كود :
Virus.Win32.Induc.aتم تنظيف المرفق، بالتوفيق.
برنامج تحويل الاعداد- عربي فرنسي- - I_Tiger - 23-12-2009
برنامج جميل و فكرة اجمل ، فاحيانا قد يمتلك المبرمج عضلات برمجية دون منتوج يذكر.
لكن الفكرة المفيدة مهما كانة بسيطة تعطي قيمة للمنتوج.
واصل بارك الله فيك.
برنامج تحويل الاعداد- عربي فرنسي- - nebchadelphi - 24-12-2009
السلام عليكم
أشكركم اخوتي جميعكم
وانا في انتظار أي اقتراحات أو انتقادات
انا الآن في صدد اضافة اللغة الانجليزية
والسلام
برنامج تحويل الاعداد- عربي فرنسي- - sami2008 - 17-04-2010
شيء جمبل وبرنامج جميل أين الكود يأخي وإن كنت تبحث على الكود والمصدر أعطيك عنوان delphi fr.com الكود موجود بالعربية وبالفرنسية السلام عليكم
برنامج تحويل الاعداد- عربي فرنسي- - kachwahed - 17-04-2010
الأخ sami2008 مرحبا بك في المنتدى
في قسم "برامج من عمل الأعضاء" لا تطرح الملفات المصدرية (الكود سورس)
راجع: مرحبا بك في منتدى دلفي للعرب
برنامج تحويل الاعداد- عربي فرنسي- - sami2008 - 17-04-2010
كود :
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 - 17-04-2010
لم أكن أدري حين فعلتها لقد رفعت إلى الحافضة لكي أستعمله لكن نسيت ثم تم اللسق معذرة إخواني وشكرا
برنامج تحويل الاعداد- عربي فرنسي- - tissemsiltbelkhous - 06-06-2013
السلام على الجميع
//////
(*-------------------------------------------
(*-------------------------------------------
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, differ
tring;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.