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

[H_afkhami60]

سلام به اساتید بزرگوار
اساتید بزرگوار خواهشاً ی تابعی که کار تبدیل مبلغ عددی به حروفی را انجام بده ارائه کنید. مثلاً 5000 را بگیره و پنج هزار تحویل بده. با تشکر و سپاس فراوان

[H_afkhami60]

ی مسلمون پیدا نمیشه به فریاد ما برسه؟

[Mask]

بیش از 10 بار سوال شما در این بخش پرسیده شده.
بهتره جستجو کنید.
برای مثال :

function three(number: int64): string; forward;

implementation


{$R *.dfm}


function adad(number: int64): string;
var
flag: boolean;
s, u: string;
i, l: byte;
k: array [1 .. 5] of longint;
begin
// op:=number;
if (number = 0) then
adad := 'صفر';
str(number, s);
l := length(s);
if (l <= 15) then
begin


for i := 1 to 15 - l do
s := '0' + s;
for i := 1 to trunc((l / 3) + 0.99) do
begin
u := copy(s, 3 * (5 - i) + 1, 3);
delete(s, 3 * (5 - i) + 1, 3);
k[5 - i + 1] := strtoint(u);
end;
if (l > 2) then
flag := false
else
flag := true;
s := '';
for i := 1 to 5 do
if (k[i] <> 0) then
case i of
1:
s := s + three(k[i]) + ' تريليون ';
2:
if (flag = false) then
s := s + 'و' + three(k[i]) + ' ميليارد '
else
begin
s := s + '' + three(k[i]) + ' ميليارد ';
flag := true;
end;
3:
if (flag = false) then
s := s + 'و' + three(k[i]) + ' ميليون '
else
begin
s := s + '' + three(k[i]) + ' ميليون ';
flag := true;
end;
4:
if (flag = false) then
s := s + 'و' + three(k[i]) + ' هزار '
else
begin
s := s + '' + three(k[i]) + ' هزار ';
flag := true;
end;
5:
if (flag = false) then
s := s + 'و' + three(k[i])
else
s := s + three(k[i]);
else
begin
s := s + '' + three(k[i]);
flag := true;
end;


end;
trimright(s);
trimleft(s);
l := length(s);
for i := 1 to 10 do
if (s[i] <> 'و') and (s[i] <> ' ') then
break
else
s[i] := ' ';
for i := 1 to l do
if s[i] = 'و' then
if s[i] = s[i + 1] then
s[i] := ' ';
end
else
begin
s := '................عدد بسيار بزرگ است';
end;


// mombaini2006.blogsky.com
// mombaini2001@yahoo.com
adad := s;
end; { function }


function three(number: int64): string;
var
s: string;
l: longint;
h: array [1 .. 3] of byte;
// flag:boolean;
begin
str(number, s);
l := length(s);
s := '';
if (number = 0) then
three := '';
if (number = 100) then
three := 'يكصد';
if (l = 2) then
h[1] := 0;
if (l = 1) then
begin
h[1] := 0;
h[2] := 0;
h[3] := number;
end;
h[3] := number mod 10;
number := number div 10;
h[2] := number mod 10;
h[1] := number div 10;


case h[1] of
1:
s := ' يكصد ';
2:
s := ' دويست ';
3:
s := ' سيصد ';
4:
s := ' چهارصد ';
5:
s := ' پانصد ';
6:
s := ' ششصد ';
7:
s := ' هفتصد ';
8:
s := ' هشتصد ';
9:
s := ' نهصد ';
end;
case h[2] of
1:
case h[3] of
0:
s := s + 'و' + ' ده ';
1:
s := s + 'و' + ' يازده ';
2:
s := s + 'و' + ' دوازده ';
3:
s := s + 'و' + ' سيزده ';
4:
s := s + 'و' + ' چهارده ';
5:
s := s + 'و' + ' پانزده ';
6:
s := s + 'و' + ' شانزده ';
7:
s := s + 'و' + ' هفده ';
8:
s := s + 'و' + ' هجده ';
9:
s := s + 'و' + ' نوزده ';
end;
2:
s := s + 'و' + ' بيست ';
3:
s := s + 'و' + ' سي ';
4:
s := s + 'و' + ' چهل ';
5:
s := s + 'و' + ' پنجاه ';
6:
s := s + 'و' + ' شصت ';
7:
s := s + 'و' + ' هفتاد ';
8:
s := s + 'و' + ' هشتاد ';
9:
s := s + 'و' + ' نود ';
end;


