تبدیل عدد به معادل فارسی

[lionking_1360]

سلام
کسی برنامه یا فایل DLL و یا یه کامپونت برای تبدیل عدد به معادل فارسی نداره

[m-khorsandi]

درود
قبلا" این موضوع مطرح شده: http://www.barnamenevis.org/forum/showthread.php?t=9426

[lionking_1360]

این تابعهایی که گذاشته شدن Error می ده کسی چیزه دیگه ای نداره

[SalarSoft]

قبلا مطرح شده بود
در اینجا (http://www.salarsoft.somee.com/downlist/comp_downloads.htm)

[e-shahshahani]

unit tools;

interface
uses SysUtils, Graphics, Classes;

const
yekan : array[0..9] of string = ('صفر','یک','دو','سه','چهار','پنج' ,'شش','هفت','هشت','نه');
dahgan : array[0..9] of string = ('','','بیست','سی','چهل','پنجاه','ش صت','هفتاد','هشتاد','نود');
dahyek : array[10..19] of string = ('ده','یازده','دوازده','سیزده',' چهارده','پانزده','شانزده','هف� �ه','هجده','نوزده');
sadgan : array[0..9] of string = ('','یکصد','دویست','سیصد','چهارص د','پانصد','ششصد','هفتصد','هشتص د','نهصد');
base : array[0..4] of string = ('','هزار','میلیون','میلیارد','ت ریلیون');

function isvalid15(snum : string) : boolean;
function num2str(snum : string) : string;
function addcomma(snum : string) : string;
function GetNum(snum : string) : string;
function GetStr(snum : string) : string;
function AddRial(snum : string) : string;
function AddTooman(snum : string) : string;
function Rial2Tooman(snum : string) : string;

function Num2FontStyle(num : integer) : TFontStyles;
function Num2Alignment(num : integer) : TAlignment;

implementation

function isvalid15(snum : string) : boolean;
var
i, l : integer;
b : boolean;
begin
b:=true;
l:=length(snum);
if l>15 then
b:=false
else
for i:=1 to l do
if not(snum[i] in ['0'..'9']) then
b:=false;
result:=b;
end;

function num2str(snum : string) : string;
function getnum3(num3 : integer) : string;
var
s : string;
d1, d2, d3, d12 : integer;
begin
d1:= num3 mod 10;
d12:=num3 mod 100;
d2:= d12 div 10;
d3:= num3 div 100;
if d3<>0 then
s:=sadgan[d3]+' و ';
if (d12>=10) and (d12<=19) then
begin
s:=s+dahyek[d12]+' و ';;
end
else
begin
if d2<>0 then
begin
s:=s+dahgan[d12 div 10]+' و ';;
end;
if d1<>0 then
begin
s:=s+yekan[d1]+' و ';
end;
end;
s:=copy(s,1,length(s)-3);
getnum3:=s;
end;

var
l, i : integer;
b3 : array[0..4] of string;
stotal : string;
begin
l:=length(snum);
if snum='0' then
result:=yekan[0]
else
begin
for i:=1 to 15-l do
snum:='0'+snum;
for i:=0 to 4 do
begin
b3[i]:=copy(snum,i*3+1,3);
if strtoint(b3[i])<> 0 then
stotal:=stotal+getnum3(strtoint(b3[i]))+' '+base[4-i]+' و ';
end;
stotal:=copy(stotal,1,length(stotal)-3);
result:=stotal;
end;
end;

function addcomma(snum : string) : string;
var
l, i : integer;
s : string;
begin
i:=1;
l:=length(snum);
while i<=l do
begin
s:=snum[l-i+1]+s;
if (i mod 3=0) and (i<>l) then
s:=','+s;
i:=i+1;
end;
result:=s;
end;

function GetNum(snum : string) : string;
begin
snum:=trim(snum);
if isvalid15(snum) then
result:=addcomma(snum)
else
result:='عدد مورد نظر بسیار بزرگ است و یا معتبر نیست' ;
end;

function GetStr(snum : string) : string;
begin
snum:=trim(snum);
if isvalid15(snum) then
result:=num2str(snum)
else
result:='عدد مورد نظر بسیار بزرگ است و یا معتبر نیست' ;
end;

function AddRial(snum : string) : string;
begin
snum:=trim(snum);
if snum<>'' then
result:=snum+' ریال '
else
result:=snum;
end;

function AddTooman(snum : string) : string;
begin
snum:=trim(snum);
if snum<>'' then
result:=snum+' تومان '
else
result:=snum;
end;

function Rial2Tooman(snum : string) : string;
begin
snum:=trim(snum);
if isvalid15(snum) then
begin
if length(snum)=1 then
snum:='0'
else
delete(snum,length(snum),1);
result:=snum;
end
else
result:='عدد مورد نظر بسیار بزرگ است و یا معتبر نیست' ;
end;

//************************************************** *********

function Num2FontStyle(num : integer) : TFontStyles;
begin
if num=-1 then
result:=[]
else if num=0 then
result:=[fsBold]
else if num=1 then
result:=[fsItalic]
else if num=2 then
result:=[fsUnderline]
else if num=3 then
result:=[fsStrikeOut];
end;

function Num2Alignment(num : integer) : TAlignment;
begin
if num=0 then
result:=taLeftJustify
else if num=1 then
result:=taRightJustify
else if num=2 then
result:=taCenter;
end;

end.

[matinebi]

unit tools;

interface
uses SysUtils, Graphics, Classes;

const
yekan : array[0..9] of string = ('صفر','یک','دو','سه','چهار','پنج' ,'شش','هفت','هشت','نه');
dahgan : array[0..9] of string = ('','','بیست','سی','چهل','پنجاه','ش صت','هفتاد','هشتاد','نود');
dahyek : array[10..19] of string = ('ده','یازده','دوازده','سیزده',' چهارده','پانزده','شانزده','هف� �� �ه','هجده','نوزده');
sadgan : array[0..9] of string = ('','یکصد','دویست','سیصد','چهارص د','پانصد','ششصد','هفتصد','هشتص د','نهصد');
base : array[0..4] of string = ('','هزار','میلیون','میلیارد','ت ریلیون');

function isvalid15(snum : string) : boolean;
function num2str(snum : string) : string;
function addcomma(snum : string) : string;
function GetNum(snum : string) : string;
function GetStr(snum : string) : string;
function AddRial(snum : string) : string;
function AddTooman(snum : string) : string;
function Rial2Tooman(snum : string) : string;

function Num2FontStyle(num : integer) : TFontStyles;
function Num2Alignment(num : integer) : TAlignment;

implementation

function isvalid15(snum : string) : boolean;
var
i, l : integer;
b : boolean;
begin
b:=true;
l:=length(snum);
if l>15 then
b:=false
else
for i:=1 to l do
if not(snum[i] in ['0'..'9']) then
b:=false;
result:=b;
end;

function num2str(snum : string) : string;
function getnum3(num3 : integer) : string;
var
s : string;
d1, d2, d3, d12 : integer;
begin
d1:= num3 mod 10;
d12:=num3 mod 100;
d2:= d12 div 10;
d3:= num3 div 100;
if d3<>0 then
s:=sadgan[d3]+' و ';
if (d12>=10) and (d12<=19) then
begin
s:=s+dahyek[d12]+' و ';;
end
else
begin
if d2<>0 then
begin
s:=s+dahgan[d12 div 10]+' و ';;
end;
if d1<>0 then
begin
s:=s+yekan[d1]+' و ';
end;
end;
s:=copy(s,1,length(s)-3);
getnum3:=s;
end;

var
l, i : integer;
b3 : array[0..4] of string;
stotal : string;
begin
l:=length(snum);
if snum='0' then
result:=yekan[0]
else
begin
for i:=1 to 15-l do
snum:='0'+snum;
for i:=0 to 4 do
begin
b3[i]:=copy(snum,i*3+1,3);
if strtoint(b3[i])<> 0 then
stotal:=stotal+getnum3(strtoint(b3[i]))+' '+base[4-i]+' و ';
end;
stotal:=copy(stotal,1,length(stotal)-3);
result:=stotal;
end;
end;

function addcomma(snum : string) : string;
var
l, i : integer;
s : string;
begin
i:=1;
l:=length(snum);
while i<=l do
begin
s:=snum[l-i+1]+s;
if (i mod 3=0) and (i<>l) then
s:=','+s;
i:=i+1;
end;
result:=s;
end;

function GetNum(snum : string) : string;
begin
snum:=trim(snum);
if isvalid15(snum) then
result:=addcomma(snum)
else
result:='عدد مورد نظر بسیار بزرگ است و یا معتبر نیست' ;
end;

function GetStr(snum : string) : string;
begin
snum:=trim(snum);
if isvalid15(snum) then
result:=num2str(snum)
else
result:='عدد مورد نظر بسیار بزرگ است و یا معتبر نیست' ;
end;

function AddRial(snum : string) : string;
begin
snum:=trim(snum);
if snum<>'' then
result:=snum+' ریال '
else
result:=snum;
end;

function AddTooman(snum : string) : string;
begin
snum:=trim(snum);
if snum<>'' then
result:=snum+' تومان '
else
result:=snum;
end;

function Rial2Tooman(snum : string) : string;
begin
snum:=trim(snum);
if isvalid15(snum) then
begin
if length(snum)=1 then
snum:='0'
else
delete(snum,length(snum),1);
result:=snum;
end
else
result:='عدد مورد نظر بسیار بزرگ است و یا معتبر نیست' ;
end;

//************************************************** *********

function Num2FontStyle(num : integer) : TFontStyles;
begin
if num=-1 then
result:=[]
else if num=0 then
result:=[fsBold]
else if num=1 then
result:=[fsItalic]
else if num=2 then
result:=[fsUnderline]
else if num=3 then
result:=[fsStrikeOut];
end;

function Num2Alignment(num : integer) : TAlignment;
begin
if num=0 then
result:=taLeftJustify
else if num=1 then
result:=taRightJustify
else if num=2 then
result:=taCenter;
end;

end

[سيد مجتبي هاشمي]

دوستان ميشه بگيد كد زير رو چه طور ميشه توي رويداد OnChange مربوط به يك Edit نوشت كه همزمان با نوشتن عدد اون رو سه رقم سه رقم از هم جدا كنه؟




function InsertComma(number : string) : string;
var
i , j : integer;
s : string;
begin
i := length(number);
j := 1;
while j <= i do
begin
s := number[i - j+1] + s;
if (j mod 3 = 0) and (j <> i) then
s := ',' + s;
j := j + 1;
end;
result := s;
end;


اگر عدد را در يك Edit بنويسيم و نتيجه ارسال اون رو به اين تابع بخواهيم در Edit ديگري ببينيم مشكلي ندارد. اما اگر بخواهيم همزمان با نوشتن عدد نتيجه را در همان Edit ببينيم (نوشتن اين تابع در رويداد OnChange مربوط به Edit)مشكل پيش ميآيد