ورود

View Full Version : برنامه تبدیل عدد به حروف


AMIR NEZAMI
پنج شنبه 22 دی 1384, 16:15 عصر
function yekan(x:integer):string;
begin
case x of
1: yekan:='í˜'; 2: yekan:='Ïæ'; 3: yekan:='Óå';
4: yekan:='åÇÑ'; 5: yekan:='äÌ'; 6: yekan:='ÔÔ';
7: yekan:='åÝÊ'; 8: yekan:='åÔÊ'; 9: yekan:='äå';
end;
end;
function dah(xx2:integer):string;
begin
case xx2 of
2: dah:='ÈíÓÊ'; 3: dah:='Óí';
4: dah:='åá'; 5: dah:='äÌÇå'; 6: dah:='ÔÕÊ';
7: dah:='åÝÊÇÏ'; 8: dah:='åÔÊÇÏ'; 9: dah:='äæÏ';
end;
end;
function bin(xx:integer):string;
begin
case xx of
10: bin:='Ïå'; 11: bin:='íÇÒÏå'; 12: bin:='ÏæÇÒÏå'; 13: bin:='ÓíÒÏå';
14: bin:='åÇÑÏå'; 15: bin:='ÇäÒÏå'; 16: bin:='ÔÇäÒÏå';
17: bin:='åÝÏå'; 18: bin:='åÌÏå'; 19: bin:='äæÒÏå';
end;
end;
function sad(xxx:integer):string;
begin
case xxx of
1: sad:='í˜ ÕÏ';2: sad:='ÏæíÓÊ'; 3: sad:='Óí ÕÏ';
4: sad:='åÇÑ ÕÏ'; 5: sad:='ÇäÕÏ'; 6: sad:='ÔÔÕÏ';
7: sad:='åÝÊÕÏ'; 8: sad:='åÔÊÕÏ'; 9: sad:='äå ÕÏ';
end;
end;

//procedure event ------------------------------------------

function hlp(xy:integer):string;
var
x,xx,xx2,s,x3,m:integer;
ss:string;
begin
ss:='';
m:=xy;

if (xy>999999)and(xy<10000000)then
begin x:=xy div 1000000;xy:=xy-(x*1000000);ss:=ss+' '+yekan(x)+' ';end;
if (m>999999)and(m<100000000)then ss:=ss+'&atilde;&iacute;&aacute;&iacute;&aelig;&auml;';
m:=xy;

//------------------------------------------------------------//

if (xy>99999)and(xy<1000000)then
begin x:=xy div 100000;xy:=xy-(x*100000);ss:=ss+' '+sad(x);end;

if (xy>19999)and(xy<99999)then
begin xx2:=xy div 10000;xy:=xy-(xx2*10000);ss:=ss+' '+dah(xx2)+' ';end;

if (xy>10999)and(xy<19999)then
begin xx:=xy div 1000;xy:=xy-(xx*1000);ss:=ss+' '+bin(xx)+' ';end;

if (xy>9999)and(xy<100000) then
begin xx2:=xy div 10000;xy:=xy-(xx2*10000);ss:=ss+' '+dah(xx2)+' ';end;

if (xy>999)and(xy<10000)then
begin x:=xy div 1000;xy:=xy-(x*1000);ss:=ss+yekan(x)+' ';end;
if (m>999)and(m<1000000)then ss:=ss+'&aring;&Ograve;&Ccedil;&Ntilde; ';

//------------------------------------------------------------//

if (xy>99)and(xy<999)then
begin x:=xy div 100; xy:=xy-(x*100);ss:=' '+ss+sad(x);end;

if (xy>9)and(xy<20)then
begin xx:=xy;ss:=ss+' '+bin(xx);end;

if (xy>19)and(xy<100)then
begin xx2:=xy div 10;xy:=xy-(xx2*10);ss:=ss+' '+dah(xx2);end;

if (xy>0) and (xy<10) then
begin x:=xy; ss:=ss+' &aelig; '+yekan(x);end;

//------------------------------------------------------------//
hlp:=ss;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
z:string;
xy:integer;
begin
xy:=1234569;
z:=hlp(xy);
form1.Caption:=z;
end;
oghab
پنج شنبه 22 دی 1384, 18:00 عصر
سلام
متشکر
با اجازه ات چپ به راستش کردم.
http://www.barnamenevis.org/forum/misc.php?do=bbcode#imgcode


