**金额小写转换大写
FUNC cash
PARA rmb
FH=''
IF RMB<0
RMB=RMB*-1
FH='负'
ENDI
IF RMB>=1000000000
WAIT '金额超出有效范围!' WIND TIME 2
RETU ''
ENDI
rmb1=allt(str(rmb*100,15))
crmb=''
n1=len(rmb1)
money0='零壹贰叁肆伍陆柒捌玖'
MONEY1='分角元拾佰仟万拾佰仟亿'
DIME S1(N1),S2(N1),T1(N1),T2(N1)
STORE '' TO S1,S2
FOR N=1 TO N1
Q=VAL(SUBS(RMB1,N1-N+1,1))
S2(N)=SUBS(MONEY0,Q*2+1,2)
T2(N)=SUBS(MONEY0,Q*2+1,2)
S1(N)=SUBS(MONEY1,N*2-1,2)
T1(N)=SUBS(MONEY1,N*2-1,2)
ENDF
IF S2(1)='零' &&处理分
T2(1)=''
T1(1)='整'
ENDI
IF N1>1
FOR N=2 TO N1
IF S2(N)='零'
IF S2(N-1)='零'
T2(N)=''
ENDI
IF n=3 AND s2(2)#'零' &&处理元为零而角不为零
T2(3)=''
T1(3)='元零'
ENDI
IF n=7 AND s2(6)#'零' &&处理万元为零而仟不为零
T2(7)=''
T1(7)='万零'
ENDI
IF N#3 AND N#7 &&除元和万外
T1(N)=''
ENDI
ENDI
ENDF
ENDI
IF N>10 AND S2(8)='零' AND S2(9)='零' AND S2(10)='零'
T1(7)=''
ENDI
FOR N=1 TO N1
CRMB=T2(N)+T1(N)+CRMB
ENDF
CRMB=FH+CRMB
crmb=allt(crmb)
IF rmb=0
crmb=''
ENDI
RETU CRMB
function convdx
PARAMETER M.PA
DO CASE
CASE M.PA='0'
RETURN '零'
CASE M.PA='1'
RETURN '壹'
CASE M.PA='2'
RETURN '贰'
CASE M.PA='3'
RETURN '叁'
CASE M.PA='4'
RETURN '肆'
CASE M.PA='5'
RETURN '伍'
CASE M.PA='6'
RETURN '陆'
CASE M.PA='7'
RETURN '柒'
CASE M.PA='8'
RETURN '捌'
CASE M.PA='9'
RETURN '玖'
CASE M.PA='.'
RETURN ''
ENDCASE
function dx
PARAMETER M.PA
PRIVATE M.ZERO, M.VALU, M.STR, M.LENG, A, M.ZERO1
M.ZERO = .F.
M.ZERO1 = .F.
M.VALU = ''
M.STR = ALLTRIM(STR(M.PA,14,2))
M.LENG = LEN(M.STR)
A = 0
DO WHILE A<=M.LENG
DO CASE
CASE M.LENG-A=12
M.VALU = M.VALU+CONVDX(SUBSTR(M.STR,A+1,1))+'亿'
CASE M.LENG-A=11
M.ZERO1 = (SUBSTR(M.STR,A+1,1)=='0')
M.VALU = M.VALU+CONVDX(SUBSTR(M.STR,A+1,1))+IIF(M.ZERO1,'','仟')
CASE M.LENG-A=10 .OR. M.LENG-A=6
M.ZERO = (SUBSTR(M.STR,A+1,1)=='0')
IF M.ZERO
IF M.ZERO1
M.VALU = M.VALU
ELSE
M.VALU = M.VALU+'零'
ENDIF
ELSE
M.VALU = M.VALU+CONVDX(SUBSTR(M.STR,A+1,1))+'佰'
ENDIF
M.ZERO1 = M.ZERO
CASE M.LENG-A=9 .OR. M.LENG-A=5
M.ZERO = (SUBSTR(M.STR,A+1,1)=='0')
IF M.ZERO
IF M.ZERO1
M.VALU = M.VALU
ELSE
M.VALU = M.VALU+'零'
ENDIF
ELSE
M.VALU = M.VALU+CONVDX(SUBSTR(M.STR,A+1,1))+'拾'
ENDIF
M.ZERO1 = M.ZERO
CASE M.LENG-A=8
M.ZERO = (SUBSTR(M.STR,A+1,1)=='0')
IF M.ZERO
IF M.ZERO1
M.VALU = M.VALU+'万'
ELSE
M.VALU = M.VALU+'万零'
ENDIF
ELSE
M.VALU = M.VALU+CONVDX(SUBSTR(M.STR,A+1,1))+'万'
ENDIF
IF SUBSTR(M.VALU,LEN(M.VALU)-3,2)=='零'
M.VALU = SUBSTR(M.VALU,1,LEN(M.VALU)-4)+'万零'
ENDIF
M.ZERO1 = M.ZERO
CASE M.LENG-A=7
M.ZERO = (SUBSTR(M.STR,A+1,1)=='0')
IF M.ZERO
IF M.ZERO1
M.VALU = M.VALU
ELSE
M.VALU = M.VALU+'零'
ENDIF
ELSE
M.VALU = M.VALU+CONVDX(SUBSTR(M.STR,A+1,1))+'仟'
ENDIF
M.ZERO1 = M.ZERO
CASE M.LENG-A=4
M.ZERO = (SUBSTR(M.STR,A+1,1)=='0')
IF M.ZERO
M.VALU = M.VALU+'圆'
ELSE
M.VALU = M.VALU+CONVDX(SUBSTR(M.STR,A+1,1))+'圆'
ENDIF
M.ZERO1 = M.ZERO
ENDCASE
A = A+1
ENDDO
IF SUBSTR(M.VALU,LEN(M.VALU)-3,2)=='零'
M.VALU = SUBSTR(M.VALU,1,LEN(M.VALU)-4)+'圆'
ENDIF
IF M.PA=INT(M.PA)
M.VALU = M.VALU+'整'
ELSE
IF SUBSTR(M.STR,M.LENG,1)=='0'
M.VALU = M.VALU+CONVDX(SUBSTR(M.STR,M.LENG-1,1))+'角整'
ELSE
M.VALU = M.VALU+CONVDX(SUBSTR(M.STR,M.LENG-1,1))+'角'+CONVDX(SUBSTR(M.STR,M.LENG,1))+'分'
ENDIF
ENDIF
RETURN M.VALU
哇,好长!
我也给一个吧
*-------vfp-------
G='零壹贰叁肆伍陆柒捌玖'
H='分角圆拾佰仟万拾佰仟亿拾'
K=' '
DD1=YS1*100
DX0=STR(DD1)
DXA=ALLT(DX0)
DX1=LEN(DXA)
D=1
DO WHILE D<DX1.OR.D=DX1
DY=DX1-D+1
F=SUBSTR(DXA,DY,1)
* IF F<>'.'
F1=VAL(F)*2+1
G1=SUBSTR(G,F1,2)
D1=D*2-1
H1=SUBSTR(H,D1,2)
K1=G1+H1
K=K1+K
* ELSE
* ENDI
D=D+1
ENDDO
REPL ALL DX with K FOR ALLT(XH)='合 计'