المساعد الشخصي الرقمي

مشاهدة النسخة كاملة : تفقيط مجموع ناتج عن نسب مؤوية


medreg
07-08-2010, 03:11 PM
وهو ربما يقع فيه بعد الأعضاء
لدي مشكلة في التفقيط
عندما يكون المجموع ناتج عن نسب مؤية
ولنفرض ان المجموع هو 33.254,25 سنتيم
يظهر لي في التفقيط
هكذا
انظر جيدًا
ثلاثة وثلاثون ألف ومائتان وأربعة وخمسون دينار وأربعة وعشرون سنتيم
بدلا من و '' خمسة وعشرون سنتيم''
ولبيس في كل الحالات إلا في بعض الحالات
كيف يمكن معالجته
وجزاكم الله عنا كل خير

وهذا هو الكود الذي استعمله

unit UMT_EnLettre;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, DBCtrls, Spin, Mask, Grids, DBGrids,DB;
Type
Table=array[1..99] of string;
TCent=array[1..10] of string;

function Min(x,y:Real):Real;
function Max(x,y:Real):Real;
function iMin(x,y:Integer):Integer;
function iMax(x,y:Integer):Integer;

function aRound(x:Real;n:Integer):Real;
function aTrunc(x:Real;n:Integer):Real;
function RealToInt(x:Real):Integer;
function ItoC(i:Integer):String;
function Traduit_Lettre(NBRE:Real):String;
function Groupe(t:Integer;TAB:Table;Cent:TCent):String;

implementation

function Min(x,y:Real):Real;begin if x>y then Result:=y else Result:=x;end;
function Max(x,y:Real):Real;begin if x>y then Result:=x else Result:=y;end;

function iMax(x,y:Integer):Integer;begin if x>y then Result:=x else Result:=y;end;
function iMin(x,y:Integer):Integer;begin if x>y then Result:=y else Result:=x;end;

function aRound(x:Real;n:Integer):Real;
var p,j:integer;
positive:boolean;

function Rounder(d:Real):Real;
var R :Real;
begin
d:=Abs(d);
if Frac(d)<0.5 then R:=Int(d)
else R:=Int(d)+1;
Result:=R;
end;
begin
if n>=0 then positive:=true else positive:=false;
n:=abs(n);
p:=1;for j:= 1 to n do p:=p*10;
if positive then Result:=Rounder(x*p)/p
else Result:=Rounder(x/p)*p;
end;

function aTrunc(x:Real;n:Integer):Real;
var p,j:integer;
positive:boolean;
function Entier(x:Real):Real;
begin
Result:=x-Frac(x);
end;
begin
if n>0 then positive:=true else positive:=false;
n:=abs(n);
p:=1; for j:= 1 to n do p:=p*10;
if Positive then Result:=Entier(x*p)/p
else Result:=Entier(x/p)*p;
end;

function RealToInt(x:Real):Integer;
begin
Result:=StrToInt(FloatToStr(aTrunc(x,0)));
end;

function ItoC(i:Integer):String;
var c:string;
begin
if (i>=0)and(i<=9) then begin
str(i:1,c);
c:='0'+c
end else c:=IntToStr(i);
Result:=c;
end;
{************************************************* ****************************
* Procedure :Convertion en lettres d'un montant ecrit en chiffres *
************************************************** ****************************}
function Traduit_Lettre(NBRE:Real):String;
var CTS, Dr :Integer;
Lb_CTS, Lb_Dr1, Lb_Dr2, Lb_Dr3, Lb_Dr4 :String;
Dr1,Dr2,Dr3,Dr4:integer;

Unite :Array[1..9] of string;
Dizaine:Array[1..9] of string;
Cent :TCent;
TAB:Table;
R:String;
i:Integer;

