masoud1345
چهارشنبه 20 شهریور 1392, 11:30 صبح
دوستان در همين سايت يكي از اساتيد تابعي براي تبديل اعداد به فارسي نوشته اند حال چگونه از اين تابع در برنامه وفرمها وگزارشات استفاده كنم اين هم دستور تابع FUNCTION num2str
lPARAMETERS cstrr
nlll = INT(LEN(cstrr))&& ãÞÏÇÑ ÕÍíÍ Øæá ÑÔÊå
ntg = nlll/3+0.99&& Øæá ÑÔÊå ÊÞÓíã ÈÑ 3
ntg = INT(ntg)
nash = ntg
ncon = 0
DIMENSION aab(1,ntg)
cdd= ""
chh =""
nchse = ntg
FOR nkol =1 TO LEN(allt(cstrr))
FOR nsee = 1 TO 3
cdd = SUBSTR(cstrr,nlll,1)+cdd
nlll= nlll-1
IF nlll = 0
EXIT
endif
ENDFOR
aab(1,nash)= harf(cdd)
cdd = ""
nash = nash-1
IF nlll = 0
EXIT
endif
endfor
cbeg =""
chezar = chr(229)+chr(210)+chr(199)+chr(209)+chr(32)+CHR(23 0)
cmilyon = chr(227)+chr(237)+chr(225)+chr(237)+chr(230)+chr(2 28)+chr(32)+CHR(230)
cmilyard = chr(227)+chr(237)+chr(225)+chr(237)+chr(199)+chr(2 09)+chr(207)+chr(32)+CHR(230)
ctrilon = chr(202)+chr(209)+chr(237)+chr(225)+chr(237)+chr(2 30)+chr(228)+chr(32)+CHR(230)
DO CASE
CASE ntg = 1
cbeg = allt(aab(1,1))
CASE ntg = 2
cbeg = allt(aab(1,1))+Chr(32)+chezar+Chr(32)+allt(aab(1,2 ))
CASE ntg = 3
cbeg = allt(aab(1,1))+Chr(32)+ cmilyon +Chr(32)+ allt(aab(1,2))+Chr(32)+chezar+Chr(32) +allt(aab(1,3))
CASE ntg = 4
cbeg = allt(aab(1,1))+Chr(32)+cmilyard +" "+ allt(aab(1,2))+Chr(32)+cmilyon +Chr(32)+allt(aab(1,3))+Chr(32)+chezar+ Chr(32)+ allt(aab(1,4))
CASE ntg = 5
cbeg = allt(aab(1,1))+Chr(32)+ ctrilon + Chr(32) + allt(aab(1,2))+Chr(32)+cmilyard +Chr(32)+ allt(aab(1,3))+Chr(32)+cmilyon +Chr(32)+allt(aab(1,4))+Chr(32)+chezar+Chr(32)+all t(aab(1,5))
ENDCASE
cbeg = allt(cbeg)
IF RIGHT(cbeg,1) = CHR(230)
cbeg = LEFT(cbeg,LEN(cbeg)-1)
ENDIF
RETURN cbeg
ENDFUNC
**********
FUNCTION harf
lPARAMETERS chhar
chhar = hazf(chhar)
ntml= LEN(ALLTRIM(chhar))
chaf = ""
chhh = ""
ldah1 = .f.
DO CASE
CASE ntml = 0
dddd = 0
ldah1 = .f.
CASE ntml = 1
dddd = 0
CASE ntml = 2
dddd = LEFT(allt(chhar),1)
dddd = VAL(dddd)
CASE ntml = 3
dddd = SUBSTR(chhar,2,1)
dddd = VAL(dddd)
ENDCASE
IF dddd = 1
ldah1 = .t.
ELSE
ldah1 = .f.
endif
IF VAL(right(chhar,1)) = 0
ldah1 = .f.
endif
IF ldah1 = .t.
DIMENSION dahgan(1,10)
STORE "íÇÒÏå" TO dahgan(1,1)
STORE "ÏæÇÒÏå" TO dahgan(1,2)
STORE "ÓíÒÏå" TO dahgan(1,3)
STORE "åÇÑÏå" TO dahgan(1,4)
STORE "ÇäÒÏå" TO dahgan(1,5)
STORE "ÔÇäÒÏå" TO dahgan(1,6)
STORE "åÝÏå" TO dahgan(1,7)
STORE "åÌÏå" TO dahgan(1,8)
STORE "äæÒÏå" TO dahgan(1,9)
STORE "" TO dahgan(1,10)
else
DIMENSION dahgan(1,10)
STORE "Ïå" TO dahgan(1,1)
STORE "ÈíÓÊ" TO dahgan(1,2)
STORE "Óí" TO dahgan(1,3)
STORE "åá" TO dahgan(1,4)
STORE "äÌÇå" TO dahgan(1,5)
STORE "ÔÕÊ" TO dahgan(1,6)
STORE "åÝÊÇÏ" TO dahgan(1,7)
STORE "åÔÊÇÏ" TO dahgan(1,8)
STORE "äæÏ" TO dahgan(1,9)
STORE "" TO dahgan(1,10)
endif
DIMENSION yekan(1,10)
STORE "í˜" TO yekan(1,1)
STORE "Ïæ" TO yekan(1,2)
STORE "Óå" TO yekan(1,3)
STORE "åÇÑ" TO yekan(1,4)
STORE "äÌ" TO yekan(1,5)
STORE "ÔÔ" TO yekan(1,6)
STORE "åÝÊ" TO yekan(1,7)
STORE "åÔÊ" TO yekan(1,8)
STORE "äå" TO yekan(1,9)
STORE "" TO yekan(1,10)
DIMENSION sadgan(1,10)
STORE "í˜ÕÏ" TO sadgan(1,1)
STORE " ÏæíÓÊ" TO sadgan(1,2)
STORE "ÓíÕÏ" TO sadgan(1,3)
STORE "åÇÑÕÏ" TO sadgan(1,4)
STORE "ÇäÕÏ" TO sadgan(1,5)
STORE "ÔÔÕÏ" TO sadgan(1,6)
STORE "åÝÊÕÏ" TO sadgan(1,7)
STORE "åÔÊÕÏ" TO sadgan(1,8)
STORE "äåÕÏ" TO sadgan(1,9)
STORE "" TO sadgan(1,10)
DIMENSION tmp(1,3)
FOR nii = 1 TO LEN(chhar) && ÍáÞå ÝÊä ÇÚÏÇÏ Óå ÑÞã Óå ÑÞã
tmp(1,ntml)= INT(val(SUBSTR(chhar,ntml,1)))
IF tmp(1,ntml) = 0
tmp(1,ntml) = 10
cva = ""
ELSE
cva = " æ "
endif
IF ldah1 = .f.
DO CASE && ÝÊä ÍÑæÝí ÇÚÏÇÏ Óå ÑÞã Óå ÑÞã
CASE nii = 1
chaf = yekan(1,tmp(1,ntml))
chhh = chaf+cva+chhh
CASE nii = 2
chaf = dahgan(1,tmp(1,ntml))
chhh = chaf+cva+chhh
CASE nii = 3
chaf = sadgan(1,tmp(1,ntml))
chhh = chaf+cva+chhh
ENDCASE
ELSE
IF tmp(1,ntml) = 0
tmp(1,ntml) = 10
cva = ""
ELSE
cva = " æ "
endif
DO case
CASE nii = 1
chaf = dahgan(1,tmp(1,ntml))
chhh = chaf+cva+chhh
CASE nii = 3
chaf = sadgan(1,tmp(1,ntml))
chhh = chaf+cva+chhh
ENDCASE
endif
ntml = ntml-1
ENDFOR
chhh = alltrim(chhh)
IF right(chhh,1)= "æ"
chhh = LEFT(chhh,LEN(chhh)-1)
endif
RETURN chhh
ENDFUNC
*******************
FUNCTION hazf
PARAMETERS chaz ,nhazf
nhaz = VAL(chaz)
chaz = allt(STR(INT(nhaz)))
RETURN chaz
endfunc
lPARAMETERS cstrr
nlll = INT(LEN(cstrr))&& ãÞÏÇÑ ÕÍíÍ Øæá ÑÔÊå
ntg = nlll/3+0.99&& Øæá ÑÔÊå ÊÞÓíã ÈÑ 3
ntg = INT(ntg)
nash = ntg
ncon = 0
DIMENSION aab(1,ntg)
cdd= ""
chh =""
nchse = ntg
FOR nkol =1 TO LEN(allt(cstrr))
FOR nsee = 1 TO 3
cdd = SUBSTR(cstrr,nlll,1)+cdd
nlll= nlll-1
IF nlll = 0
EXIT
endif
ENDFOR
aab(1,nash)= harf(cdd)
cdd = ""
nash = nash-1
IF nlll = 0
EXIT
endif
endfor
cbeg =""
chezar = chr(229)+chr(210)+chr(199)+chr(209)+chr(32)+CHR(23 0)
cmilyon = chr(227)+chr(237)+chr(225)+chr(237)+chr(230)+chr(2 28)+chr(32)+CHR(230)
cmilyard = chr(227)+chr(237)+chr(225)+chr(237)+chr(199)+chr(2 09)+chr(207)+chr(32)+CHR(230)
ctrilon = chr(202)+chr(209)+chr(237)+chr(225)+chr(237)+chr(2 30)+chr(228)+chr(32)+CHR(230)
DO CASE
CASE ntg = 1
cbeg = allt(aab(1,1))
CASE ntg = 2
cbeg = allt(aab(1,1))+Chr(32)+chezar+Chr(32)+allt(aab(1,2 ))
CASE ntg = 3
cbeg = allt(aab(1,1))+Chr(32)+ cmilyon +Chr(32)+ allt(aab(1,2))+Chr(32)+chezar+Chr(32) +allt(aab(1,3))
CASE ntg = 4
cbeg = allt(aab(1,1))+Chr(32)+cmilyard +" "+ allt(aab(1,2))+Chr(32)+cmilyon +Chr(32)+allt(aab(1,3))+Chr(32)+chezar+ Chr(32)+ allt(aab(1,4))
CASE ntg = 5
cbeg = allt(aab(1,1))+Chr(32)+ ctrilon + Chr(32) + allt(aab(1,2))+Chr(32)+cmilyard +Chr(32)+ allt(aab(1,3))+Chr(32)+cmilyon +Chr(32)+allt(aab(1,4))+Chr(32)+chezar+Chr(32)+all t(aab(1,5))
ENDCASE
cbeg = allt(cbeg)
IF RIGHT(cbeg,1) = CHR(230)
cbeg = LEFT(cbeg,LEN(cbeg)-1)
ENDIF
RETURN cbeg
ENDFUNC
**********
FUNCTION harf
lPARAMETERS chhar
chhar = hazf(chhar)
ntml= LEN(ALLTRIM(chhar))
chaf = ""
chhh = ""
ldah1 = .f.
DO CASE
CASE ntml = 0
dddd = 0
ldah1 = .f.
CASE ntml = 1
dddd = 0
CASE ntml = 2
dddd = LEFT(allt(chhar),1)
dddd = VAL(dddd)
CASE ntml = 3
dddd = SUBSTR(chhar,2,1)
dddd = VAL(dddd)
ENDCASE
IF dddd = 1
ldah1 = .t.
ELSE
ldah1 = .f.
endif
IF VAL(right(chhar,1)) = 0
ldah1 = .f.
endif
IF ldah1 = .t.
DIMENSION dahgan(1,10)
STORE "íÇÒÏå" TO dahgan(1,1)
STORE "ÏæÇÒÏå" TO dahgan(1,2)
STORE "ÓíÒÏå" TO dahgan(1,3)
STORE "åÇÑÏå" TO dahgan(1,4)
STORE "ÇäÒÏå" TO dahgan(1,5)
STORE "ÔÇäÒÏå" TO dahgan(1,6)
STORE "åÝÏå" TO dahgan(1,7)
STORE "åÌÏå" TO dahgan(1,8)
STORE "äæÒÏå" TO dahgan(1,9)
STORE "" TO dahgan(1,10)
else
DIMENSION dahgan(1,10)
STORE "Ïå" TO dahgan(1,1)
STORE "ÈíÓÊ" TO dahgan(1,2)
STORE "Óí" TO dahgan(1,3)
STORE "åá" TO dahgan(1,4)
STORE "äÌÇå" TO dahgan(1,5)
STORE "ÔÕÊ" TO dahgan(1,6)
STORE "åÝÊÇÏ" TO dahgan(1,7)
STORE "åÔÊÇÏ" TO dahgan(1,8)
STORE "äæÏ" TO dahgan(1,9)
STORE "" TO dahgan(1,10)
endif
DIMENSION yekan(1,10)
STORE "í˜" TO yekan(1,1)
STORE "Ïæ" TO yekan(1,2)
STORE "Óå" TO yekan(1,3)
STORE "åÇÑ" TO yekan(1,4)
STORE "äÌ" TO yekan(1,5)
STORE "ÔÔ" TO yekan(1,6)
STORE "åÝÊ" TO yekan(1,7)
STORE "åÔÊ" TO yekan(1,8)
STORE "äå" TO yekan(1,9)
STORE "" TO yekan(1,10)
DIMENSION sadgan(1,10)
STORE "í˜ÕÏ" TO sadgan(1,1)
STORE " ÏæíÓÊ" TO sadgan(1,2)
STORE "ÓíÕÏ" TO sadgan(1,3)
STORE "åÇÑÕÏ" TO sadgan(1,4)
STORE "ÇäÕÏ" TO sadgan(1,5)
STORE "ÔÔÕÏ" TO sadgan(1,6)
STORE "åÝÊÕÏ" TO sadgan(1,7)
STORE "åÔÊÕÏ" TO sadgan(1,8)
STORE "äåÕÏ" TO sadgan(1,9)
STORE "" TO sadgan(1,10)
DIMENSION tmp(1,3)
FOR nii = 1 TO LEN(chhar) && ÍáÞå ÝÊä ÇÚÏÇÏ Óå ÑÞã Óå ÑÞã
tmp(1,ntml)= INT(val(SUBSTR(chhar,ntml,1)))
IF tmp(1,ntml) = 0
tmp(1,ntml) = 10
cva = ""
ELSE
cva = " æ "
endif
IF ldah1 = .f.
DO CASE && ÝÊä ÍÑæÝí ÇÚÏÇÏ Óå ÑÞã Óå ÑÞã
CASE nii = 1
chaf = yekan(1,tmp(1,ntml))
chhh = chaf+cva+chhh
CASE nii = 2
chaf = dahgan(1,tmp(1,ntml))
chhh = chaf+cva+chhh
CASE nii = 3
chaf = sadgan(1,tmp(1,ntml))
chhh = chaf+cva+chhh
ENDCASE
ELSE
IF tmp(1,ntml) = 0
tmp(1,ntml) = 10
cva = ""
ELSE
cva = " æ "
endif
DO case
CASE nii = 1
chaf = dahgan(1,tmp(1,ntml))
chhh = chaf+cva+chhh
CASE nii = 3
chaf = sadgan(1,tmp(1,ntml))
chhh = chaf+cva+chhh
ENDCASE
endif
ntml = ntml-1
ENDFOR
chhh = alltrim(chhh)
IF right(chhh,1)= "æ"
chhh = LEFT(chhh,LEN(chhh)-1)
endif
RETURN chhh
ENDFUNC
*******************
FUNCTION hazf
PARAMETERS chaz ,nhazf
nhaz = VAL(chaz)
chaz = allt(STR(INT(nhaz)))
RETURN chaz
endfunc