if h[2] <> 1 then
case h[3] of
1:
s := s + 'و' + ' يك ';
2:
s := s + 'و' + ' دو ';
3:
s := s + 'و' + ' سه ';
4:
s := s + 'و' + ' چهار ';
5:
s := s + 'و' + ' پنج ';
6:
s := s + 'و' + ' شش ';
7:
s := s + 'و' + ' هفت ';
8:
s := s + 'و' + ' هشت ';
9:
s := s + 'و' + ' نه ';
end;


three := s;
end;


procedure TForm1.Edit1Change(Sender: TObject);
begin
if (Edit1.Text = '') or (Edit1.Text = '0') or (Edit1.Text = '00') or
(Edit1.Text = '000') or (Edit1.Text = '0000') or (Edit1.Text = '00000') or
(Edit1.Text = '000000') or (Edit1.Text = '0000000') or
(Edit1.Text = '00000000') or (Edit1.Text = '000000000') or
(Edit1.Text = '0000000000') or (Edit1.Text = '00000000000') or
(Edit1.Text = '000000000000') or (Edit1.Text = '0000000000000') then
begin
Edit2.Text := '';
end
else
begin
Edit2.Text := adad(strtoint(Edit1.Text));
Edit2.Text := Edit2.Text + ' ريال ';
end;
end;

[یوسف زالی]

ی مسلمون پیدا نمیشه به فریاد ما برسه؟

این حرفتون توهین به دین سایرینه.
شمایی که سرچ نمی کنی، انتظار داری تو 3 ساعت هم بهت جواب بدن، توهین هم می کنی؟
دوستمون هم خیلی لطف کرد که جواب داد. به احترام همین دوستمون هم پستتون پاک نشد.
خود من تابعش رو گذاشتم. جستجو کن.

[SayeyeZohor]

من هم به نوبه خودم اعلام میدارم "بگرددددددددد" مجبورم :متفکر:

http://barnamenevis.org/showthread.php?184773-%D8%B3%D9%88%D8%A7%D9%84-%D9%85%DB%8C-%D8%AE%D9%88%D8%A7%D9%85-%DB%8C%D9%87-%D8%B9%D8%AF%D8%AF-%D8%A8%DA%AF%DB%8C%D8%B1-%D9%88-%D8%A8%D9%87-%D9%81%D8%A7%D8%B1%D8%B3%DB%8C-%D8%A8%D9%86%D9%88%DB%8C%D8%B3%D9%87&highlight=char


آقا یوسف عزیز ، فک نکنم بنده خدا از حرفش قصدی داشته این یه اصطلاح رایج بین مردم شده شاید هم بد باشه

[H_afkhami60]

آقا من معذرت می خوام قصد توهین به هیچ عزیزی را نداشتم. اگر هم سرچ نکردم بذارید به حساب بی تجربگیم ولی انصافاً شما که استاد هستید از این سوالهای بی سوادایی همچون بنده ناراحت نشید به قول معروف اون فیلم سینمایی را که 10 سال پیش پخش شده اگه امروز دوباره گذاشتند، برای خیلیا که 10 سال پیش هنوز به دنیا نیومده بودند، تکراری نیست. بازم معذرت می خوام اگه به عزیزی برخورده. قصد جسارت نداشتم.