求小写的金额转成大写金额的程式～

大肥肥

COBOL写的，编译出来就可以直接用了，编译方法和rpg一样。
  
    * FUNCTION: CGANHE NUMBER INTO CHINESE                                  *
      *     INPUT : STRING                                                    *
      *     OUTPUT : PRINT                                                    *
       *************************************************************************
       IDENTIFICATION   DIVISION.
       PROGRAM-ID.   CONVERT.


       ENVIRONMENT DIVISION.
       DATA DIVISION.

       WORKING-STORAGE SECTION.
       77   MIDDATA    PIC X(15).
       77   I          PIC 99 .
       77   K          PIC 99.
       77   PD         PIC 99.
       77   PP         PIC 99.
       77   PM         PIC 99.
       77   LEN        PIC 99.
       77   ZSLEN      PIC 99.
       77   MIDLEN     PIC 99.
       77   MIDNUM     PIC X.
       77   J          PIC 99.
       77   YI         PIC X(4) VALUE '壹'.
       77   ER         PIC X(4) VALUE '贰'.
       77   SHAN       PIC X(4) VALUE '叁'.
       77   SHI        PIC X(4) VALUE '肆'.
       77   WU         PIC X(4) VALUE '伍'.
       77   LIU        PIC X(4) VALUE '陆'.
       77   QI         PIC X(4) VALUE '柒'.
       77   BA         PIC X(4) VALUE '捌'.
       77   JIU        PIC X(4) VALUE '玖'.
       77   LING       PIC X(4) VALUE '零'.
       77   YUAN       PIC X(4) VALUE '元'.
       77   JIAO       PIC X(4) VALUE '角'.
       77   FEN        PIC X(4) VALUE '分'.
       77   YIYI       PIC X(4) VALUE '亿'.
       77   WAN        PIC X(4) VALUE '万'.
       77   QIAN       PIC X(4) VALUE '仟'.
       77   BAI        PIC X(4) VALUE '佰'.
       77   SI         PIC X(4) VALUE '拾'.
       77   ZHENG      PIC X(4) VALUE '整'.
       77   ZHONWEN    PIC X(2) VALUE SPACE.

            01   MIDSTR     PIC X(40) VALUE SPACE.

          01   RSTSTR     PIC X(40) VALUE SPACE.
       77   XIAOSHU    PIC 99   VALUE 0.
       77   XSHU       PIC 99   VALUE 0.
       77   TESTTMP    PIC X    VALUE SPACE.
       77   L          PIC 99 .
       77   TMPV       PIC X(4) VALUE SPACE.

       LINKAGE SECTION.

  77   INPUTDATA  PIC X(15) VALUE SPACE.
  77   OUTDATA    PIC X(40).

       PROCEDURE DIVISION USING INPUTDATA, OUTDATA.
       MAIN-PROGRAM.
            PERFORM INITIAL-PHASE.
            PERFORM DETAIL-PHASE THRU END-DETAIL-PHASE.
            PERFORM END-PHASE.
       INITIAL-PHASE.
            MOVE 0  TO XIAOSHU.
            MOVE 0 TO XSHU.
            MOVE SPACE TO OUTDATA.
            MOVE SPACE TO MIDDATA.
            MOVE SPACE TO MIDSTR.
            MOVE SPACE TO RSTSTR.
            MOVE SPACE TO MIDNUM.
       DETAIL-PHASE.
            MOVE 1 TO I .
            MOVE INPUTDATA TO MIDDATA.
            PERFORM COUNT-LENGTH THRU C-END UNTIL MIDDATA(I:1) = SPACE.
            IF LEN = 1
               GO TO END-DETAIL-PHASE
            END-IF.

            IF MIDDATA(1:1) = '0' AND MIDDATA = '0.00'

               MOVE LING TO OUTDATA
               GO TO END-DETAIL-PHASE
            END-IF.
            SUBTRACT 2 FROM LEN GIVING MIDLEN.
            MOVE MIDDATA(MIDLEN:1) TO TESTTMP.
            IF MIDDATA(MIDLEN:1) = '.'
                 SUBTRACT 3 FROM LEN GIVING ZSLEN
            ELSE
                 MOVE LEN TO ZSLEN
            END-IF.
            MOVE 1 TO J.
            MOVE YI(1:1) TO MIDSTR(J:1) .
            ADD 1 TO J .
            EVALUATE ZSLEN
               WHEN  1
                 MOVE MIDDATA(1:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE YUAN(2:2) TO  MIDSTR(J:4)
               WHEN  2
                 MOVE MIDDATA(1:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE SI(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(2:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE YUAN(2:2)  TO MIDSTR(J:2)
              WHEN 3
                 MOVE MIDDATA(1:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE BAI(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(2:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE SI(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(3:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE YUAN(2:2)  TO MIDSTR(J:2)
              WHEN 4
                 MOVE MIDDATA(1:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE QIAN(2:2)  TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(2:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE BAI(2:2)  TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(3:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE SI(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(4:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE YUAN(2:2) TO MIDSTR(J:2)
             WHEN 5
                 MOVE MIDDATA(1:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE WAN(2:2)  TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(2:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE QIAN(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(3:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE BAI(2:2)  TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(4:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE SI(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(5:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE YUAN(2:2) TO MIDSTR(J:2)
             WHEN 6
                 MOVE MIDDATA(1:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE SI(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(2:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE WAN(2:2)  TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(3:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE QIAN(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(4:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE BAI(2:2)  TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(5:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE SI(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(6:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE YUAN(2:2) TO MIDSTR(J:2)

大肥肥

WHEN 7
                 MOVE MIDDATA(1:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE BAI(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(2:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE SI(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(3:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE WAN(2:2)  TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(4:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE QIAN(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(5:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE BAI(2:2)  TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(6:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE SI(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(7:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE YUAN(2:2) TO MIDSTR(J:2)
             WHEN 8
                 MOVE MIDDATA(1:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE QIAN(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(2:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE BAI(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(3:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE SI(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(4:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE WAN(2:2)  TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(5:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE QIAN(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(6:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE BAI(2:2)  TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(7:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE SI(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(8:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE YUAN(2:2) TO MIDSTR(J:2)
             WHEN 9
                 MOVE MIDDATA(1:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE YIYI(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(2:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE QIAN(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(3:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE BAI(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(4:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE SI(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(5:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE WAN(2:2)  TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(6:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE QIAN(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(7:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE BAI(2:2)  TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(8:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE SI(2:2) TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE MIDDATA(9:1) TO MIDNUM
                 PERFORM CHANGE-PHASE
                 MOVE ZHONWEN TO MIDSTR(J:2)
                 ADD 2 TO J
                 MOVE YUAN(2:2) TO MIDSTR(J:2)
            END-EVALUATE.
            IF ZSLEN < LEN
                 PERFORM TRANS-XIAOSHU THRU TRANS-XIAOSHU-END
            END-IF.
                 ADD 2 TO J.
                 MOVE YI(4:1) TO MIDSTR(J:1).
      * MOVE AWAY ZERO
                 PERFORM MOVE-AWAY-ZERO THRU MOVE-AWAY-ZERO-END.
                 MOVE RSTSTR TO OUTDATA.
       END-DETAIL-PHASE.
       TRANS-XIAOSHU.
                 MOVE ZSLEN TO XIAOSHU.
                 ADD 2 TO XIAOSHU.
                 MOVE XIAOSHU TO XSHU.
                 ADD 2 TO J   .
                 IF MIDDATA(XIAOSHU:2) = '00'
                   SUBTRACT 2 FROM J
                   GO TO TRANS-XIAOSHU-END
                 END-IF.
                 IF MIDDATA(XIAOSHU:1) = '0'
                     MOVE MIDDATA(XIAOSHU:1) TO MIDNUM
                     PERFORM CHANGE-PHASE
                     MOVE ZHONWEN  TO MIDSTR(J:2)
                     ADD 2 TO J
                     ADD 1 TO XIAOSHU
                     MOVE MIDDATA(XIAOSHU:1) TO MIDNUM
                     PERFORM CHANGE-PHASE
                     MOVE ZHONWEN TO MIDSTR(J:2)
                     ADD 2 TO J
                     MOVE FEN(2:2) TO MIDSTR(J:2)
                 ELSE
      *          IF MIDDATA(XIAOSHU:1) NOT EQUAL '0'
                     MOVE MIDDATA(XIAOSHU:1) TO MIDNUM
                     PERFORM CHANGE-PHASE
                     MOVE ZHONWEN TO MIDSTR(J:2)
                     ADD 2 TO J
                     MOVE JIAO(2:2) TO MIDSTR(J:2)
      *              ADD 2 TO J
                     ADD 1 TO XIAOSHU
                     IF MIDDATA(XIAOSHU:1) = '0'
                        GO TO  TRANS-XIAOSHU-END
                     END-IF
                     ADD 2 TO J
                     MOVE MIDDATA(XIAOSHU:1) TO MIDNUM
                     PERFORM CHANGE-PHASE
                     MOVE ZHONWEN TO MIDSTR(J:2)
                     ADD 2 TO J
                     MOVE FEN(2:2) TO MIDSTR(J:2)
                END-IF.
       TRANS-XIAOSHU-END.
       COUNT-LENGTH.
            MOVE I TO LEN.
            ADD 1 TO I.
       C-END.
       END-PHASE.
            GOBACK.
      *     EXIT PROGRAM.
       CHANGE-PHASE.
            EVALUATE MIDNUM
               WHEN '1'
                 MOVE YI(2:2) TO ZHONWEN
               WHEN '2'
                 MOVE ER(2:2) TO ZHONWEN
               WHEN '3'
                 MOVE SHAN(2:2) TO ZHONWEN
               WHEN '4'
                 MOVE SHI(2:2) TO ZHONWEN
               WHEN '5'
                 MOVE WU(2:2) TO ZHONWEN
               WHEN '6'
                 MOVE LIU(2:2) TO ZHONWEN
               WHEN '7'
                 MOVE QI(2:2) TO ZHONWEN
               WHEN '8'
                 MOVE BA(2:2) TO ZHONWEN
               WHEN '9'
                 MOVE JIU(2:2) TO ZHONWEN
               WHEN '0'
                 MOVE LING(2:2) TO ZHONWEN
            END-EVALUATE.
       MOVE-AWAY-ZERO.
           MOVE MIDSTR(1:5) TO RSTSTR(1:5).
           IF MIDSTR(6:1) = YI(4:1)
              MOVE ZHENG(2:2) TO RSTSTR(6:2)
              MOVE YI(4:1) TO RSTSTR(8:1)
           ELSE
              MOVE 6 TO K
              MOVE 6 TO L
              PERFORM CHECK-ZERO THRU CHECK-ZERO-END UNTIL K = J
           END-IF.
       MOVE-AWAY-ZERO-END.
       CHECK-ZERO.
           IF MIDSTR(K:2) = LING(2:2)
                PERFORM WRITE-ZERO THRU WRITE-ZERO-END
                UNTIL MIDSTR(K:2) NOT EQUAL LING(2:2)
                IF MIDSTR(K:2) = YI(4:1)
                   MOVE YI(4:1) TO RSTSTR(L:1)
                   GO TO CHECK-ZERO-END
                END-IF

                IF MIDSTR(K:2) = FEN(2:2)
                    SUBTRACT 2 FROM K GIVING PD
                    MOVE MIDSTR(PD:2) TO RSTSTR(L:2)
                    ADD 2 TO L
                    MOVE FEN(2:2) TO RSTSTR(L:2)
                    ADD 2 TO L
                    MOVE YI(4:1) TO RSTSTR(L:1)
                    MOVE J TO K
                    GO TO CHECK-ZERO-END
                END-IF
                MOVE LING(2:2) TO RSTSTR(L:2)
                ADD 2 TO L
                MOVE YI(1:1) TO TMPV(1:1)
                MOVE MIDSTR(K:2) TO TMPV(2:2)
                MOVE YI(4:1) TO TMPV(4:1)
                MOVE MIDSTR(K:2) TO RSTSTR(L:2)
                ADD 2 TO K
                ADD 2 TO L
                MOVE YI(1:1) TO TMPV(1:1)
                MOVE MIDSTR(K:2) TO TMPV(2:2)
                MOVE YI(4:1)  TO TMPV(4:1)
                MOVE MIDSTR(K:2) TO RSTSTR(L:2)

                ADD 2 TO K
                ADD 2 TO L
                IF MIDSTR(K:2) = YI(4:1) AND TMPV(2:2) = YUAN(2:2)
                   MOVE ZHENG(2:2) TO RSTSTR(L:2)
                   ADD 2 TO L
                   MOVE YI(4:1) TO RSTSTR(L:1)
                   GO TO CHECK-ZERO-END
            ELSE
E90631             MOVE YI(4:1) TO RSTSTR(L:1)
                END-IF
           ELSE
                IF MIDSTR(K:1) = YI(4:1)
                    MOVE YI(4:1) TO RSTSTR(L:1)
                    GO TO CHECK-ZERO-END
                END-IF

                MOVE MIDSTR(K:2)  TO RSTSTR(L:2)
                ADD 2 TO K
                ADD 2 TO L
                MOVE MIDSTR(K:2) TO RSTSTR(L:2)
                IF  MIDSTR(K:2) = YUAN(2:2) AND MIDDATA(XSHU:2) = '00'
                   ADD 2 TO L
                   MOVE ZHENG(2:2) TO RSTSTR(L:2)
                   ADD 2 TO L
                   MOVE YI(4:1) TO RSTSTR(L:1)
                   MOVE J TO K
                   GO TO CHECK-ZERO-END
                END-IF
                IF MIDSTR(K:2) = FEN(2:2)
                   ADD 2 TO L
                   MOVE YI(4:1) TO RSTSTR(L:1)
                   MOVE J TO K
                   GO TO CHECK-ZERO-END
                END-IF
                ADD 2 TO K
                ADD 2 TO L
                IF MIDSTR(K:1) = YI(4:1)
                   MOVE YI(4:1) TO RSTSTR(L:1)
                   GO TO CHECK-ZERO-END
                END-IF
           END-IF.
       CHECK-ZERO-END.

       WRITE-ZERO.
                 SUBTRACT 2 FROM K GIVING PP.
                 ADD 2, K GIVING PM.
                 IF MIDSTR(PP:2) = SI(2:2) AND MIDSTR(PM:2) = YUAN(2:2)
                     MOVE YUAN(2:2) TO RSTSTR(L:2)
                     ADD 2 TO L
                     IF  MIDDATA(XSHU:2) = '00'
                        MOVE ZHENG(2:2) TO RSTSTR(L:2)
                        ADD 2 TO L
                     END-IF
                 END-IF.
                 IF MIDSTR(PP:2) = SI(2:2) AND MIDSTR(PM:2) = WAN(2:2)
                     MOVE WAN(2:2)  TO RSTSTR(L:2)
                     ADD 2 TO L
                 END-IF.
                 ADD 4 TO K.
       WRITE-ZERO-END.

wyvern050

和你说下算法 你就能弄出来了
首先你要先把现有的数字截位
eg: 5678  首先要把5取出 判断其位置是 十位 百位 还是 千位 怎么判断千百十呢 取出5之后用原来的值除以取出来的5 得出的结构肯定是大于等于1000 小于10000的 这样就把除以之后的结果给为1000 tab 这样建立
     zhi      weishu
       10          十
    100         百
   1000        千
   。。。   。。。
用这个结果chain db   取值
然后用5去查找库 在库中应该这样写出tab
       alb     hanzi
         0         零
      1         壹
    。。。  。。。
然后用5去chain 这个tab 取出hanzi 段的值 给一个中间变量 在把上面取出的位置 例如 千 （这个千取值方法和取hanzi一样）   如此类推 最后程序结束怎们判断就不用我说了
-----------------------------------------------------------------------------
其实这个算法很简单 估计是楼主一时没想到吧

sater84

谢谢前辈，我明白您的意思了，谢谢您，我去试一试先～

uglyneo

不知道你有没有完成。最近才上论坛，看到这个觉得有点意思。闲来没事，就试了下。

一个汉字在400里面占用4个字节，第一个字节表示汉字开始，第二第三个字节表示该汉字，第四个字节表示汉字结束。

所以我自己写了个程序，希望对你有所帮助。（RPG3）
小写金额 14P 2
实现功能：输入小写金额：10010.11  大写金额“壹零壹十元壹角壹分”（这个零我是揣摸别人读数字时的习惯，所以不是正规的大写写法，关于这个习惯，N多人有N多种读法，本想改为大写写法，可我确实不知是不是应该写成“壹万零仟零百壹拾零元壹角一分”）
没有从LF READ，而是选择屏幕输入输出，相信改成READ 也比较简单。

写完没经过严密测试，可能会有不少BUG，欢迎指出。

显示文件（XZD010W）很简单，就一个小写金额字段：W1XX  14Y 2   大写金额字段：W1DX  58O
0000.30      A                                      DSPSIZ(24 80 *DS3)           
0000.31      A                                      CF01                        
0000.40      A          R XZD010W1                                               
0000.60      A                                  3 31' 小写金额转大写金额 '      
0000.70      A                                      DSPATR(RI)                  
0000.80      A                                  9 11' 请输入小写金额： '         
0000.90      A            W1XX          14Y 2B  9 30EDTCDE(1)                    
0001.00      A          R XZD010W2                                               
0001.20      A                                  3 31' 小写金额转大写金额 '      
0001.30      A                                      DSPATR(RI)                  
0001.40      A                                  9  3' 请输入小写金额： '         
0001.50      A            W1XX          14Y 2O  9 22EDTCDE(1)                    
0001.60      A                                 12  9' 大写金额： '               
0001.70      A            W1DX          58O  O 12 22DSPATR(UL)               

程序（XZD010）   
     FXZD010W CF  E                    WORKSTN               
     F*------------------------------------------            
     E                    TTT     1   9  4                  
     E                    TAB1    1  10  1 0 TAB2    4      
     E*----------------------------------------------------  
     I            DS                                         
     I                                        1   4 HZ      
     I                                        1   1 HB      
     I                                        2   3 HH      
     I                                        4   4 HE      
     I            DS                                         
     I                                        1   40SR      
     I                                        1   10QIAN     
     I                                        2   20BAI      
     I                                        3   30SHI      
     I                                        4   40GE      
     I            DS                                         
     I                                        1  142W1XX     
     I                                        1   40YD      
     I                                        5   80WD      
     I                                        9  120GD      
     I                                       13  140FD      
     I                                        1   10QY      
     I                                        2   20BY      
     I                                        3   30SY      
     I                                        4   40Y      
     I                                        5   50QW      
     I                                        6   60BW      
     I                                        7   70SW      
     I                                        8   80W      
     I                                        9   90Q      
     I                                       10  100B      
     I                                       11  110S      
     I                                       12  120G      
     I                                       13  130J      
     I                                       14  140F      
     I*-----------------------------------------------------
     C                     MOVEL*BLANK    W1XX              
     C           STEP01    TAG                              
     C                     EXFMTXZD010W1                        
     C   KA                GOTO END                              
     C                     MOVEL*BLANK    W1DX                  
     C           W1XX      IFEQ 0                                
     C           0         LOKUPTAB1      TAB2           90      
     C                     MOVELTAB2      HZ                     
     C                     MOVELHB        W1DX                  
     C                     CAT  HH:0      W1DX                  
     C                     MOVELTTT,3     HZ                     
     C                     CAT  HH:0      W1DX                  
     C                     MOVELTTT,9     HZ                     
     C                     CAT  HH:0      W1DX                  
     C                     CAT  HE:0      W1DX                  
     C                     GOTO STEP03                           
     C                     ENDIF                                 
     C                     MOVELTTT,3     HZ                     
     C                     MOVELHB        W1DX                  
     C           YD        CABEQ0                        70      
     C           WD        CABEQ0                        60      
     C           GD        CABEQ0                        50      
     C  N70                DO                                   
     C                     Z-ADDYD        SR                    
     C                     EXSR XZD                             
     C                     MOVELTTT,8     HZ                    
     C                     CAT  HH:0      W1DX                  
     C                     ENDDO                                
     C  N60                DO                                   
     C                     Z-ADDWD        SR                    
     C                     EXSR XZD                             
     C                     MOVELTTT,7     HZ                    
     C                     CAT  HH:0      W1DX                  
     C                     ENDDO                                
     C  N50                DO                                   
     C                     Z-ADDGD        SR                    
     C                     EXSR XZD                             
     C                     ENDDO                                
     C           *IN50     IFEQ '0'                             
     C           *IN60     OREQ '0'                             
     C           *IN70     OREQ '0'                             
     C                     MOVELTTT,3     HZ                    
     C                     CAT  HH:0      W1DX                 
     C                     ENDIF                              
     C           FD        IFEQ 0                              
     C                     MOVELTTT,9     HZ                  
     C                     CAT  HH:0      W1DX                 
     C                     ENDIF                              
     C           J         CABEQ0         TAGF                 
     C           J         LOKUPTAB1      TAB2           90   
     C   90                MOVELTAB2      HZ                  
     C                     CAT  HH:0      W1DX                 
     C                     MOVELTTT,2     HZ                  
     C                     CAT  HH:0      W1DX                 
     C           TAGF      TAG                                 
     C           F         CABEQ0         STEP02               
     C           F         LOKUPTAB1      TAB2           90   
     C                     MOVELTAB2      HZ                  
     C                     CAT  HH:0      W1DX                 
     C                     MOVELTTT,1     HZ                  
     C                     CAT  HH:0      W1DX                 
     C           STEP02    TAG                                 
     C                     CAT  HE:0      W1DX                  
     C           STEP03    TAG                                   
     C                     EXFMTXZD010W2                        
     C                     GOTO STEP01                           
     C           END       TAG                                   
     C                     SETON                     LR         
     C                     RETRN                                 
     C*-------------------------------------------------------   
     C           XZD       BEGSR                                 
     C           QIAN      CABNE0                    51         
     C           BAI       CABNE0                    52         
     C           SHI       CABNE0                    53         
     C           GE        CABNE0                    54         
     C           SR        IFEQ GD                              
     C           YD        IFNE 0                                
     C           WD        ORNE 0                                
     C  N51                DO                                    
     C           QIAN      LOKUPTAB1      TAB2           90      
     C                     MOVELTAB2      HZ                     
     C                     CAT  HH:0      W1DX                  
     C                     GOTO TAGB                          
     C                     ENDDO                              
     C                     ENDIF                              
     C                     ENDIF                              
     C  N51                GOTO TAGB                          
     C           QIAN      LOKUPTAB1      TAB2           90   
     C                     MOVELTAB2      HZ                  
     C                     CAT  HH:0      W1DX               
     C                     MOVELTTT,6     HZ                  
     C                     CAT  HH:0      W1DX               
     C           TAGB      TAG                                
     C  N52N53N54          GOTO XZDEND                        
     C  N51N52             GOTO TAGS                          
     C           BAI       LOKUPTAB1      TAB2           90   
     C                     MOVELTAB2      HZ                  
     C                     CAT  HH:0      W1DX               
     C  N52                GOTO TAGS                          
     C                     MOVELTTT,5     HZ                  
     C                     CAT  HH:0      W1DX               
     C           TAGS      TAG                                
     C  N53N54             GOTO XZDEND                       
     C  N52N53             GOTO TAGG                        
     C           SHI       LOKUPTAB1      TAB2           90  
     C                     MOVELTAB2      HZ                 
     C                     CAT  HH:0      W1DX               
     C  N53                GOTO TAGG                        
     C                     MOVELTTT,4     HZ                 
     C                     CAT  HH:0      W1DX               
     C           TAGG      TAG                              
     C  N54                GOTO XZDEND                       
     C           GE        LOKUPTAB1      TAB2           90  
     C                     MOVELTAB2      HZ                 
     C                     CAT  HH:0      W1DX               
     C           XZDEND    ENDSR                             
** TTT                                                      
分                                                         
角                                                         
元                                                         
拾                                                         
佰                                                         
仟                                      
万                                      
亿                                      
整                                      
** TAB1 TAB2                             
0 零                                    
1 壹                                    
2 贰                                    
3 叁                                    
4 肆                                    
5 伍                                    
6 陆                                    
7 柒                                    
8 捌                                    
9 玖

[ 本帖最后由 uglyneo 于 2007-3-22 11:06 编辑 ]

pantierui

顶一下.

icefirer

你可以借鉴一下


      *=====================================================================
      *
     D yMsgRtnDDS    E DS                  EXTNAME( CMMsgStrPZ )
     D                                     PREFIX ( y :1 )
     D                                     BASED  ( iMsgRtnPtr )
      *
      *=====================================================================
      *
     D wDigDim         S              1A   DIM(1
      *
      *---------------------------------------------------------------------
     ? 中文数字
      *---------------------------------------------------------------------
      *
     D wChnChaNbr      S             40A   INZ(X'-
     D                                     0E51840F0E59BB0F0E4C410F0E54FD0F-
     D                                     0E56610F0E57E80F0E51BC0F0E53E10F-
     D                                     0E48C50F0E4FC00F')
      *
     D wChnDim         S              4A   DIM(10)
      *---------------------------------------------------------------------
     ? 中文单位
      *---------------------------------------------------------------------
     D wChnChaUnt      S             72A   INZ(X'-
     D                                     0E4C760F0E4F670F0E5AB10F0E55AF0F-
     D                                     0E48DA0F0E544A0F0E57930F0E55AF0F-
     D                                     0E48DA0F0E544A0F0E59D90F0E55AF0F-
     D                                     0E48DA0F0E544A0F0E57930F0E55AF0F-
     D                                     0E48DA0F0E544A0F')
      *
     D wUntDim         S              4A   DIM(1
      *
      *=====================================================================
      *
     D wSfxTst         S              8A
      *
      *=====================================================================
      *
     D wInpDigAmt      S             18S 0
     D wOutChrAmt      S            200A
      *
     D wInpLen         S              2S 0
     D wRpcLen         S              2S 0
     D wRpcPos         S              3S 0
      *
     D X               S              2S 0
     D Y               S              1S 0
     D Z               S              1S 0
      *
      *---------------------------------------------------------------------
     ? 中文字符
      *---------------------------------------------------------------------
      *
     D wLinLin         S              8A   INZ('零零')
     D wLinYuan        S              8A   INZ('零圆')
     D wLinWan         S              8A   INZ('零万')
     D wLinYi          S              8A   INZ('零亿')
     D wJiaoLin        S              8A   INZ('角零')
     D wJZ             S              8A   INZ('角整')
     D wYuanLin        S              8A   INZ('圆零')
     D wYZ             S              8A   INZ('圆整')
     D wYiWan          S              8A   INZ('亿万')
      *
     D wLin            S              4A   INZ('零')
     D wYuan           S              4A   INZ('圆')
     D wWan            S              4A   INZ('万')
     D wYi             S              4A   INZ('亿')
      *
      *=====================================================================
      *
      *
      *
     C                   EXSR      #InParm
      *
     C                   EXSR      #Main
      *
     C                   EXSR      #OutParm
      *
     C                   EVAL      *INLR       = *ON
     C                   RETURN
      *
      *
      *
     CSR   #Main         BEGSR
      *---------------------------------------------------------------------
     ?    检查输入
      *---------------------------------------------------------------------
     C     ' 0123456789' CHECK     xInpDigAmt                             90
      *
     C                   IF        *IN90       = *ON
     C                   EVAL      yMsgRtnCod  = 'FI30671'
     C                   EXSR      #ErrRtn
     C                   ENDIF
      *
     C                   MOVE      xInpDigAmt    wInpDigAmt
      *
     C                   SELECT
     C                   WHEN      wInpDigAmt  = *ZERO
     C                   EVAL      zOutChrAmt  = '零圆整'
      *                  EXSR      #ErrRtn
     C                   ENDSL
      *
     C                   EXSR      #IniChnInf
     CSR                 ENDSR
      *
      *
      *
     CSR   #IniChnInf    BEGSR
      *---------------------------------------------------------------------
     ?   初始化中文信息
      *---------------------------------------------------------------------
     C                   EVAL      wInpLen     = %LEN(%TRIM(
     C                                           %CHAR(wInpDigAmt)))
      *
     C                   MOVEA     wChnChaNbr    wChnDim
     C                   MOVEA     wChnChaUnt    wUntDim
      *
     C                   MOVEA     xInpDigAmt    wDigDim
      *
     C     1             DO        wInpLen       X
     C                   EVAL      Z           = %DEC(wDigDim(18 - X + 1):1:0)
     C                   SELECT
      *---------------------------------------------------------------------
     ?该位为零，为一般位
      *---------------------------------------------------------------------
     C                   WHEN      Z           = 0                 AND
     C                             X          <> 3                 AND
     C                             X          <> 7                 AND
     C                             X          <> 11                AND
     C                             X          <> 15
     C                   EVAL      wOutChrAmt  = wChnDim(Z + 1)
     C                                         + %TRIM(wOutChrAmt)
      *---------------------------------------------------------------------
     ?该位为零，为敏感位,要添零
      *---------------------------------------------------------------------
     C                   WHEN      Z           = 0                 AND
     C                             (X          = 3                 OR
     C                              X          = 7                 OR
     C                              X          = 11                OR
     C                              X          = 15)
     C                   EVAL      wOutChrAmt  = wUntDim(X)
     C                                         + wChnDim(Z + 1)
     C                                         + %TRIM(wOutChrAmt)
      *---------------------------------------------------------------------
     ?该位不为零
      *---------------------------------------------------------------------
     C                   WHEN      Z          <> 0
     C                   EVAL      wOutChrAmt  = wChnDim(Z + 1)
     C                                         + wUntDim(X)
     C                                         + %TRIM(wOutChrAmt)
     C                   ENDSL
     C                   ENDDO
      *
     C                   EXSR      #ChgSpcInf
     CSR                 ENDSR
      *
      *
      *
     CSR   #ChgSpcInf    BEGSR
      *---------------------------------------------------------------------
     ?转换特殊情况
      *---------------------------------------------------------------------
      *
      *---------------------------------------------------------------------
     ?零零->零
      *---------------------------------------------------------------------
     C                   EVAL      wRpcPos     = %SCAN(wLinLin:wOutChrAmt)
     C                   EVAL      wRpcLen     = %SIZE(wLinLin)
      *
     C                   DOW       wRpcPos     > *ZERO
     C                   EVAL      wOutChrAmt  = %REPLACE(wLin:wOutChrAmt   :
     C                                                  wRpcPos:wRpcLen)
     C                   EVAL      wRpcPos     = %SCAN(wLinLin:wOutChrAmt)
     C                   ENDDO
      *---------------------------------------------------------------------
     ?零圆->圆
      *---------------------------------------------------------------------
     C                   EVAL      wRpcPos     = %SCAN(wLinYuan:wOutChrAmt)
     C                   IF        wRpcPos     > *ZERO
     C                   EVAL      wOutChrAmt  = %REPLACE(wYuan:wOutChrAmt:
     C                                                  wRpcPos:wRpcLen)
     C                   ENDIF
      *---------------------------------------------------------------------
     ?零万->零
      *---------------------------------------------------------------------
     C                   EVAL      wRpcPos     = %SCAN(wLinWan:wOutChrAmt)
     C                   DOW       wRpcPos     > *ZERO
     C                   EVAL      wOutChrAmt  = %REPLACE(wWan:wOutChrAmt   :
     C                                                 wRpcPos:wRpcLen)
     C                   EVAL      wRpcPos     = %SCAN(wLinWan:wOutChrAmt)
     C                   ENDDO
      *---------------------------------------------------------------------
     ?零亿->亿
      *---------------------------------------------------------------------
     C                   EVAL      wRpcPos     = %SCAN(wLinYi:wOutChrAmt)
     C                   IF        wRpcPos     > *ZERO
     C                   EVAL      wOutChrAmt  = %REPLACE(wYi:wOutChrAmt:
     C                                               wRpcPos:wRpcLen)
     C                   ENDIF
      *---------------------------------------------------------------------
     ?角零->角整
      *---------------------------------------------------------------------
     C                   EVAL      wRpcPos     = %SCAN(wJiaoLin:wOutChrAmt)
     C                   IF        wRpcPos     > *ZERO
     C                   EVAL      wOutChrAmt  = %REPLACE(wJZ  :wOutChrAmt:
     C                                                 wRpcPos:wRpcLen)
     C                   ENDIF
      *---------------------------------------------------------------------
     ?圆零->圆整
      *---------------------------------------------------------------------
     C                   EVALR     wSfxTst     = %TRIM(wOutChrAmt)
     C                   IF        wSfxTst     = wYuanLin
     C                   EVALR     wOutChrAmt  = %TRIM(wOutChrAmt)
     C                   MOVE      wYZ           wOutChrAmt
     C                   EVAL      wOutChrAmt  = %TRIM(wOutChrAmt)
     C                   ENDIF
      *---------------------------------------------------------------------
     ?亿万->亿
      *---------------------------------------------------------------------
     C                   EVAL      wRpcPos     = %SCAN(wYiWan:wOutChrAmt)
     C                   IF        wRpcPos     > *ZERO
     C                   EVAL      wOutChrAmt  = %REPLACE(wYi:wOutChrAmt:
     C                                                wRpcPos:wRpcLen)
     C                   ENDIF
      *---------------------------------------------------------------------
     ?去除0F0E
      *---------------------------------------------------------------------
     C                   EVAL      wRpcPos     = %SCAN(X'0F0E':wOutChrAmt)
     C                   DOW       wRpcPos     > *ZERO
     C                   EVAL      wOutChrAmt  = %REPLACE(''  :wOutChrAmt:
     C                                                 wRpcPos:2)
     C                   EVAL      wRpcPos     = %SCAN(X'0F0E':wOutChrAmt)
     C                   ENDDO
     CSR                 ENDSR
      *
      *
      *
     CSR   #ErrRtn       BEGSR
     C                   EVAL      *INLR       = *ON
     C                   RETURN
     CSR                 ENDSR
      *
      *
      *
     CSR   #OutParm      BEGSR
     C                   EVAL      zOutChrAmt  = wOutChrAmt
     CSR                 ENDSR
      *
      *
      *
     CSR   #InParm       BEGSR
     C                   EVAL      yMsgRtnCod  = 'SUC9999'
     CSR                 ENDSR

qingzhou

存档备查.

wnai

RPGLE代码中咋写中文啊？
俺试了试，键盘就锁住了，DSPF中倒是没问题

uglyneo

建立SRCPF时，按F9，将该选项改为*YES
User specified DBCS data . . . .   *YES           *NO, *YES