تبدیل اعدا به حروف

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 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;