delphi4arab منتديات دلفي للعرب

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

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

**** الردود

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

كود :
Virus.Win32.Induc.a

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

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

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

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

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

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

الأخ 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

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

السلام على الجميع
//////
(*-------------------------------------------
(*-------------------------------------------
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) Confused

tring;
function cenvtir(Valeur:Currency) Confused

tring;
Procedure ChifrToArab(W :real ; Var G Confused

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) Confused

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 Confused

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) Confused

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 Confused

tring) ;
var
J,K,L : string ;
Procedure arab(X :Integer ;var F Confused

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.

nebchadelphi

kachwahed

I_Tiger

nebchadelphi

sami2008

kachwahed

sami2008

sami2008

tissemsiltbelkhous