cNombre :String;
cDinars :String;
cCentimes:String;
n,p:Integer;
PointDecimal:String;
Begin
Unite[1]:='&aelig;&Ccedil;&Iacute;&Iuml;';
Unite[2]:='&Aring;&Ecirc;&auml;&Ccedil;&auml;';
Unite[3]:='&Euml;&aacute;&Ccedil;&Ecirc;&Eacute;';
Unite[4]:='&Atilde;&Ntilde;&Egrave;&Uacute;&Eacute;';
Unite[5]:='&Icirc;&atilde;&Oacute;&Eacute;';
Unite[6]:='&Oacute;&Ecirc;&Eacute;';
Unite[7]:='&Oacute;&Egrave;&Uacute;&Eacute;';
Unite[8]:='&Euml;&atilde;&Ccedil;&auml;&iacute;&Eacute;';
Unite[9]:='&Ecirc;&Oacute;&Uacute;&Eacute;';

Dizaine[1]:='&Aring;&Iacute;&Iuml;&igrave; &Uacute;&Ocirc;&Ntilde;&Eacute;';
Dizaine[2]:='&Aring;&Ecirc;&auml;&Ccedil; &Uacute;&Ocirc;&Ntilde;&Eacute;';
Dizaine[3]:='&Euml;&aacute;&Ccedil;&Ecirc;&Eacute; &Uacute;&Ocirc;&Ntilde;&Eacute;';
Dizaine[4]:='&Atilde;&Ntilde;&Egrave;&Uacute;&Eacute; &Uacute;&Ocirc;&Ntilde;&Eacute;';
Dizaine[5]:='&Icirc;&atilde;&Oacute;&Eacute; &Uacute;&Ocirc;&Ntilde;&Eacute;';
Dizaine[6]:='&Oacute;&Ecirc;&Eacute; &Uacute;&Ocirc;&Ntilde;&Eacute;';
Dizaine[7]:='&Oacute;&Egrave;&Uacute;&Eacute; &Uacute;&Ocirc;&Ntilde;&Eacute;';
Dizaine[8]:='&Euml;&atilde;&Ccedil;&auml;&iacute;&Eacute; &Uacute;&Ocirc;&Ntilde;';
Dizaine[9]:='&Ecirc;&Oacute;&Uacute;&Eacute; &Uacute;&Ocirc;&Ntilde;&Eacute;';

Cent[1]:='&atilde;&Ccedil;&AElig;&Eacute;';
Cent[2]:='&atilde;&Ccedil;&AElig;&Ecirc;&Ccedil;&auml;';
Cent[3]:='&Euml;&aacute;&Ccedil;&Ecirc;&atilde;&Ccedil;&AElig;&Eacute;';
Cent[4]:='&Atilde;&Ntilde;&Egrave;&Uacute;&atilde;&Ccedil;&AElig;&Eacute;';
Cent[5]:='&Icirc;&atilde;&Oacute;&atilde;&Ccedil;&AElig;&Eacute;';
Cent[6]:='&Oacute;&Ecirc;&atilde;&Ccedil;&AElig;&Eacute;';
Cent[7]:='&Oacute;&Egrave;&Uacute;&atilde;&Ccedil;&AElig;&Eacute;';
Cent[8]:='&Euml;&atilde;&Ccedil;&auml;&atilde;&Ccedil;&AElig;&Eacute;';
Cent[9]:='&Ecirc;&Oacute;&Uacute;&atilde;&Ccedil;&AElig;&Eacute;';
Cent[10]:='&Uacute;&Ocirc;&Ntilde;&atilde;&Ccedil;&AElig;&Eacute;';

for i:=1 to 9 do TAB[i]:=UNITE[i];

TAB[10]:='&Uacute;&Ocirc;&Ntilde;&Eacute;';
for i:=1 to 9 do TAB[i+10]:=DIZAINE[i];

TAB[20]:='&Uacute;&Ocirc;&Ntilde;&aelig;&auml;';
for i:=1 to 9 do TAB[i+20]:=UNITE[i]+' &aelig; '+TAB[20];

TAB[30]:='&Euml;&aacute;&Ccedil;&Ecirc;&aelig;&auml;';
for i:=1 to 9 do TAB[i+30]:=UNITE[i]+' &aelig; '+TAB[30];

TAB[40]:='&Atilde;&Ntilde;&Egrave;&Uacute;&aelig;&auml;';
for i:=1 to 9 do TAB[i+40]:=UNITE[i]+' &aelig; '+TAB[40];

TAB[50]:='&Icirc;&atilde;&Oacute;&aelig;&auml;';
for i:=1 to 9 do TAB[i+50]:=UNITE[i]+' &aelig; '+TAB[50];

