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

[davoodmz]

با سلام

آیا کامپونتی که عدد را به حروفی بنویسد وجود دارد یعنی اگر دی یک edit box عدد 1001 بود در edit2 ((هزار و یک)) نوشته شود.
باتشکر

[mzjahromi]

یه جستجو بکنید. همین جا قبلا صحبت شده. به نظرم خودم هم یک تابع واسه این کار گذاشتم سایر دوستان هم تابع این کار رو گذاشتن.

[ali_divsalar]

فکر می کنم functionتبدیل تاریخ را داده باشم درهر صورت کل source را همین الان در اختیارتون قرار می دم

[davoodmz]

آقای دیوسالار
نوشتی ولی عمل نکردی . مشکل من حل شد
باتشکر

[Mona_r]

ببخشید . من در تبدیل تاریخ میلادی به شمسی مشکل دارم . فایلش رو به صورت dll دارم ولی نمی دونم چطور ازش استفاده کنم . ممکنه راهنماییم کنید ؟
sara_m3m3@yahoo.com

[programersa]

function WNToA(N: LongInt): ShortString;
var
Strs: array[0..3] of ShortString;
Vals: array[0..3] of Integer;
Code: Integer;
I: Integer;

function Ones(C: Char): ShortString;
begin
case C of
'0': Ones := '';
'1': Ones := 'یک';
'2': Ones := 'دو';
'3': Ones := 'سه';
'4': Ones := 'چهار';
'5': Ones := 'پنج';
'6': Ones := 'شش';
'7': Ones := 'هفت';
'8': Ones := 'هشت';
'9': Ones := 'نه';
else
Result := '';
end;
Result := Result + ' ';
end;

function TenOnes(C: Char): ShortString;
begin
case C of
'1': TenOnes := 'یازده';
'2': TenOnes := 'دوازده';
'3': TenOnes := 'سیزده';
'4': TenOnes := 'چهارده';
'5': TenOnes := 'پانزده';
'6': TenOnes := 'شانزده';
'7': TenOnes := 'هفده';
'8': TenOnes := 'هجده';
'9': TenOnes := 'نوزده';
else
Result := '';
end;
Result := Result + ' ';
end;

function Tens(C: Char): ShortString;
begin
case C of
'0': Tens := '';
'2': Tens := 'بیست';
'3': Tens := 'سی';
'4': Tens := 'چهل';
'5': Tens := 'پنجاه';
'6': Tens := 'شصت';
'7': Tens := 'هفتاد';
'8': Tens := 'هشتاد';
'9': Tens := 'نود';
else
Result := '';
end;
Result := Result + ' ';
end;

function Hundreds(C: Char): ShortString;
begin
case C of
'1': Hundreds := 'یکصد';
'2': Hundreds := 'دویست';
'3': Hundreds := 'سیصد';
'4': Hundreds := 'چهارصد';
'5': Hundreds := 'پانصد';
'6': Hundreds := 'ششصد';
'7': Hundreds := 'هفتصد';
'8': Hundreds := 'هشتصد';
'9': Hundreds := 'نهصد';
else
Result := '';
end;
Result := Result + ' ';
end;

function DoNToA(S: ShortString): ShortString;
begin
if S[1] = '0' then S := Copy(S, 2, 2);
if S[1] = '0' then S := Copy(S, 2, 1);
case Length(S) of
1: Result := Ones(S[1]);
2: if (S[1] = '1') and (S[2] = '0') then Result := 'ده '
else
if S[1] = '1' then Result := TenOnes(S[2])
else
begin
Result := Tens(S[1]);
if S[2] <> '0' then Result := SRtrim(Result) + ' و ' + Ones(S[2]);
end;
3: if (S[2]='0') and (S[3]='0') then Result := Hundreds(S[1])
else
begin
Result := Hundreds(S[1]);
if (S[2] = '1') and (S[3] = '0') then Result := SRtrim(Result)+' و ده '
else
if S[2] = '1' then Result := SRtrim(Result)+ ' ده ' + TenOnes(S[3])
else
begin
if S[2] <> '0' then Result := SRtrim(Result) + ' و ' + Tens(S[2]);
if S[3] <> '0' then Result := SRtrim(Result) + ' و ' + Ones(S[3]);
end;
end;
else
Result := '';
end;
end;
var
S: ShortString;
begin
Result := '';
Str(Abs(N):12, S);
if SIsBlank(S) then
begin
Result := 'صفر';
Exit;
end;
for I := 0 to 3 do
begin
Strs[i] := SLTrim(Copy(S, 12 - ((I+1) * 3) +1, 3));
Val(Strs[i], Vals[i], Code);
end;
if (Strs[0] = '') and (Strs[1] = '') and (Strs[2] = '') and (Strs[3] = '') then
Exit;
if (Strs[0] <> '') and (Strs[1] <> '') and
(Strs[2] <> '') and (Strs[3] <> '') then
Result := DoNToA(Strs[3]) +
IIF(Vals[3] = 0, '', 'میلیارد') +
IIF(Vals[2] = 0, '', ' و ') +
DoNToA(Strs[2]) +
IIF(Vals[2] = 0, '', 'میلیون') +
IIF(Vals[1] = 0, '', ' و ') +
DoNToA(Strs[1]) +
IIF(Vals[1] = 0, '', 'هزار ') +
IIF(Vals[0] = 0, '', ' و ') +
DoNToA(Strs[0])
else
if (Strs[0] <> '') and (Strs[1] <> '') and
(Strs[2] <> '') and (Strs[3] = '') then
Result :=
DoNToA(Strs[2])+
IIF(Vals[2] = 0, '', 'میلیون') +
IIF(Vals[1] = 0, '', ' و ') +
DoNToA(Strs[1]) +
IIF(Vals[1] = 0, '', 'هزار') +
IIF(Vals[0] = 0, '', ' و ') +
DoNToA(Strs[0])
else
if (Strs[0] <> '') and (Strs[1] <> '') and
(Strs[2] = '') and (Strs[3] = '') then
Result := DoNToA(Strs[1])+
IIF(Vals[1] = 0, '', 'هزار') +
IIF(Vals[0] = 0, '', ' و ') +
DoNToA(Strs[0])
else
if (Strs[0] <> '') and (Strs[1] = '') and
(Strs[2] = '') and (Strs[3] = '') then
Result := DoNToA(Strs[0]);
end;
فقط کافی است بنویسید:
labe1.caption:=wntoa(strtoint(edit1.text))