تبدیل عدد به معادل حرفی آن( هرچی سرچ کردم پیدا نکردم)!

[khafanovich]

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

[nasr]

function addad2harf(adad:string):string;
var
adad1 : string;
seragham1,seragham2 : string;
a : array [1..9] of byte;
adad_i : integer;
i , j : byte;
javab : string;
begin
case Length(adad) of
1 : adad1 := '00000000' + adad;
2 : adad1 := '0000000' + adad;
3 : adad1 := '000000' + adad;
4 : adad1 := '00000' + adad;
5 : adad1 := '0000' + adad;
6 : adad1 := '000' + adad;
7 : adad1 := '00' + adad;
8 : adad1 := '0' + adad;
9 : adad1 := adad;
end;
i := 1; j := 9;
while ((i <= 9) and (j >= 1)) do begin
a[i] := strtoint(copy(adad1,j,1));
inc(i);
dec(j);
end;
adad_i := strtoint(adad1);
seragham1 := copy(adad1,7,3);
seragham2 := copy(adad1,4,3);
if a[2] = 0 then result := adadtoharf(a[1]); //1-9.
if a[2] = 1 then result := adadtoharf(a[2] * 10 + a[1]); //10-19.
if ((a[2] >= 2) and (a[1] = 0)) then javab := adadtoharf(a[2] * 10); //20,30,...,90.
if ((a[2] >= 2) and (a[1] <> 0)) then javab := adadtoharf(a[2] * 10)+' æ '+adadtoharf(a[1]); //21-99.
if ((a[3] >= 1) and (a[1] = 0) and (a[2] = 0)) then javab := adadtoharf(a[3] * 100); //200,300,...,900.
if ((a[3] >= 1) and ((a[1] <> 0) or (a[2] <> 0))) then javab := adadtoharf(a[3] * 100)+' æ '+javab; //100-999.
{**** HEZAR ****}
if adad_i >= 1000 then begin
if ((a[5] = 0) and (a[4] <> 0))then
if seragham1 = '000' then javab := adadtoharf(a[4])+' åÒÇÑ ' //1,2,...9.
else javab := adadtoharf(a[4])+' åÒÇÑ æ '+javab ; //1-9.
if a[5] = 1 then //10-19.
if seragham1 = '000' then javab := adadtoharf(a[5] * 10 + a[4])+' åÒÇÑ ' // 10,11,...,99.
else javab := adadtoharf(a[5] * 10 + a[4])+' åÒÇÑ æ '+javab ; //10-19
if ((a[5] >= 2) and (a[4] = 0)) then
if seragham1 = '000' then javab := adadtoharf(a[5] * 10)+' åÒÇÑ '+javab //20,30,...,90.
else javab := adadtoharf(a[5] * 10)+' åÒÇÑ æ '+javab ; //20001,20002,...,90999.
if ((a[5] >= 2) and (a[4] <> 0)) then
if seragham1 = '000' then javab := adadtoharf(a[5] * 10)+' æ '+adadtoharf(a[4])+' åÒÇÑ '+javab //21-99.
else javab := adadtoharf(a[5] * 10)+' æ '+adadtoharf(a[4])+' åÒÇÑ æ '+javab; //21-99.
if ((a[6] >= 1) and (a[4] = 0) and (a[5] = 0)) then
if seragham1 = '000' then javab := adadtoharf(a[6] * 100)+' åÒÇÑ '+javab //200,300,...,900.
else javab := adadtoharf(a[6] * 100)+' åÒÇÑ æ '+javab ; //200,300,...,900.
if ((a[6] >= 1) and ((a[4] <> 0) or (a[5] <> 0))) then javab := adadtoharf(a[6] * 100)+' æ '+javab; //100-999.
end;
{**** Milion ****}
if adad_i >= 1000000 then begin
if ((a[8] = 0) and (a[7] <> 0))then
if ((seragham1 = '000') and (seragham2 = '000')) then javab := adadtoharf(a[7])+' ãíáíæä ' //1,2,...9.
else javab := adadtoharf(a[7])+' ãíáíæä æ '+javab ; //1-9.
if a[8] = 1 then //10-19.
if ((seragham1 = '000') and (seragham2 = '000')) then javab := adadtoharf(a[8] * 10 + a[7])+' ãíáíæä ' // 10,11,...,99.
else javab := adadtoharf(a[8] * 10 + a[7])+' ãíáíæä æ '+javab ; //10-19
if ((a[8] >= 2) and (a[7] = 0)) then
if ((seragham1 = '000') and (seragham2 = '000')) then javab := adadtoharf(a[8] * 10)+' ãíáíæä '+javab //20,30,...,90.
else javab := adadtoharf(a[8] * 10)+' ãíáíæä æ '+javab ; //20001,20002,...,90999.
if ((a[8] >= 2) and (a[7] <> 0)) then
if ((seragham1 = '000') and (seragham2 = '000')) then javab := adadtoharf(a[8] * 10)+' æ '+adadtoharf(a[7])+' ãíáíæä '+javab //21-99.
else javab := adadtoharf(a[8] * 10)+' æ '+adadtoharf(a[7])+' ãíáíæä æ '+javab; //21-99.
if ((a[9] >= 1) and (a[8] = 0) and (a[7]= 0)) then
if ((seragham1 = '000') and (seragham2 = '000')) then javab := adadtoharf(a[9] * 100)+' ãíáíæä '+javab //200,300,...,900.
else javab := adadtoharf(a[9] * 100)+' ãíáíæä æ '+javab ; //200,300,...,900.
if ((a[9] >= 1) and ((a[8] <> 0) or (a[7] <> 0))) then javab := adadtoharf(a[9] * 100)+' æ '+javab; //100-999.
end;
result := javab;
end;