TAB[60]:='&Oacute;&Ecirc;&aelig;&auml;';
for i:=1 to 9 do TAB[i+60]:=UNITE[i]+' &aelig; '+TAB[60];

TAB[70]:='&Oacute;&Egrave;&Uacute;&aelig;&auml;';
for i:=1 to 9 do TAB[i+70]:=UNITE[i]+' &aelig; '+TAB[70];

TAB[80]:='&Euml;&atilde;&Ccedil;&auml;&aelig;&auml;';
for i:=1 to 9 do TAB[i+80]:=UNITE[i]+' &aelig; '+TAB[80];

TAB[90]:='&Ecirc;&Oacute;&Uacute;&aelig;&auml;';
for i:=1 to 9 do TAB[i+90]:=UNITE[i]+' &aelig; '+TAB[90];

NBRE:=ABS(NBRE);

if (NBRE >= 10000000000000)or(NBRE <= 0) then begin
Result:='';
exit;
end;

cNombre :=Trim(FloatToStr(NBRE));

PointDecimal:=DecimalSeparator;

p:=Pos(PointDecimal,cNombre);
n:=Length(cNombre);

if (p=0) then cNombre:=cNombre+PointDecimal+'00'
else if ((p+1)=n) then cNombre:=cNombre+'0';

n:=Length(cNombre);
p:=Pos(PointDecimal,cNombre);

cDinars :=Copy(cNombre, 1,p-1);
cCentimes:=Copy(cNombre,p+1, 2);

Dr:=StrToInt(cDinars);
CTS:=StrToInt(cCentimes);

if(CTS = 0) then Lb_CTS:='';
if(CTS = 1) then Lb_CTS:='&aelig;&Ccedil;&Iacute;&Iuml; &Oacute;&auml;&Ecirc;&iacute;&atilde; ';
if(CTS = 2) then Lb_CTS:=' &Oacute;&auml;&Ecirc;&iacute;&atilde;&Ccedil;&auml; ';
if(CTS>= 3)and(CTS<=99) then Lb_CTS:=Tab[CTS]+' &Oacute;&auml;&Ecirc;&iacute;&atilde; ';

if Dr=0 then begin
R:=Lb_CTS;
Result:=R;
Exit;
end;

Dr1 := Trunc(INT(Dr/1)) MOD 1000 ;
if Dr1>0 then Lb_Dr1 := Groupe(Dr1,TAB,Cent)+' '
else Lb_Dr1 := '';

Dr := Dr-Dr1;
Dr2 := Trunc(INT(Dr/1000)) Mod 1000;

Lb_Dr2 := '';
if Dr2>0 then begin
if(Dr2= 1) then Lb_Dr2:=' &Atilde;&aacute;&Yacute; ';
if(Dr2= 2) then Lb_Dr2:=' &Atilde;&aacute;&Yacute;&Ccedil;&auml; ';
if(Dr2>= 3)and(Dr2<= 9) then Lb_Dr2:=Groupe(Dr2,TAB,Cent)+' &Atilde;&aacute;&Acirc;&Yacute; ';
if(Dr2>=10)and(Dr2<=999) then Lb_Dr2:=Groupe(Dr2,TAB,Cent)+' &Atilde;&aacute;&Yacute; ';

if(Dr1>0) then Lb_Dr2:=Lb_Dr2+' &aelig; ';
end;
Lb_Dr2:=Lb_Dr2+' ';

Dr := Dr-Dr2;
Dr3:= Trunc(INT(Dr/1000000)) Mod 1000;
Lb_Dr3:= '';
if Dr3>0 then begin

if(Dr3= 1) then Lb_Dr3:=' &atilde;&aacute;&iacute;&aelig;&auml; ';
if(Dr3= 2) then Lb_Dr3:=' &atilde;&aacute;&iacute;&aelig;&auml;&iacute;&auml; ';
if(Dr3>= 3)and(Dr3<= 9) then Lb_Dr3:=Groupe(Dr3,TAB,Cent)+' &atilde;&aacute;&Ccedil;&iacute;&iacute;&auml; ';
if(Dr3>=10)and(Dr3<=999) then Lb_Dr3:=Groupe(Dr3,TAB,Cent)+' &atilde;&aacute;&iacute;&aelig;&auml; ';

