INFORMIX 4GL写的转换成大写金额字串的函数
######################################### 这个函数输入金额,返回大写汉字金额 ##
## bellchiu AT NanJing CITIC :em13: ##
#######################################
FUNCTION F_CONV_GB(pf_money)
DEFINE pf_money DECIMAL(14,2)
DEFINE ll_money INTEGER
DEFINE i SMALLINT
DEFINE li_bit SMALLINT
DEFINE li_length SMALLINT
DEFINE li_len SMALLINT
DEFINE ls_moneyCHAR(20)
DEFINE ls_result CHAR(64)
DEFINE ls_arr_num ARRAY OF CHAR(2)
DEFINE ls_arr_unitARRAY OF CHAR(2)
DEFINE ls_arr_unit0 ARRAY OF CHAR(2)
LET ls_arr_num ='壹'
LET ls_arr_num ='贰'
LET ls_arr_num ='叁'
LET ls_arr_num ='肆'
LET ls_arr_num ='伍'
LET ls_arr_num ='陆'
LET ls_arr_num ='柒'
LET ls_arr_num ='捌'
LET ls_arr_num ='玖'
LET ls_arr_num='零'
LETls_arr_unit[ 1] = '分'
LETls_arr_unit[ 2] = '角'
LETls_arr_unit[ 3] = '元'
LETls_arr_unit[ 4] = '拾'
LETls_arr_unit[ 5] = '佰'
LETls_arr_unit[ 6] = '仟'
LETls_arr_unit[ 7] = '万'
LETls_arr_unit[ 8] = '拾'
LETls_arr_unit[ 9] = '佰'
LETls_arr_unit = '仟'
LETls_arr_unit = '亿'
LETls_arr_unit = '拾'
LETls_arr_unit = '佰'
LETls_arr_unit = '仟'
LETls_arr_unit0[ 1] = '整'
LETls_arr_unit0[ 2] = '零'
LETls_arr_unit0[ 3] = '元'
LETls_arr_unit0[ 4] = '零'
LETls_arr_unit0[ 5] = '零'
LETls_arr_unit0[ 6] = '零'
LETls_arr_unit0[ 7] = '万'
LETls_arr_unit0[ 8] = '零'
LETls_arr_unit0[ 9] = '零'
LETls_arr_unit0 = '零'
LETls_arr_unit0 = '亿'
LETls_arr_unit0 = '零'
LETls_arr_unit0 = '零'
LETls_arr_unit0 = '零'
IFpf_money=0 THEN
RETURN '零元整'
END IF
IF pf_money<0 THEN
LET pf_money=0 - pf_money
LET ls_result='负 '
ELSE
LET ls_result=''
END IF
IF pf_money>;999999999999.99 THEN
RETURN ls_result='数值超出范围'
END IF
LET ls_money=pf_money*100 USING "<<<<<<<<<<<<<<"
LET li_length=length(ls_money CLIPPED)
for i=1 to li_length
LET li_bit=ls_money
if li_bit=0 then
LET li_len=length(ls_result CLIPPED)
if ls_result<>;'零' then
LET ls_result = ls_result CLIPPED, ls_arr_unit0
else
LET ls_result = ls_result,
ls_arr_unit0
end if
else
LET ls_result = ls_result CLIPPED, ls_arr_num,
ls_arr_unit
end if
END FOR
return ls_result CLIPPED
END FUNCTION
****帮你加上code,格式就好看了！ Admirer
INFORMIX 4GL写的转换成大写金额字串的函数
不知道为什么缩进都没有了 ! 大家凑合着看.其中:
DEFINE ls_arr_unit0 ARRAY OF CHAR(2)
数组的用法很高效, 很特别.
INFORMIX 4GL写的转换成大写金额字串的函数
不错~~~~~~~~~~INFORMIX 4GL写的转换成大写金额字串的函数
如果能寫個英文最好不過了！INFORMIX 4GL写的转换成大写金额字串的函数
不错！INFORMIX 4GL写的转换成大写金额字串的函数
设计方法新颖。INFORMIX 4GL写的转换成大写金额字串的函数
寫得不錯!頂! #---------------------------------------------------------------------#
# -- 將一串數字返回漢字大寫 -- zwx
# -- Ssta='S',簡短型 50010.00:(伍萬 零 壹拾 圓 零角 零分)
# -- Ssta='L',完整型 50010.00:(伍萬 零仟 零佰 壹拾 零圓 零角 零分)
#---------------------------------------------------------------------#
FUNCTION num_to_upcode(Snum,Ssta)
DEFINE Snum DEC(16,2),
Ssta CHAR(1),
S1str CHAR(20),
S3str CHAR(2),
Snstr CHAR(100),
Srstr CHAR(100),
Slen INT,
Scnt INT,
St1 INT,
St2 INT,
St3 INT
LET S1str = Snum
# display 'Input:',Snum,' -- >',S1str
LET Slen = LENGTH(S1str)
FOR St1 = 1 TO Slen
IFS1str = '.' THEN
EXIT FOR
END IF
END FOR
LET Snstr = NULL
LET S3str = ' '
FOR St2 = 1 TO Slen
LET St3 = St1 - St2
LET S3str = ' '
CALL num_1to_upcode(S1str) RETURNING S3str
LET Snstr = Snstr CLIPPED,S3str CLIPPED
LET Snstr = Snstr CLIPPED
LET Scnt = LENGTH(Snstr)
IFScnt > 4 THEN
IFSnstr = '零零' THEN
LETSnstr = ''
END IF
END IF
IFS1str = '-' THEN
CONTINUE FOR
END IF
LET S3str = ' '
CALL num_2to_upcode(St3) RETURNING S3str
LET Snstr = Snstr CLIPPED,S3str CLIPPED
IFSsta = 'S' THEN
LET Snstr = Snstr CLIPPED
LET Scnt = LENGTH(Snstr)
IFScnt > 4 THEN
IFSnstr = '零圓' OR
Snstr = '零萬' OR
Snstr = '零億' OR
Snstr = '零兆' THEN
LET Snstr = Snstr
LET Snstr = ''
END IF
END IF
LET Snstr = Snstr CLIPPED
LET Scnt= LENGTH(Snstr)
IFScnt > 4 THEN
IFSnstr = '兆億' OR
Snstr = '兆萬' OR
Snstr = '零拾' OR
Snstr = '零佰' OR
Snstr = '零仟' OR
Snstr = '億萬' THEN
LET Snstr = '零'
END IF
END IF
END IF
LET Snstr = Snstr CLIPPED
LET Scnt = LENGTH(Snstr)
IFScnt > 4 THEN
IFSnstr = '零零' THEN
LETSnstr = ''
END IF
END IF
END FOR
#display 'Output:-- >',Snstr
# -- 格式調整，加空格
LET Srstr = "（"
LET Snstr = Snstr CLIPPED
LET Slen = LENGTH(Snstr)
FOR St2 = 1 TO Slen/2
LET St1 = St2 * 2
LET S3str = Snstr
IFS3str MATCHES '[負兆億萬仟佰拾圓角]' THEN
LET Srstr = Srstr CLIPPED,S3str,'_'
ELSE
IFS3str MATCHES '[零]' AND St2 <= Slen/2-4 AND
Ssta = 'S' THEN
LET Srstr = Srstr CLIPPED
LET Scnt = LENGTH(Srstr)
IFSrstr = '_' THEN
LET Srstr = Srstr CLIPPED,S3str,'_'
ELSE
LET Srstr = Srstr CLIPPED,'_',S3str,'_'
END IF
ELSE
LET Srstr = Srstr CLIPPED,S3str
END IF
END IF
END FOR
LET Srstr = Srstr CLIPPED,'）'
LET Srstr = Srstr CLIPPED
LET Slen = LENGTH(Srstr)
FOR St2 = 1 TO Slen
IFSrstr = '_' THEN
LET Srstr = ' '
END IF
END FOR
# display 'Return:-- >',Srstr
RETURN Srstr
END FUNCTION
#---------------------------------------------------------------------#
# -- 將一個數字返回漢字名稱 --zwx
#---------------------------------------------------------------------#
FUNCTION num_1to_upcode(Snum)
DEFINE Snum CHAR(1),
Sstr CHAR(2)
LET Sstr = ' '
CASE
WHEN Snum = '-'
LET Sstr = '負'
WHEN Snum = '0'
LET Sstr = '零'
WHEN Snum = '1'
LET Sstr = '壹'
WHEN Snum = '2'
LET Sstr = '貳'
WHEN Snum = '3'
LET Sstr = '參'
WHEN Snum = '4'
LET Sstr = '肆'
WHEN Snum = '5'
LET Sstr = '伍'
WHEN Snum = '6'
LET Sstr = '陸'
WHEN Snum = '7'
LET Sstr = '柒'
WHEN Snum = '8'
LET Sstr = '捌'
WHEN Snum = '9'
LET Sstr = '玖'
END CASE
RETURN Sstr
END FUNCTION
#---------------------------------------------------------------------#
# -- 返回數字對應的位數代碼 --zwx
#---------------------------------------------------------------------#
FUNCTION num_2to_upcode(Snum)
DEFINE Snum INT,
Sstr CHAR(2)
LET Sstr = ' '
CASE
WHEN Snum MOD 4 = 2
LET Sstr = '拾'
WHEN Snum MOD 4 = 3
LET Sstr = '佰'
WHEN Snum MOD 4 = 0 AND Snum > 0
LET Sstr = '仟'
WHEN Snum = 5
LET Sstr = '萬'
WHEN Snum = 9
LET Sstr = '億'
WHEN Snum = 13
LET Sstr = '兆'
WHEN Snum = 0
LET Sstr = '圓'
WHEN Snum = -1
LET Sstr = '角'
WHEN Snum = -2
LET Sstr = '分'
END CASE
RETURN Sstr
END FUNCTION
呵呵,谢谢楼主了~~~~~~~~~~~ 謝謝樓主和8樓的朋友，學習了！
页:
[1]