INFORMIX 4GL写的转换成大写金额字串的函数

bellchiu

1. #######################################
   
2. ## 这个函数输入金额,返回大写汉字金额 ##
   
3. ## bellchiu AT NanJing CITIC    :em13:       ##
   
4. #######################################
   
5. FUNCTION F_CONV_GB(pf_money)
   
6. DEFINE pf_money DECIMAL(14,2)
   
7. 
   
8. DEFINE ll_money        INTEGER
   
9. DEFINE i                 SMALLINT
   
10. DEFINE li_bit        SMALLINT
    
11. DEFINE li_length SMALLINT
    
12. DEFINE li_len    SMALLINT
    
13. DEFINE ls_money  CHAR(20)
    
14. DEFINE ls_result CHAR(64)
    
15. 
    
16. DEFINE ls_arr_num   ARRAY [10] OF CHAR(2)
    
17. DEFINE ls_arr_unit  ARRAY [14] OF CHAR(2)
    
18. DEFINE ls_arr_unit0 ARRAY [14] OF CHAR(2)
    
19. 
    
20. LET ls_arr_num[1] ='壹'
    
21. LET ls_arr_num[2] ='贰'
    
22. LET ls_arr_num[3] ='叁'
    
23. LET ls_arr_num[4] ='肆'
    
24. LET ls_arr_num[5] ='伍'
    
25. LET ls_arr_num[6] ='陆'
    
26. LET ls_arr_num[7] ='柒'
    
27. LET ls_arr_num[8] ='捌'
    
28. LET ls_arr_num[9] ='玖'
    
29. LET ls_arr_num[10]='零'
    
30. 
    
31. LET  ls_arr_unit[ 1] = '分'
    
32. LET  ls_arr_unit[ 2] = '角'
    
33. LET  ls_arr_unit[ 3] = '元'
    
34. LET  ls_arr_unit[ 4] = '拾'
    
35. LET  ls_arr_unit[ 5] = '佰'
    
36. LET  ls_arr_unit[ 6] = '仟'
    
37. LET  ls_arr_unit[ 7] = '万'
    
38. LET  ls_arr_unit[ 8] = '拾'
    
39. LET  ls_arr_unit[ 9] = '佰'
    
40. LET  ls_arr_unit[10] = '仟'
    
41. LET  ls_arr_unit[11] = '亿'
    
42. LET  ls_arr_unit[12] = '拾'
    
43. LET  ls_arr_unit[13] = '佰'
    
44. LET  ls_arr_unit[14] = '仟'
    
45. 
    
46. LET  ls_arr_unit0[ 1] = '整'
    
47. LET  ls_arr_unit0[ 2] = '零'
    
48. LET  ls_arr_unit0[ 3] = '元'
    
49. LET  ls_arr_unit0[ 4] = '零'
    
50. LET  ls_arr_unit0[ 5] = '零'
    
51. LET  ls_arr_unit0[ 6] = '零'
    
52. LET  ls_arr_unit0[ 7] = '万'
    
53. LET  ls_arr_unit0[ 8] = '零'
    
54. LET  ls_arr_unit0[ 9] = '零'
    
55. LET  ls_arr_unit0[10] = '零'
    
56. LET  ls_arr_unit0[11] = '亿'
    
57. LET  ls_arr_unit0[12] = '零'
    
58. LET  ls_arr_unit0[13] = '零'
    
59. LET  ls_arr_unit0[14] = '零'
    
60. 
    
61. IF  pf_money=0 THEN
    
62.         RETURN '零元整'
    
63. END IF
    
64. IF pf_money<0 THEN
    
65.         LET pf_money=0 - pf_money
    
66.         LET ls_result='负 '
    
67. ELSE
    
68.         LET ls_result=''
    
69. END IF
    
70. IF pf_money>;999999999999.99 THEN
    
71.         RETURN ls_result='数值超出范围'
    
72. END IF
    
73. 
    
74. LET ls_money=pf_money*100 USING "<<<<<<<<<<<<<<"
    
75. LET li_length=length(ls_money CLIPPED)
    
76. 
    
77. for i=1 to li_length
    
78. 
    
79.         LET li_bit=ls_money[i]
    
80.                
    
81.         if li_bit=0 then
    
82.                 LET li_len=length(ls_result CLIPPED)
    
