Ali_Ham
یک شنبه 15 خرداد 1384, 11:45 صبح
با عرض سلام
من به یک پروژه احتیاج دارم که چند عدد را بگیرد ودر زیر به صورت حروف انگلیسی نشان بدهد من این برنامه را از این سایت دانلود کرده ودر فاکس پرو2.6 و ویژوال فاکس پرو6 امتحان کردم ولی وقتی که می خواهم آنرا با فرمان Do اجرا کنم یا برنامه اجرا نمی شود ویا به به پنجره دستورات رفته خط دستورات را اشکال می گیرد
FUNCTION StringRial
LPARAMETERS tnRial
LOCAL lcOutput,lcRial,lnIndex, lnLoop, lcTemp
#DEFINE WA '?'
lcRial = ALLTRIM(STR(tnRial))
lcOutput = ''
lnLoop = LEN(lcRial)
FOR lnIndex = 1 TO lnLoop STEP 3
lcTemp = num100(RIGHT(lcRial,3))
lcOutPut = IIF(NOT EMPTY(lcTemp),lcTemp+HMMBT(lnIndex)+IIF(NOT EMPTY(lcOutput),WA,''),'') + lcOutPut
lcRial = LEFT(lcRial,LEN(lcRial)-3)
NEXT
IF EMPTY(lcOutput)
lcOutput = 'صفر'
ENDIF
RETURN lcOutput
ENDFUNC
FUNCTION HMMBT
LPARAMETERS tnNumber
#DEFINE HEZAR 'هزار'
#DEFINE MILLION 'میلیون '
#DEFINE MILLIARD 'میلیارد'
#DEFINE BILLION 'بیلیون '
#DEFINE TRILLION 'تریلیارد '
DO CASE
CASE tnNumber = 1
RETURN ''
CASE tnNumber = 4
RETURN HEZAR
CASE tnNumber = 7
RETURN MILLION
CASE tnNumber = 10
RETURN MILLIARD
CASE tnNumber = 13
RETURN BILLION
CASE tnNumber = 16
RETURN TRILLION
ENDCASE
ENDFUNC
FUNCTION Num100
LPARAMETERS tcNumber
LOCAL lnSad,lnDah,lnYek,laYek,laDah,laDah2,laSad,lcOutpu t
tcNumber = PADL(tcNumber,3,'0')
lnSad = VAL(SUBSTR(tcNumber,1,1))
lnDah = VAL(SUBSTR(tcNumber,2,1))
lnYek = VAL(SUBSTR(tcNumber,3,1))
DIMENSION laYek(10),laDah(10),laDah2(10),laSad(10)
laYek(1) = ''
laYek(2) ='یک '
laYek(3) ='دو '
laYek(4) ='سه '
laYek(5) ='چهار'
laYek(6) ='پنج '
laYek(7) ='شش '
laYek(8) ='هفت '
laYek(9) ='هشت '
laYek(10) ='نه '
laDah(1) ='ده '
laDah(2) ='یازده '
laDah(3) ='دوازده '
laDah(4) ='سیزده '
laDah(5) ='چهارده '
laDah(6) ='پانزده '
laDah(7) ='شانزده '
laDah(8) ='هفده '
laDah(9) ='هجده '
laDah(10) ='نوزده '
laDah2(2) ='بیست '
laDah2(3) ='سی '
laDah2(4) ='چهل '
laDah2(5) ='پنجاه '
laDah2(6) ='شصت'
laDah2(7) ='هفتاد'
laDah2(8) ='هشتاد'
laDah2(9) ='نود'
laSad(1) = ''
laSad(2) ='یکصد'
laSad(3) ='دویست '
laSad(4) ='سیصد'
laSad(5) ='چهارصد'
laSad(6) ='پانصد'
laSad(7) ='ششصد'
laSad(8) ='هفتصد'
laSad(9) ='هشتصد'
laSad(10) ='نهصد'
lcSad = laSad(lnSad+1)
lcDah =IIF(lnDah > 1 ,laDah2(lnDah)+IIF(lnYek#0,WA+laYek(lnYek+1),''),I IF( lnDah = 0 , IIF(lnYek#0,laYek(lnYek+1),''), laDah(lnYek+1)))
lcOutput = IIF(NOT EMPTY(lcSad) AND NOT EMPTY(lcDah),lcSad+WA+lcDah,lcSAD+lcDah)
RETURN lcOutPut
ENDFUNC
من به یک پروژه احتیاج دارم که چند عدد را بگیرد ودر زیر به صورت حروف انگلیسی نشان بدهد من این برنامه را از این سایت دانلود کرده ودر فاکس پرو2.6 و ویژوال فاکس پرو6 امتحان کردم ولی وقتی که می خواهم آنرا با فرمان Do اجرا کنم یا برنامه اجرا نمی شود ویا به به پنجره دستورات رفته خط دستورات را اشکال می گیرد
FUNCTION StringRial
LPARAMETERS tnRial
LOCAL lcOutput,lcRial,lnIndex, lnLoop, lcTemp
#DEFINE WA '?'
lcRial = ALLTRIM(STR(tnRial))
lcOutput = ''
lnLoop = LEN(lcRial)
FOR lnIndex = 1 TO lnLoop STEP 3
lcTemp = num100(RIGHT(lcRial,3))
lcOutPut = IIF(NOT EMPTY(lcTemp),lcTemp+HMMBT(lnIndex)+IIF(NOT EMPTY(lcOutput),WA,''),'') + lcOutPut
lcRial = LEFT(lcRial,LEN(lcRial)-3)
NEXT
IF EMPTY(lcOutput)
lcOutput = 'صفر'
ENDIF
RETURN lcOutput
ENDFUNC
FUNCTION HMMBT
LPARAMETERS tnNumber
#DEFINE HEZAR 'هزار'
#DEFINE MILLION 'میلیون '
#DEFINE MILLIARD 'میلیارد'
#DEFINE BILLION 'بیلیون '
#DEFINE TRILLION 'تریلیارد '
DO CASE
CASE tnNumber = 1
RETURN ''
CASE tnNumber = 4
RETURN HEZAR
CASE tnNumber = 7
RETURN MILLION
CASE tnNumber = 10
RETURN MILLIARD
CASE tnNumber = 13
RETURN BILLION
CASE tnNumber = 16
RETURN TRILLION
ENDCASE
ENDFUNC
FUNCTION Num100
LPARAMETERS tcNumber
LOCAL lnSad,lnDah,lnYek,laYek,laDah,laDah2,laSad,lcOutpu t
tcNumber = PADL(tcNumber,3,'0')
lnSad = VAL(SUBSTR(tcNumber,1,1))
lnDah = VAL(SUBSTR(tcNumber,2,1))
lnYek = VAL(SUBSTR(tcNumber,3,1))
DIMENSION laYek(10),laDah(10),laDah2(10),laSad(10)
laYek(1) = ''
laYek(2) ='یک '
laYek(3) ='دو '
laYek(4) ='سه '
laYek(5) ='چهار'
laYek(6) ='پنج '
laYek(7) ='شش '
laYek(8) ='هفت '
laYek(9) ='هشت '
laYek(10) ='نه '
laDah(1) ='ده '
laDah(2) ='یازده '
laDah(3) ='دوازده '
laDah(4) ='سیزده '
laDah(5) ='چهارده '
laDah(6) ='پانزده '
laDah(7) ='شانزده '
laDah(8) ='هفده '
laDah(9) ='هجده '
laDah(10) ='نوزده '
laDah2(2) ='بیست '
laDah2(3) ='سی '
laDah2(4) ='چهل '
laDah2(5) ='پنجاه '
laDah2(6) ='شصت'
laDah2(7) ='هفتاد'
laDah2(8) ='هشتاد'
laDah2(9) ='نود'
laSad(1) = ''
laSad(2) ='یکصد'
laSad(3) ='دویست '
laSad(4) ='سیصد'
laSad(5) ='چهارصد'
laSad(6) ='پانصد'
laSad(7) ='ششصد'
laSad(8) ='هفتصد'
laSad(9) ='هشتصد'
laSad(10) ='نهصد'
lcSad = laSad(lnSad+1)
lcDah =IIF(lnDah > 1 ,laDah2(lnDah)+IIF(lnYek#0,WA+laYek(lnYek+1),''),I IF( lnDah = 0 , IIF(lnYek#0,laYek(lnYek+1),''), laDah(lnYek+1)))
lcOutput = IIF(NOT EMPTY(lcSad) AND NOT EMPTY(lcDah),lcSad+WA+lcDah,lcSAD+lcDah)
RETURN lcOutPut
ENDFUNC