PDA

View Full Version : تبدیل عدد به حروف



reza_66
شنبه 24 تیر 1391, 21:12 عصر
سلام به همه دوستان

من می خواستم بدونم چگونه میشه در زبان دلفی اعداد رو به حروف تبدیل کرد؟ البته خیلی جستجوکردم در مبناها و زبانهای مختلف هست ولی در دلفی چیزی ندیدم.

بهترین و ساده ترین و کاملترین و کوتاه ترین راه چه راهی می باشد؟استفاده از کامپوننت یا dll یا.... و یا دستور

خاصی وجود دارد؟

ممنون از دوستان عزیز

بهروز عباسی
شنبه 24 تیر 1391, 21:35 عصر
درود اگه درست متوجه شده باشم
این لینک ها رو ببین:
http://delphi.about.com/od/objectpascalide/a/curr2words.htm
http://www.delphipages.com/forum/showthread.php?t=33856
در غیر این صورت شرمنده (الان وقت ندارم)

موفق باشید

SayeyeZohor
شنبه 24 تیر 1391, 21:36 عصر
Function TMainForm.Number2Str;
const
Main: array[1..3,0..9]of string = (('', 'يكصد و', 'دويست و', 'سيصد و', 'چهارصد و', 'پانصد و', 'ششصد و', 'هفتصد و', 'هشتصد و', 'نهصد و'),
('', '', 'بيست و', 'سي و', 'چهل و', 'پنجاه و', 'شصت و', 'هفتاد و', 'هشتاد و', 'نود و'),
('', 'يك', 'دوو', 'سه', 'چهار', 'پنج', 'شش', 'هفت', 'هشت', 'نه'));
NPos: array[1..4]of string = ('ميليارد و', 'ميليون و', 'هزار و', '');
_10_19: array[10..19]of string = ('ده', 'يازده', 'دوازده', 'سيزده', 'چهارده', 'پانزده', 'شانزده', 'هفده', 'هجده', 'نوزده');

var
TMP2, TMP: string;
Cntr2, Cntr: Integer;
begin
case Length(Nm) mod 3 of
1: TMP := '00';
2: TMP := '0';
end;
Nm := TMP + Nm;
TMP := '';
if Length(Nm) <=3 then
begin
for Cntr := 1 to 3 do
if (Cntr = 2) and (Nm[Cntr] = '1') then
begin
TMP := TMP + _10_19[StrToInt(Copy(Nm, 2, 2))] + ' ';
Break;
end
else
TMP := TMP + Main[Cntr, StrToInt(Nm[Cntr])] + ' ';
TMP := Trim(TMP);
Cntr := Length(TMP);
if TMP <> '' then
if TMP[Cntr] = 'و' then
Delete(TMP, Cntr, 1);
Result := TMP + ' ';
Exit;
end;
Cntr2 := 0;
for Cntr := (4 - (Length(Nm) div 3)) + 1 to 4 do
begin
TMP2 := Number2Str(Copy(Nm, (Cntr2 * 3) + 1, 3));
if Trim(TMP2) <> '' then
TMP := TMP + TMP2 + NPos[Cntr] + ' ';
Inc(Cntr2);
end;
TMP := Trim(TMP);
Cntr := Length(TMP);

{----This command fix it----}
If not (Nm[length(NM)]='2') then
{--This command remove the و from end of the number that has دو! this is mistake--}
if TMP <> '' then
if TMP[Cntr] = 'و' then
Delete(TMP, Cntr, 1);
Result := TMP;
end;

SayeyeZohor
شنبه 24 تیر 1391, 21:38 عصر
unit num2char;

interface
uses SysUtils;

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 AddComma(snum : string) : string;
function GetStr(snum : string) : string;

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
d12 := num3 mod 100; // دو رقم اول
d3 := num3 div 100; // صدگان
if d3 <> 0 then
s := sadgan[d3] + ' و ';
// نام گذاري اعداد 10 تا 19 در بين
// اعداد دو رقمي استثنا است
if (d12 >= 10) and (d12 <= 19) then
begin
s := s + dahyek[d12];
end
else
begin
d2 := d12 div 10; // دهگان
if d2 <> 0 then
s := s + dahgan[d2] + ' و ';
d1 := d12 mod 10; // يکان
if d1 <> 0 then
s := s + yekan[d1] + ' و ';
// حذف حرف <و> اضافي
s := copy(s, 1, length(s) - 3);
end;
getnum3 := s;
end;

var
L, i, b : integer;
stotal : string;
begin
// اگر عدد صفر بود، يکراست نتيجه را برگردان
if snum = '0' then
result := yekan[0]
else
begin
// براي اينکه بتوان عدد را به قسمت هاي سه رقمي تقسيم کرد
// به سمت چپ عدد، به اندازه کافي صفر مي افزاييم
for i := Length(snum) to ((Length(snum) - 1) div 3 + 1) * 3 - 1 do
snum := '0' + snum;

L := Length(snum) div 3 - 1; // تعداد قسمت هاي سه رقمي منهاي يک

// سه رقم سه رقم حلقه را تکرار کن
// از چپ به راست
for i := 0 to L do
begin
// به دست آوردن سه رقم مورد نظر
b := strtoint(copy(snum ,i * 3 + 1, 3));
// اگر سه رقم به دست آمده صفر باشد، در نام عدد تاثيري ندارد
// نام قسمت سه رقمي را بدست مي آوريمgetnum3 با استفاده از تابع
// پسوند را به آن اضافه مي کنيمbase با استفاده از آرايه
if b <> 0 then
stotal := stotal + getnum3(b) + ' ' + base[L - i] + ' و ';
end;
// حذف حرف <و> اضافي
stotal := copy(stotal, 1, length(stotal) - 3);
result := stotal;
end;
end;

// اين تابع، يک لايه براي تابع <تبديل عدد به حروف> است که صحت مقدار ورودي را نيز بررسي مي کند
function GetStr(snum : string) : string;
begin
snum := trim(snum);
if isvalid15(snum) then
result := num2str(snum)
else
result := 'عدد مورد نظر بسيار بزرگ است و يا معتبر نيست' ;
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;

end.

hector2000
جمعه 12 دی 1393, 12:52 عصر
با تشکر بابت گذاشتن تابع تبدیل عدد به حروف همچنین با عرض معذزت به خاطر بالا اوردن تاپیکهای قدیمی
من از این تابع در دلفی 7 استفاده کردم ولی متاسفانه حروف را بر عکس می نویسد مثلا عددد 250 را می نویسد پنجاه و دویست
ایا راهی هست درست شود؟
با تشکر

hadisalahi2
یک شنبه 14 دی 1393, 15:44 عصر
فایل ضمیمه کارت رو راه میندازه

از دلفی 7 تا XE2 خودم باهاش کار کردم هیچ مشکلی نداشته

اگه مشکلی توی نمایش حروف باشه ، صد در صد در تنظیمات زبان فارسیت هست نه در این یونیت
چون این فایل الان 7 سال یار همیشگی من بوده و تا الان یک بار هم تنهام نزاشته و کارش رو هم به درستی انجام داده
خلاصه که من خیلی ازش راضیم
دستش درد نکنه :لبخند::لبخند: