+- delphi4arab منتديات دلفي للعرب (https://delphi4arab.net/forum)
+-- قسم : منتديات دلفي للعرب التعليمية (https://delphi4arab.net/forum/forumdisplay.php?fid=3)
+--- قسم : سؤال و جواب حول دلفي (https://delphi4arab.net/forum/forumdisplay.php?fid=15)
+--- الموضوع : تفقيط مجموع ناتج عن نسب مؤوية (/showthread.php?tid=2273)
تفقيط مجموع ناتج عن نسب مؤوية - medreg - 07-08-2010
وهو ربما يقع فيه بعد الأعضاء
لدي مشكلة في التفقيط
عندما يكون المجموع ناتج عن نسب مؤية
ولنفرض ان المجموع هو 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]:='æÇÍÏ';
Unite[2]:='ÅÊäÇä';
Unite[3]:='ËáÇÊÉ';
Unite[4]:='ÃÑÈÚÉ';
Unite[5]:='ÎãÓÉ';
Unite[6]:='ÓÊÉ';
Unite[7]:='ÓÈÚÉ';
Unite[8]:='ËãÇäíÉ';
Unite[9]:='ÊÓÚÉ';
Dizaine[1]:='ÅÍÏì ÚÔÑÉ';
Dizaine[2]:='ÅÊäÇ ÚÔÑÉ';
Dizaine[3]:='ËáÇÊÉ ÚÔÑÉ';
Dizaine[4]:='ÃÑÈÚÉ ÚÔÑÉ';
Dizaine[5]:='ÎãÓÉ ÚÔÑÉ';
Dizaine[6]:='ÓÊÉ ÚÔÑÉ';
Dizaine[7]:='ÓÈÚÉ ÚÔÑÉ';
Dizaine[8]:='ËãÇäíÉ ÚÔÑ';
Dizaine[9]:='ÊÓÚÉ ÚÔÑÉ';
Cent[1]:='ãÇÆÉ';
Cent[2]:='ãÇÆÊÇä';
Cent[3]:='ËáÇÊãÇÆÉ';
Cent[4]:='ÃÑÈÚãÇÆÉ';
Cent[5]:='ÎãÓãÇÆÉ';
Cent[6]:='ÓÊãÇÆÉ';
Cent[7]:='ÓÈÚãÇÆÉ';
Cent[8]:='ËãÇäãÇÆÉ';
Cent[9]:='ÊÓÚãÇÆÉ';
Cent[10]:='ÚÔÑãÇÆÉ';
for i:=1 to 9 do TAB[i]:=UNITE[i];
TAB[10]:='ÚÔÑÉ';
for i:=1 to 9 do TAB[i+10]:=DIZAINE[i];
TAB[20]:='ÚÔÑæä';
for i:=1 to 9 do TAB[i+20]:=UNITE[i]+' æ '+TAB[20];
TAB[30]:='臂澊';
for i:=1 to 9 do TAB[i+30]:=UNITE[i]+' æ '+TAB[30];
TAB[40]:='ÃÑÈÚæä';
for i:=1 to 9 do TAB[i+40]:=UNITE[i]+' æ '+TAB[40];
TAB[50]:='ÎãÓæä';
for i:=1 to 9 do TAB[i+50]:=UNITE[i]+' æ '+TAB[50];
TAB[60]:='ÓÊæä';
for i:=1 to 9 do TAB[i+60]:=UNITE[i]+' æ '+TAB[60];
TAB[70]:='ÓÈÚæä';
for i:=1 to 9 do TAB[i+70]:=UNITE[i]+' æ '+TAB[70];
TAB[80]:='ËãÇäæä';
for i:=1 to 9 do TAB[i+80]:=UNITE[i]+' æ '+TAB[80];
TAB[90]:='ÊÓÚæä';
for i:=1 to 9 do TAB[i+90]:=UNITE[i]+' æ '+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:='æÇÍÏ ÓäÊíã ';
if(CTS = 2) then Lb_CTS:=' ÓäÊíãÇä ';
if(CTS>= 3)and(CTS<=99) then Lb_CTS:=Tab[CTS]+' ÓäÊíã ';
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:=' ÃáÝ ';
if(Dr2= 2) then Lb_Dr2:=' ÃáÝÇä ';
if(Dr2>= 3)and(Dr2<= 9) then Lb_Dr2:=Groupe(Dr2,TAB,Cent)+' ÃáÂÝ ';
if(Dr2>=10)and(Dr2<=999) then Lb_Dr2:=Groupe(Dr2,TAB,Cent)+' ÃáÝ ';
if(Dr1>0) then Lb_Dr2:=Lb_Dr2+' æ ';
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:=' ãáíæä ';
if(Dr3= 2) then Lb_Dr3:=' ãáíæäíä ';
if(Dr3>= 3)and(Dr3<= 9) then Lb_Dr3:=Groupe(Dr3,TAB,Cent)+' ãáÇííä ';
if(Dr3>=10)and(Dr3<=999) then Lb_Dr3:=Groupe(Dr3,TAB,Cent)+' ãáíæä ';
if(Dr2>0) then Lb_Dr3:=Lb_Dr3+' æ ';
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+'ãáíÇÑ'
else Lb_Dr4:=Lb_Dr4+' ãáÇííÑ';
if(Dr3>0) then Lb_Dr4:=Lb_Dr4+' æ ';
end;
Lb_Dr4:=Lb_Dr4+' ';
R:=Lb_Dr4+Lb_Dr3+Lb_Dr2+Lb_Dr1;
if Dr=1 then R:=R+'ÏíäÇÑ ÌÒÇÆÑí ';
if Dr=2 then R:=R+' ÏíäÇÑÇä';
if (Dr>=3)and(Dr<=10) then R:=R+'ÏíäÇÑ ÌÒÇÆÑí '
else R:=R+'ÏíäÇÑ ÌÒÇÆÑí';
if CTS>0 then R:=R+' æ ';
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+' æ '+Tab[d]
else R:=Tab[d];
end;
R:=R+' ';
Result:=R;
end;
end.تفقيط مجموع ناتج عن نسب مؤوية - kachwahed - 07-08-2010
السلام عليكم
الخوارزمية صحيحة، الخلل ليس فيها
الخلل في تدوير العدد...
استخدم Round/Trunc لتفادي الخلل
ينظر:
http://www.delphi4arab.net/forum/showthread.php?tid=3246
http://www.delphi4arab.net/forum/showthread.php?tid=2336
للتفقيط ينظر:
http://www.delphi4arab.net/forum/showthread.php?tid=2360
http://www.delphi4arab.net/forum/showthread.php?tid=299
http://www.delphi4arab.net/forum/showthread.php?tid=1450
بالتوفيق.
تفقيط مجموع ناتج عن نسب مؤوية - Lam.Abdeldjalil - 07-08-2010
السلام عليكم
جربته ويعمل جيدا مثال في المرفق
تأكد من : عند إستعمال الدالة
كود :
Traduit_Lettre(strtoint(edit1.Text ));أو كما قال الأستاذ kachwahed الخلل في تدوير العدد
يوجد برنامج للأخ مهدي بارك الله فيه
برنامج تفقيط لتحويل الأرقام إلى حروف عربية 'مجرب'
http://www.delphi4arab.net/forum/showpost.php?p=1507&postcount=1
بالتوفيق
تفقيط مجموع ناتج عن نسب مؤوية - medreg - 07-08-2010
اين اضع round او Trunc
هل اضعه عند التفقيط ام اثنا العملية الحسابية
وكيف ذلك