//------------------------------------------------------------------------------
function adadtoharf(i:integer):string;
begin
case i of
1 : result := 'í˜';
2 : result := 'Ïæ';
3 : result := 'Óå';
4 : result := 'åÇÑ';
5 : result := 'äÌ';
6 : result := 'ÔÔ';
7 : result := 'åÝÊ';
8 : result := 'åÔÊ';
9 : result := 'äå';
10 : result := 'Ïå';
11 : result := 'íÇÒÏå';
12 : result := 'ÏæÇÒÏå';
13 : result := 'ÓíÒÏå';
14 : result := 'åÇÑÏå';
15 : result := 'ÇäÒÏå';
16 : result := 'ÔÇäÒÏå';
17 : result := 'åÝÏå';
18 : result := 'åÌÏå';
19 : result := 'äæÒÏå';
20 : result := 'ÈíÓÊ';
30 : result := 'Óí';
40 : result := 'åá';
50 : result := 'äÌÇå';
60 : result := 'ÔÕÊ';
70 : result := 'åÝÊÇÏ';
80 : result := 'åÔÊÇÏ';
90 : result := 'äæÏ';
100 : result := 'í˜ÕÏ';
200 : result := 'ÏæíÓÊ';
300 : result := 'ÓíÕÏ';
400 : result := 'åÇÑÕÏ';
500 : result := 'ÇäÕÏ';
600 : result := 'ÔÔÕÏ';
700 : result := 'åÝÊÕÏ';
800 : result := 'åÔÊÕÏ';
900 : result := 'äåÕÏ';
end;
end;

[nasr]

نمی دونم چرا متنهای فارسی را اینطور نشون می ده

چند بار تکرار کردم درست نشد

این حروفی که بصورت 'äåÕÏ' نوشته است حروف فارسی است که نمی دونم چرا اینطور نشون می ده

[abedi vida]

اگه بیشتر سرچ میکردی ÷یدا می کردی


; unit Unit1


interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Label_Famil: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
implementation
{$R *.dfm}

function num2str_pro(w:longint):string;
const
ch1:array[1..9] of string[10]=(' یک',' دو',' سه',' چهار',' پنج',' شش',' هفت',' هشت',' نه');
ch2:array[0..9] of string[10]=(' ده',' یازده',' دوازده',' سیزده¨',' چهارده',' پانزده',' شانزده',' هفده',' هجده',' نوزده');
ch3:array[1..8] of string[10]=(' بیست',' سی',' چهل',' پنجاه',' شصت',' هفتاد',' هشتاد',' نود');
ch4:array[1..9] of string[10]=(' صد',' دویست',' سیصد',' چهارصد',' پانصد',' ششصد',' هفتصد',' هشتصد',' نهصد');
ch5:array[2..4] of string[10]=(' هزار',' میلیون',' میلیارد');
var
org,scr,tem:string;
cont,i:byte;
cone,cten,chan:byte;

function zero(s:string):boolean;
var i:integer;w:word;
begin
if (s='') then zero:=false else zero:=true;
end;
begin
str(w,tem);cont:=0;
while length(tem) mod 3 <> 0 do
tem:='0'+tem;
cont:=length(tem) div 3;
org:='';i:=0;
while true do begin
if i=0 then inc(i) else inc(i,3);
if i>=length(tem) then break;
scr:=Copy(tem,i,3);
cone:=byte(scr[3])-48;
cten:=byte(scr[2])-48;
chan:=byte(scr[1])-48;
scr:='';
if(cone=0)and(cten=0)and(chan=0) then begin dec(cont);continue;end;
if zero(org) then
org:=' و '+org;
if (chan<10)and (chan>0) then
scr:=ch4[chan];
if (zero(scr)) and (cten<>0) then
scr:=' و '+scr;
if cten=1 then
begin
if cone<10 then
scr:=ch2[cone]+scr;
if (cont>1)and(cont<5) then
scr:=ch5[cont]+scr;
org:=scr+org;
dec(cont);
Continue;
end;
if (cten<>1)and (cten<10) and (cten>0)then
scr:=ch3[cten-1]+scr;
if (zero(scr)) and (cone <>0) and (cten<>1) then
scr:=' و '+scr;
if (cten<>1)and(cone<10)and(cone>0) then
scr:=ch1[cone]+scr;
if (cont>1)and(cont<5) then
scr:=ch5[cont]+scr;
dec(cont);
org:=scr+org;
end;
num2str_pro:=org;
end;

