آیا مشود تابعی نوشت که یک عدد بگیرد و آن را به حروف تدیل کند؟
تابع تبدیل عدد به حروف
جواب :
درقسمت implementation تابع زیر را بنویسید:
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 number_to_word(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;
مثال با دو عنصر Edit و یک Button
procedure TForm1.Button1Click(Sender: TObject);
begin
if Edit2.Text=''then
begin
Edit1.Text:='0';
end;
Edit1.Text:= number_to_word(Edit2.Text);
end;
منبع : http://www.prdev.com
موفق وسربلند باشید .
*********************************************************************