83.                 if ls_result[li_len - 1, li_len]<>;'零' then
    
84.                         LET ls_result = ls_result CLIPPED, ls_arr_unit0[li_length - i + 1]
    
85.                 else
    
86.                         LET ls_result = ls_result[1, li_len - 2],
    
87.                                                          ls_arr_unit0[li_length - i + 1]
    
88.                 end if
    
89.         else
    
90.                 LET ls_result = ls_result CLIPPED, ls_arr_num[li_bit],
    
91.                                                 ls_arr_unit [li_length -i + 1]
    
92.         end if
    
93. END FOR
    
94. 
    
95. return ls_result CLIPPED
    
96. 
    
97. END FUNCTION

复制代码

****帮你加上code,格式就好看了！ Admirer

bellchiu

不知道为什么缩进都没有了 ! 大家凑合着看.
其中:
DEFINE ls_arr_unit0 ARRAY [14] OF CHAR(2)

数组的用法很高效, 很特别.

czw1413_cn

不错~~~~~~~~~~

dintan

如果能寫個英文最好不過了！

mxf6666

不错！

john_student

设计方法新颖。

wjj9912130

寫得不錯!
頂!

star_zheng

#---------------------------------------------------------------------#
# -- 將一串數字返回漢字大寫 -- 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
        IF  S1str[St1] = '.' 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[St2]) RETURNING S3str
        LET Snstr = Snstr CLIPPED,S3str CLIPPED
        LET Snstr = Snstr CLIPPED
        LET Scnt = LENGTH(Snstr)
        IF  Scnt > 4 THEN
            IF  Snstr[Scnt-3,Scnt] = '零零' THEN
                LET  Snstr[Scnt-1,Scnt] = '  '
            END IF
        END IF
        IF  S1str[st2] = '-' THEN
            CONTINUE FOR
        END IF
        LET S3str = ' '
        CALL num_2to_upcode(St3) RETURNING S3str
        LET Snstr = Snstr CLIPPED,S3str CLIPPED
        IF  Ssta = 'S' THEN
            LET Snstr = Snstr CLIPPED
            LET Scnt = LENGTH(Snstr)
            IF  Scnt > 4 THEN
                IF  Snstr[Scnt-3,Scnt] = '零圓' OR
                    Snstr[Scnt-3,Scnt] = '零萬' OR
                    Snstr[Scnt-3,Scnt] = '零億' OR
                    Snstr[Scnt-3,Scnt] = '零兆' THEN
                    LET Snstr[Scnt-3,Scnt-2] = Snstr[Scnt-1,Scnt]
                    LET Snstr[Scnt-1,Scnt] = '  '
                END IF
            END IF
            LET Snstr = Snstr CLIPPED
            LET Scnt  = LENGTH(Snstr)
            IF  Scnt > 4 THEN
                IF  Snstr[Scnt-3,Scnt] = '兆億' OR
                    Snstr[Scnt-3,Scnt] = '兆萬' OR
                    Snstr[Scnt-3,Scnt] = '零拾' OR
                    Snstr[Scnt-3,Scnt] = '零佰' OR
                    Snstr[Scnt-3,Scnt] = '零仟' OR
                    Snstr[Scnt-3,Scnt] = '億萬' THEN
                    LET Snstr[Scnt-1,Scnt] = '零'
                END IF
            END IF
        END IF
        LET Snstr = Snstr CLIPPED
        LET Scnt = LENGTH(Snstr)
        IF  Scnt > 4 THEN
            IF  Snstr[Scnt-3,Scnt] = '零零' THEN
                LET  Snstr[Scnt-1,Scnt] = '  '
            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[St1-1,St1]
        IF  S3str MATCHES '[負兆億萬仟佰拾圓角]' THEN
            LET Srstr = Srstr CLIPPED,S3str,'_'
        ELSE
            IF  S3str MATCHES '[零]' AND St2 <= Slen/2-4 AND
                Ssta = 'S' THEN
                LET Srstr = Srstr CLIPPED
                LET Scnt = LENGTH(Srstr)
                IF  Srstr[Scnt] = '_' 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
        IF  Srstr[St2] = '_' THEN
            LET Srstr[St2] = ' '
        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

yezj2004

呵呵,谢谢楼主了~~~~~~~~~~~

shenhuawd

謝謝樓主和8樓的朋友，學習了！