procedure TForm1.Button1Click(Sender: TObject);
Var
Nu:Longint;
begin
Nu:=StrToInt(Edit1.Text);
Label_Famil.Caption:=(num2str_pro(nu));
end;

end.

[Farrokhpey]

:flower:

[MiRHaDi]

سلام
از نظر برنامه نویسی بهتریم سیستم نوشتن این الگوریتم اینه که عدد رو سه تا سه تا کنی بعد یک تابع داشته باشی که 3 رقمی رو تبدیل کنه بعد برای هر کدوم از سه تایی هات یک اسم دسته اضافه کنی !‌این جوری بدونم اضافه شدن خط میتونی عدد N رقمی رو تبدیل کنی
این کار بیشتر برای خواندن عدد استفاده میشه تا نوشتنش
بای

[babila]

یک Dll برای این کار نوشتم اگر مایل بودید اطلاع بدین تا براتون بفرستم.

[winer3549]

یک Dll برای این کار نوشتم اگر مایل بودید اطلاع بدین تا براتون بفرستم.

سلام دوست عزيز

اگر زحمتي نيست فايلشو همين جا آپلود كنيد تا استفاده كنيم :تشویق:

[بابک.م.]

این چه طوره!



function NumToAlph (Number: Integer): string;
const
AlphNum : array [1..5, 1..9] of string [8] = (
('يك', 'دو', 'سه', 'چهار', 'پنج', 'شش', 'هفت', 'هشت', 'نه'),
('ده', 'بيست', 'سي', 'چهل', 'پنجاه', 'شصت', 'هفتاد', 'هشتاد', 'نود'),
('يكصد', 'دويست', 'سيصد', 'چهارصد', 'پانصد', 'ششصد', 'هفتصد', 'هشتصد', 'نهصد'),
('هزار', 'ميليون', 'ميليارد', 'بيليون', 'تريليون', 'تريليارد', '???', '????', '?????'),
('يازده', 'دوازده', 'سيزده', 'چهارده', 'پانزده', 'شانزده', 'هفده', 'هجده', 'نوزده')
);
var
AlphEqu : string;
temp, N: string;
i: Integer;
Sep: string;
begin
if Number = 0 then
begin
Result := 'صفر';
Exit;
end;
N := IntToStr (Number);
N := DupeString ( '0', 3 - Length(N) Mod 3) + N;
Sep := #32;
for i := 1 to Length(N) div 3 do
begin
temp := RightStr(N, 3);
N := LeftStr(N, Length(N) - 3);
/// هزارگان
if i <> 1 then
if StrToInt(temp) <> 0 then
begin
AlphEqu := AlphNum[4][i - 1] + Sep + AlphEqu;
Sep := #32;
end;
// يكان و دهگان
if (StrToInt(RightStr(temp, 2)) > 10) and (StrToInt(RightStr(temp, 2)) < 20) then
begin
AlphEqu := AlphNum[5][StrToInt(RightStr(temp, 2)) - 10] + Sep + AlphEqu;
if Sep = #32 then Sep := ' و ' ;
end
else
begin
if StrToInt(temp [3]) <> 0 then
begin
AlphEqu := AlphNum[1][StrToInt(temp [3])] + Sep + AlphEqu;
if Sep = #32 then Sep := ' و ' ;
end;
if StrToInt(temp [2]) <> 0 then
begin
AlphEqu := AlphNum[2][StrToInt(temp [2])] + Sep + AlphEqu;
if Sep = #32 then Sep := ' و ' ;
end;
end;
// صدگان
if StrToInt(temp [1]) <> 0 then
begin
AlphEqu := AlphNum[3][StrToInt(temp [1])] + Sep + AlphEqu;
if Sep = #32 then Sep := ' و ' ;
end;
end;
Result := AlphEqu;
end;

[sarbandi]

دوست عزیز این AttaCh رو داناود کن
واست نوشتم
امتحان کن
29744

[Rahyar]

با سلام
جناب Sarbandi امکانش هست این نمونه ای که گذاشتین رو واسه اعداد اعشاری هم قابل استفاده اش کنید.
اینطوری خیلی کاملتر و قابل استفاده تر میشه.
ممنون

[sql_qassem]

براي اعداد اعشاري تغيير زيادي اضافه نمي شه . فقط لازمه يك كلمه مميز اضافه كرد و حروفي اعشار رو نيز دوباره به جمله ساخته شده اضافه كرد.

[khoshblagh]

با سلام
چه جوری میشه اون رو تو FastReport استفاده کرد.

[جواد ملاولی]

با سلام
چه جوری میشه اون رو تو FastReport استفاده کرد.

سلام. یادمه یک وقتی آقای احدی در این مورد یه پست داشت، جستجو کنید.