if(Dr2>0) then Lb_Dr3:=Lb_Dr3+' &aelig; ';
end;
Lb_Dr3:=Lb_Dr3+' ';

Dr := Dr-Dr3;
Dr4:= Trunc(INT(Dr/1000000000)) Mod 1000;
Lb_Dr4:= '';
if Dr4>0 then begin
if Dr4=1 then Lb_Dr4:=''
else Lb_Dr4:=Groupe(Dr4,TAB,Cent)+' ';

if(Dr4=1) then Lb_Dr4:=Lb_Dr4+'&atilde;&aacute;&iacute;&Ccedil;&Ntilde;'
else Lb_Dr4:=Lb_Dr4+' &atilde;&aacute;&Ccedil;&iacute;&iacute;&Ntilde;';

if(Dr3>0) then Lb_Dr4:=Lb_Dr4+' &aelig; ';

end;
Lb_Dr4:=Lb_Dr4+' ';

R:=Lb_Dr4+Lb_Dr3+Lb_Dr2+Lb_Dr1;
if Dr=1 then R:=R+'&Iuml;&iacute;&auml;&Ccedil;&Ntilde; &Igrave;&Ograve;&Ccedil;&AElig;&Ntilde;&iacute; ';
if Dr=2 then R:=R+' &Iuml;&iacute;&auml;&Ccedil;&Ntilde;&Ccedil;&auml;';
if (Dr>=3)and(Dr<=10) then R:=R+'&Iuml;&iacute;&auml;&Ccedil;&Ntilde; &Igrave;&Ograve;&Ccedil;&AElig;&Ntilde;&iacute; '
else R:=R+'&Iuml;&iacute;&auml;&Ccedil;&Ntilde; &Igrave;&Ograve;&Ccedil;&AElig;&Ntilde;&iacute;';

if CTS>0 then R:=R+' &aelig; ';

R:=R+Lb_CTS;
R:=Trim(R);

Result:=R;
end;
{************************************************* *****************************
* Convertion d'un nombre de 3 chiffres en lettres
************************************************** ****************************}
function Groupe(t:Integer;TAB:Table;Cent:TCent):String;
var u, d :Integer;
R:String;
begin

if t<=0 then begin
Result:='';
exit;
end;

u := Trunc(INT(t/100));
d := Trunc(Int(aRound(Frac(t/100)*100, 2)));

R:='';

if u>=1 then R:=Cent[u];

if not(d=0)then begin
if not(u=0) then R:=R+' &aelig; '+Tab[d]
else R:=Tab[d];
end;
R:=R+' ';
Result:=R;
end;

end.

kachwahed
07-08-2010, 03:50 PM
السلام عليكم
الخوارزمية صحيحة، الخلل ليس فيها
الخلل في تدوير العدد...
استخدم Round/Trunc لتفادي الخلل
ينظر:
http://www.delphi4arab.com/forum/showthread.php?t=3246
http://www.delphi4arab.com/forum/showthread.php?t=2336
للتفقيط ينظر:
http://www.delphi4arab.com/forum/showthread.php?t=2360
http://www.delphi4arab.com/forum/showthread.php?t=299
http://www.delphi4arab.com/forum/showthread.php?t=1450
بالتوفيق.

Lam.Abdeldjalil
07-08-2010, 03:58 PM
السلام عليكم

جربته ويعمل جيدا مثال في المرفق

تأكد من : عند إستعمال الدالة
Traduit_Lettre(strtoint(edit1.Text ));أنك تبعث المجموع و ليس عدد آخر
أو كما قال الأستاذ kachwahed الخلل في تدوير العدد

يوجد برنامج للأخ مهدي (http://www.delphi4arab.com/forum/member.php?u=122)بارك الله فيه
برنامج تفقيط لتحويل الأرقام إلى حروف عربية 'مجرب'
http://www.delphi4arab.com/forum/showpost.php?p=1507&postcount=1

بالتوفيق

medreg
07-08-2010, 05:00 PM
اين اضع round او Trunc
هل اضعه عند التفقيط ام اثنا العملية الحسابية
وكيف ذلك