6. ユーザー・メニューを作成するには？
CLP で CALL MYLIB/MENU で呼び出すメニューが多いのだが、やはり GO MENU で呼び出せる正式なメニューを作成しておけば IBM ユーティリティー・メニューとも操作性の統一も図れるしプログラムがアベンドしてもメニューまで終了していまうようなことはない。
メニューまで終了してしまうと、不慣れなユーザーは AS/400 の GO MAIN メニューが表示され、見たことも無い画面でそれ以上の操作ができなくなる。
さて、ユーザー・メニューには次の 3つのタイプがある。
- 表示装置ファイル・メニュー (DSPF)
- プログラム・メニュー（PGM）
- パネル・グループ・メニュー（UIM）
いずれの場合でも最終的に CRTMNU コマンドでメニューが作成される。
表示装置ファイル・メニュー（DSPF）
-
SDA によって作成されるメニューである。
STRSDA コマンドによって 2=メニューの設計を選択。
メニューイメージおよび、コマンドの処理=Yにして実行。
SDA 画面で画面イメージを登録したら F13=コマンド区域によってオプション毎のコマンド命令を登録。
F3で終了保管する。SDA を使用しなくても SEU で画面作成後、 メニューと同じ名前のメッセージファイルをCRTMSGF で作成して、WRKMSGD によってメッセージ記述を登録しても良い。
メッセージ識別は オプション 1に対してUSR0001,
オプション2に対して USR0002, 以下 USR0003,USR0004 のように登録する。
メッセージの中に CALL MYLIB/MYPGM のように登録する。
その後 CRTMNU で DSPF を指定してメニューを作成することもできる。 プログラム・メニュー（PGM）
-
ここで紹介する CLP によるプログラム・メニューは単にプログラムの中でアプリケーション を CALL するのではなく、やはりメッセージファイルを使用している。
そのため CRTCLPGM でプログラムを作成して画面ファイルは CRTDSPF LVLCHK(*NO) で作成して CRTMNU しておけば項目が増えても CLP を修正する必要もないし、CRTMNU の必要もない。
画面を修正してメッセージファイルに項目を追加するだけで良い。
さらに別のメニューを作成するにしても変更箇所はDCLF ステートメントだけなので、新規開発が非常に楽である。0001.00 PGM PARM(&MENU &MNULIB &RTNCOD) 0002.00 /*---------------------------------------------------------*/ 0003.00 /* MN01 : テスト・メニユー */ 0004.00 /*---------------------------------------------------------*/ 0005.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(80) 0006.00 DCL VAR(&MENU) TYPE(*CHAR) LEN(10) 0007.00 DCL VAR(&MNULIB) TYPE(*CHAR) LEN(10) 0008.00 DCL VAR(&RTNCOD) TYPE(*CHAR) LEN(2) /* + 0009.00 戻りコード */ 0010.00 DCLF FILE(QTROBJ/MN01) 0011.00 DCL VAR(&CALCMD) TYPE(*CHAR) LEN(512) 0012.00 DCL VAR(&MSGCMD) TYPE(*CHAR) LEN(512) 0013.00 DCL VAR(&USRNO) TYPE(*CHAR) LEN(7) 0014.00 DCL VAR(&MNUCMD) TYPE(*CHAR) LEN(124) 0015.00 DCL VAR(&WAIT) TYPE(*DEC) LEN(5 0) VALUE(0) 0016.00 DCL VAR(&MSGLEN) TYPE(*DEC) LEN(5 0) VALUE(80) 0017.00 DCL VAR(&CMDLEN) TYPE(*DEC) LEN(5 0) VALUE(557) 0018.00 DCL VAR(&KEYVAR) TYPE(*CHAR) LEN(4) 0019.00 DCL VAR(&LONGCMD) TYPE(*CHAR) LEN(1) 0020.00 DCL VAR(&CMDSTACK) TYPE(*CHAR) LEN(400) 0021.00 DCL VAR(&CMD557) TYPE(*CHAR) LEN(557) 0022.00 DCL VAR(&SX) TYPE(*DEC) LEN(4 0) VALUE(-3) 0023.00 DCL VAR(&CMDPMT) TYPE(*CHAR) LEN(153) 0024.00 DCL VAR(&FLD4) TYPE(*CHAR) LEN(4) 0025.00 DCL VAR(&CPYRGT) TYPE(*CHAR) LEN(80) + 0026.00 VALUE(' - 0027.00 (C) COPYRIGHT OFFICE QUATTRO 1994') 0028.00 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR)) 0029.00 0030.00 CHKOBJ OBJ(QTEMP/MSGDTAQ) OBJTYPE(*DTAQ) 0031.00 MONMSG MSGID(CPF9800) EXEC(DO) 0032.00 CRTDTAQ DTAQ(QTEMP/MSGDTAQ) MAXLEN(128) TEXT('MENU + 0033.00 MSG DTAQ') AUT(*ALL) 0034.00 RMVMSG CLEAR(*ALL) 0035.00 ENDDO 0036.00 CHKOBJ OBJ(QTEMP/CMDDTAQ) OBJTYPE(*DTAQ) 0037.00 MONMSG MSGID(CPF9800) EXEC(DO) 0038.00 CRTDTAQ DTAQ(QTEMP/CMDDTAQ) MAXLEN(557) + 0039.00 TEXT('CMD-STACK DTAQ') AUT(*ALL) 0040.00 RMVMSG CLEAR(*ALL) 0041.00 ENDDO 0042.00 CALL PGM(QRCVDTAQ) PARM('MSGDTAQ ' 'QTEMP ' + 0043.00 80 &ERRMSG &WAIT) 0044.00 IF COND(&ERRMSG *EQ ' ') THEN(CHGVAR + 0045.00 VAR(&ERRMSG) VALUE(&CPYRGT)) 0046.00 CALL PGM(QRCVDTAQ) PARM('CMDDTAQ ' 'QTEMP ' + 0047.00 557 &CMD557 &WAIT) 0048.00 IF COND(%SST(&CMD557 1 4) *NE ' ') THEN(CHGVAR + 0049.00 VAR(&SX) VALUE(%SST(&CMD557 1 4))) 0050.00 CHGVAR VAR(&CMDSTACK) VALUE(%SST(&CMD557 5 400)) 0051.00 CHGVAR VAR(&CMDLIN) VALUE(%SST(&CMD557 405 153)) 0052.00 0053.00 OVRDSPF FILE(MN01) SHARE(*YES) 0054.00 RTVOUTQ: 0055.00 RTVJOBA OUTQ(&OUTQ) 0056.00 DSPLY: 0057.00 SNDF RCDFMT(MN01) 0058.00 DSPCMD: 0059.00 SNDRCVF RCDFMT(MENUFMT) 0060.00 CHGVAR VAR(&RTNCOD) VALUE(X'0000') /* 再表示要求 */ 0061.00 CHGVAR VAR(&ERRMSG) VALUE(' ') 0062.00 /*----------------------*/ 0063.00 /* 機能キー */ 0064.00 /*----------------------*/ 0065.00 CF03: IF COND(&IN03 *EQ '1') THEN(DO) 0066.00 CHGVAR VAR(&RTNCOD) VALUE(X'FFFF') /* 終了要求 */ 0067.00 RETURN 0068.00 ENDDO 0069.00 CF04: IF COND(&IN04 *EQ '1') THEN(DO) 0070.00 CHGVAR &CALCMD VALUE('?' *CAT &CMDLIN) 0071.00 CALL PGM(QCMDCHK) PARM(&CALCMD 512) 0072.00 MONMSG MSGID(CPF6801) EXEC(DO) 0073.00 GOTO ERROR 0074.00 ENDDO 0075.00 MONMSG MSGID(CPF0006) EXEC(DO) 0076.00 GOTO ERROR 0077.00 ENDDO 0078.00 GOTO CMDEXEC 0079.00 ENDDO 0080.00 CF05: IF COND(&IN05 *EQ '1') THEN(DO) 0081.00 WRKACTJOB 0082.00 GOTO ENDPGM 0083.00 ENDDO 0084.00 CF06: IF COND(&IN06 *EQ '1') THEN(DO) 0085.00 DSPMSG 0086.00 GOTO ENDPGM 0087.00 ENDDO 0088.00 CF09: IF COND(&IN09 *EQ '1') THEN(DO) 0089.00 CHGVAR VAR(&SX) VALUE(&SX + 4) 0090.00 IF COND(&SX *GT 400) THEN(CHGVAR VAR(&SX) + 0091.00 VALUE(1)) 0092.00 CHGVAR VAR(&KEYVAR) VALUE(%SST(&CMDSTACK &SX 4)) 0093.00 IF COND((&SX *EQ 1) *AND (&KEYVAR *EQ ' ')) + 0094.00 THEN(GOTO ENDPGM) 0095.00 IF COND(&KEYVAR *EQ ' ') THEN(DO) 0096.00 GOTO ENDPGM 0097.00 ENDDO 0098.00 RCVMSG MSGKEY(&KEYVAR) RMV(*NO) MSG(&MSGCMD) 0099.00 CHGVAR VAR(&CALCMD) VALUE(&MSGCMD) 0100.00 CHGVAR VAR(&CMDLIN) VALUE(&CALCMD) 0101.00 IF COND(%SST(&CALCMD 154 350) *NE ' ') THEN(DO) 0102.00 CHGVAR VAR(%SST(&CMDLIN 151 3)) VALUE('...') 0103.00 CHGVAR VAR(&LONGCMD) VALUE('X') 0104.00 ENDDO 0105.00 CHGVAR VAR(&CMDPMT) VALUE(&CMDLIN) 0106.00 GOTO ENDPGM 0107.00 ENDDO 0108.00 CF10: IF COND(&IN10 *EQ '1') THEN(DO) 0109.00 CALL QCMD 0110.00 GOTO ENDPGM 0111.00 ENDDO 0112.00 CF12: IF COND(&IN12 *EQ '1') THEN(DO) 0113.00 CHGVAR VAR(&RTNCOD) VALUE(X'FFFE') /* 取消要求 */ 0114.00 RETURN 0115.00 ENDDO 0116.00 HELP: IF COND(&IN19 *EQ '1') THEN(DO) 0117.00 CALL OPMENUJ 0118.00 GOTO ENDPGM 0119.00 ENDDO 0120.00 HOME: IF COND(&IN25 *EQ '1') THEN(DO) 0121.00 CHGVAR VAR(&RTNCOD) VALUE(X'FFFC') /* HOME 要求 */ 0122.00 RETURN 0123.00 ENDDO 0124.00 /*----------------------*/ 0125.00 /* 選択オプション */ 0126.00 /*----------------------*/ 0127.00 IF COND((%SST(&CMDLIN 1 1) *GE '0') *AND + 0128.00 (%SST(&CMDLIN 1 1) *LE '9')) THEN(DO) 0129.00 IF COND(%SST(&CMDLIN 1 3) *EQ '90 ') THEN(SIGNOFF) 0130.00 IF COND(%SST(&CMDLIN 2 1) *EQ ' ') THEN(DO) 0131.00 CHGVAR VAR(&USRNO) VALUE('USR000' *TCAT + 0132.00 %SST(&CMDLIN 1 1)) 0133.00 ENDDO 0134.00 ELSE CMD(DO) 0135.00 CHGVAR VAR(&USRNO) VALUE('USR00' *TCAT + 0136.00 %SST(&CMDLIN 1 2)) 0137.00 ENDDO 0138.00 RTVMSG MSGID(&USRNO) MSGF(MN01) MSG(&MNUCMD) 0139.00 MONMSG MSGID(CPF2400) EXEC(DO) 0140.00 SNDPGMMSG MSGID(CPD6A64) MSGF(QCPFMSG) TOPGMQ(*SAME) + 0141.00 MSGTYPE(*DIAG) 0142.00 GOTO ERROR 0143.00 ENDDO 0144.00 IF COND((%SST(&MNUCMD 1 12) *EQ ' メッセージ ') + 0145.00 *OR (%SST(&MNUCMD 1 12) = ' ')) + 0146.00 THEN(DO) 0147.00 SNDPGMMSG MSGID(CPD6A64) MSGF(QCPFMSG) TOPGMQ(*SAME) + 0148.00 MSGTYPE(*DIAG) 0149.00 GOTO ERROR 0150.00 ENDDO 0151.00 CALL PGM(QCMDEXC) PARM(&MNUCMD 124) 0152.00 GOTO ERROR 0153.00 OPTEND: ENDDO 0154.00 /*----------------------*/ 0155.00 /* コマンド実行 */ 0156.00 /*----------------------*/ 0157.00 CHGVAR VAR(&CALCMD) VALUE(&CMDLIN) 0158.00 CMDEXEC: 0159.00 CALL PGM(QCMDEXC) PARM(&CALCMD 512) 0160.00 SNDPGMMSG MSG(&CALCMD) TOPGMQ(*SAME) MSGTYPE(*RQS) 0161.00 CHGVAR VAR(&KEYVAR) VALUE(' ') 0162.00 RCVMSG PGMQ(*SAME) MSGTYPE(*RQS) RMV(*NO) + 0163.00 KEYVAR(&KEYVAR) 0164.00 IF COND(&KEYVAR *NE ' ') THEN(DO) 0165.00 CHGVAR VAR(&CMDSTACK) VALUE(&KEYVAR *CAT &CMDSTACK) 0166.00 CHGVAR VAR(&SX) VALUE(-3) 0167.00 ENDDO 0168.00 ERROR: RCVMSG RMV(*NO) MSG(&MSG) 0169.00 SNDMSG: SNDPGMMSG MSG(&MSG) TOPGMQ(*EXT) MSGTYPE(*DIAG) 0170.00 CALL PGM(QSNDDTAQ) PARM('MSGDTAQ ' 'QTEMP ' + 0171.00 &MSGLEN &MSG) 0172.00 ENDPGM: CHGVAR VAR(&FLD4) VALUE(&SX) 0173.00 CHGVAR VAR(&CMD557) VALUE(&FLD4 *CAT &CMDSTACK *CAT + 0174.00 &CMDPMT) 0175.00 CALL PGM(QSNDDTAQ) PARM('CMDDTAQ ' 'QTEMP ' + 0176.00 &CMDLEN &CMD557) 0177.00 ENDPGM パネル・グループ・メニュー
-
ライブラリー QSYS の中のオブジェクト・タイプ*MENU を PDM で検索して欲しい。
ほとんどのメニューは 属性=UIM であることに気づくであろう。
何を隠そう UIM こそが OS/400 のインターフェースの殆どを形成しているパネル・グループである。
PANEL-WORKER のメニュー処理を使用すれば、わずか数分で IBM 提供のメニューと同じパネル・グループによるメニューを簡単に生成することができる。