;
begin
case x of
1: yekan:='&iacute;˜'; 2: yekan:='&Iuml;&aelig;'; 3: yekan:='&Oacute;&aring;';
4: yekan:='چ&aring;&Ccedil;&Ntilde;'; 5: yekan:='پ&auml;&Igrave;'; 6: yekan:='&Ocirc;&Ocirc;';
7: yekan:='&aring;&Yacute;&Ecirc;'; 8: yekan:='&aring;&Ocirc;&Ecirc;'; 9: yekan:='&auml;&aring;';
end;
end;
function dah(xx2:integer):string;
begin
case xx2 of
2: dah:='&Egrave;&iacute;&Oacute;&Ecirc;'; 3: dah:='&Oacute;&iacute;';
4: dah:='چ&aring;&aacute;'; 5: dah:='پ&auml;&Igrave;&Ccedil;&aring;'; 6: dah:='&Ocirc;&Otilde;&Ecirc;';
7: dah:='&aring;&Yacute;&Ecirc;&Ccedil;&Iuml;'; 8: dah:='&aring;&Ocirc;&Ecirc;&Ccedil;&Iuml;'; 9: dah:='&auml;&aelig;&Iuml;';
end;
end;
function bin(xx:integer):string;
begin
case xx of
10: bin:='&Iuml;&aring;'; 11: bin:='&iacute;&Ccedil;&Ograve;&Iuml;&aring;'; 12: bin:='&Iuml;&aelig;&Ccedil;&Ograve;&Iuml;&aring;'; 13: bin:='&Oacute;&iacute;&Ograve;&Iuml;&aring;';
14: bin:='چ&aring;&Ccedil;&Ntilde;&Iuml;&aring;'; 15: bin:='پ&Ccedil;&auml;&Ograve;&Iuml;&aring;'; 16: bin:='&Ocirc;&Ccedil;&auml;&Ograve;&Iuml;&aring;';
17: bin:='&aring;&Yacute;&Iuml;&aring;'; 18: bin:='&aring;&Igrave;&Iuml;&aring;'; 19: bin:='&auml;&aelig;&Ograve;&Iuml;&aring;';
end;
end;
function sad(xxx:integer):string;
begin
case xxx of
1: sad:='&iacute;˜ &Otilde;&Iuml;';2: sad:='&Iuml;&aelig;&iacute;&Oacute;&Ecirc;'; 3: sad:='&Oacute;&iacute; &Otilde;&Iuml;';
4: sad:='چ&aring;&Ccedil;&Ntilde; &Otilde;&Iuml;'; 5: sad:='پ&Ccedil;&auml;&Otilde;&Iuml;'; 6: sad:='&Ocirc;&Ocirc;&Otilde;&Iuml;';
7: sad:='&aring;&Yacute;&Ecirc;&Otilde;&Iuml;'; 8: sad:='&aring;&Ocirc;&Ecirc;&Otilde;&Iuml;'; 9: sad:='&auml;&aring; &Otilde;&Iuml;';
end;
end;

//procedure event ------------------------------------------

function hlp(xy:integer):string;
var
x,xx,xx2,s,x3,m:integer;
ss:string;
begin
ss:='';
m:=xy;

if (xy>999999)and(xy<10000000)then
begin x:=xy div 1000000;xy:=xy-(x*1000000);ss:=ss+' '+yekan(x)+' ';end;
if (m>999999)and(m<100000000)then ss:=ss+'&atilde;&iacute;&aacute;&iacute;&aelig;&au ml;';
m:=xy;

//------------------------------------------------------------//

if (xy>99999)and(xy<1000000)then
begin x:=xy div 100000;xy:=xy-(x*100000);ss:=ss+' '+sad(x);end;

if (xy>19999)and(xy<99999)then
begin xx2:=xy div 10000;xy:=xy-(xx2*10000);ss:=ss+' '+dah(xx2)+' ';end;

if (xy>10999)and(xy<19999)then
begin xx:=xy div 1000;xy:=xy-(xx*1000);ss:=ss+' '+bin(xx)+' ';end;

if (xy>9999)and(xy<100000) then
begin xx2:=xy div 10000;xy:=xy-(xx2*10000);ss:=ss+' '+dah(xx2)+' ';end;

if (xy>999)and(xy<10000)then
begin x:=xy div 1000;xy:=xy-(x*1000);ss:=ss+yekan(x)+' ';end;
if (m>999)and(m<1000000)then ss:=ss+'&aring;&Ograve;&Ccedil;&Ntilde; ';

//------------------------------------------------------------//

if (xy>99)and(xy<999)then
begin x:=xy div 100; xy:=xy-(x*100);ss:=' '+ss+sad(x);end;

if (xy>9)and(xy<20)then
begin xx:=xy;ss:=ss+' '+bin(xx);end;

if (xy>19)and(xy<100)then
begin xx2:=xy div 10;xy:=xy-(xx2*10);ss:=ss+' '+dah(xx2);end;

if (xy>0) and (xy<10) then
begin x:=xy; ss:=ss+' &aelig; '+yekan(x);end;

//------------------------------------------------------------//
hlp:=ss;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
z:string;
xy:integer;
begin
xy:=1234569;
z:=hlp(xy);
form1.Caption:=z;
end;

فکر کنم قسمتی از کد فارسی بوده و paste شدن در این قسمت کاراکترهاش بهم خورده. اگه میشه تصیحیش کن. یا ضمیمه اش کن!
موفق باشی