|
|
 |
|
Wiki | |
|
updated on 2004.06.23 |
||||
19.8.漢字の文字列を分割する部品 | |||||||||
|
これは、訪問者ＦＫ様からの、提供プログラムで、漢字の文字列を分割する部品です。ご提供、ありがとうございました。
H****************************************************************
H* *
H* プログラム名:＃ＳＵＢＣＵＴ *
H* 名称:混用フィールドの分割 *
H* *
H****************************************************************
H Y 1
E****************************************************************
E* テーブル *
E****************************************************************
E TXT 256 1
C****************************************************************
C* ＰＬＩＳＴ *
C****************************************************************
C *ENTRY PLIST
C PARM P@ITXT256 変換前
C PARM P@OTXT256 変換後
C PARM P@OLEN 30 分割LEN
C PARM P@OCUR 30 繰返し数
C****************************************************************
C* メイン・ルーチン *
C****************************************************************
C*<<初期設定>>
C MOVELX'0E' X0E 1
C MOVELX'0F' X0F 1
C MOVELP@ITXT W@CHR1256
C MOVEL*BLANK P@OTXT
C Z-ADD*ZERO W@OCUR 30
C Z-ADD256 W@ILEN 30
C Z-ADDP@OLEN W@OLEN 30
C Z-SUBW@OLEN W@TBLP 30
C Z-ADD1 K 30
C P@OLEN IFEQ *ZERO
C MOVEL'0' WLOP 1
C ELSE
C MOVEL'1' WLOP
C ENDIF
C*<<分割開始>>
C WLOP DOWEQ'1'
C*
C ADD 1 W@OCUR
C W@OCUR IFGT P@OCUR
C MOVEL'0' WLOP
C ELSE
C*
C W@ILEN IFLT W@OLEN
C Z-ADDW@ILEN W@OLEN
C ENDIF
C*
C W@OLEN SUBSTW@CHR1 W@CHAR256 P
C MOVEAW@CHAR TXT,K
C ADD P@OLEN K
C*<<シフト文字制御>>
C EXSR @SB100
C*
C ENDIF
C*
C ENDDO
C*<<結果パラメータに戻す>>
C MOVEATXT P@OTXT
C*
C SETON LR
C RETRN
C/EJECT
C*==============================================================*
C* @SB100 シフト位置チェック（シフトアウト）
C*==============================================================*
C @SB100 BEGSR
C*
C MOVEL'1' WLOP1 1
C SETOF 10
C Z-ADD*ZERO P 30
C ADD W@OLEN W@TBLP
C*
C WLOP1 DOWEQ'1'
C*<<０Ｅの位置を探す>>
C ADD 1 P
C X0E SCAN W@CHAR:P W@PTR1 30 80
C *IN80 IFEQ *ON
C*<<０Ｅが見つかった時、対の０Ｆを見つける>>
C EXSR @SB110
C ELSE
C*<<０Ｅが無い場合、そのまま抜ける>>
C W@OLEN ADD 1 J 30
C MOVEL'0' WLOP1
C ENDIF
C*
C ENDDO
C*
C SUB J W@ILEN
C W@ILEN IFGT *ZERO
C W@ILEN SUBSTW@CHR1:J W@CHR1 P
C 10 X0E CAT W@CHR1 W@CHR1 P
C ELSE
C MOVEL'0' WLOP
C ENDIF
C*
C ENDSR
C/EJECT
C*==============================================================*
C* @SB110 シフト位置チェック（シフトイン）
C*==============================================================*
C @SB110 BEGSR
C*
C SETOF 81
C Z-ADD*ZERO W@PTR2
C*<<０Ｆの位置を探す>>
C W@PTR1 IFLT W@OLEN
C W@PTR1 ADD 1 P
C X0F SCAN W@CHAR:P W@PTR2 30 81
C ENDIF
C*
C SELEC
C*<<対の０Ｆが見つかった時>>
C *IN81 WHEQ *ON
C W@PTR2 IFEQ W@OLEN
C W@PTR2 ADD 1 J
C MOVEL'0' WLOP1
C ELSE
C Z-ADDW@PTR2 P
C ENDIF
C*<<０Ｆが無い時>> (漢字が続く場合)
C *IN81 WHEQ *OFF
C W@OLEN SUB W@PTR1 W@DBCS 30
C SUB 1 W@DBCS
C W@DBCS IFLT 2
C Z-ADDW@PTR1 L 30
C Z-ADDL J
C ELSE
C SETON 10
C DIV 2 W@DBCS
C MULT 2 W@DBCS
C W@DBCS ADD W@PTR1 L
C ADD 1 L
C Z-ADDL J
C L ADD W@TBLP I 30
C MOVE X0F TXT,I
C ADD 1 L
C ENDIF
C*
C L IFLE W@OLEN
C ADD W@TBLP L
C MOVEA*BLANK TXT,L
C ENDIF
C MOVEL'0' WLOP1
C*
C ENDSL
C*
C ENDSR
1999/1/29 |
|
You are at K's tips-n-kicks of AS/400
|
| SEO | [PR] 爆速!無料ブログ 無料ホームページ開設 無料ライブ放送 | ||
