RPGでなくてもCLP上で現在のカーソルの位置を取得したい場合がある。
動的管理機能APIにはそのような機能のAPIが用意されている。
非常に簡単に使うことができる。
ろ
[カーソル取得API : TESTCURSOR ]
ソースはこちらから
0001.00 PGM 0002.00 /*---------------------------------------------------------------------*/ 0003.00 /* TESTCURSOR : カーソル位置の取得サンプル */ 0004.00 /* */ 0005.00 /* 2023/11/27 作成 */ 0006.00 /* SRCTYPE: CLLE */ 0007.00 /* [COMPILE] */ 0008.00 /* CRTBNDCL OBJLIB/TESTCURSOR SRCFILE(R610SRC/QCLSRC) DFTACTGRP(*NO) */ 0009.00 /* ACTGRP(*NEW) AUT(*ALL) DBGVIEW(*SOURCE) */ 0010.00 /*---------------------------------------------------------------------*/ 0011.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(132) 0012.00 DCL VAR(&STMMSG) TYPE(*CHAR) LEN(132) 0013.00 DCL VAR(&MSGID) TYPE(*CHAR) LEN(7) 0014.00 DCL VAR(&MSGF) TYPE(*CHAR) LEN(10) 0015.00 DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10) 0016.00 DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4) 0017.00 DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132) 0018.00 DCL VAR(&ERRDTA) TYPE(*CHAR) LEN(132) 0019.00 DCL VAR(&TYPE) TYPE(*CHAR) LEN(1) 0020.00 DCL VAR(&TOPGMQ) TYPE(*CHAR) LEN(10) 0021.00 DCL VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) + 0022.00 VALUE('*ESCAPE ') 0023.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(116) + 0024.00 VALUE(X'0000007400000000') /* 2 進数 */ 0025.00 DCL VAR(&ERR) TYPE(*CHAR) LEN(1) 0026.00 DCL VAR(&NULL4) TYPE(*CHAR) LEN(4) + 0027.00 VALUE(X'00000000') 0028.00 /*( CURSOR の変数 )*/ 0029.00 DCL VAR(&ROW) TYPE(*CHAR) LEN(4) 0030.00 DCL VAR(&ROWD) TYPE(*DEC) LEN(4 0) 0031.00 DCL VAR(&ROWC) TYPE(*CHAR) LEN(4) 0032.00 DCL VAR(&COLUMN) TYPE(*CHAR) LEN(4) 0033.00 DCL VAR(&COLUMND) TYPE(*DEC) LEN(4 0) 0034.00 DCL VAR(&COLUMNC) TYPE(*CHAR) LEN(4) 0035.00 MONMSG MSGID(CPF9999) EXEC(GOTO CMDLBL(ERROR)) 0036.00 0037.00 /*( 環境の取得 )*/ 0038.00 RTVJOBA TYPE(&TYPE) 0039.00 IF COND(&TYPE *EQ '0') THEN(DO) /* バッチ * 0040.00 CHGVAR VAR(&TOPGMQ) VALUE('*SYSOPR ') 0041.00 ENDDO /* バッチ */ 0042.00 ELSE CMD(DO) /* 対話式 */ 0043.00 CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ') 0044.00 ENDDO /* 対話式 */ 0045.00 0046.00 /*---------------------------*/ 0047.00 CALLSUBR SUBR(CURSOR) 0048.00 /*---------------------------*/ 0049.00 IF COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO) 0050.00 GOTO APIERR 0051.00 ENDDO 0052.00 CHGVAR VAR(&ROWD) VALUE(%BIN(&ROW)) 0053.00 CHGVAR VAR(&ROWC) VALUE(&ROWD) 0054.00 NXTROW: IF COND(%SST(&ROWC 1 1) = '0') THEN(DO) 0055.00 CHGVAR VAR(&ROWC) VALUE(%SST(&ROWC 2 3) *TCAT ' ') 0056.00 GOTO NXTROW 0057.00 ENDDO 0058.00 CHGVAR VAR(&COLUMND) VALUE(%BIN(&COLUMN)) 0059.00 CHGVAR VAR(&COLUMNC) VALUE(&COLUMND) 0060.00 NXTCOL: IF COND(%SST(&COLUMNC 1 1) = '0') THEN(DO) 0061.00 CHGVAR VAR(&COLUMNC) VALUE(%SST(&COLUMNC 2 3) *TCAT ' ') 0062.00 GOTO NXTCOL 0063.00 ENDDO 0064.00 CHGVAR VAR(&MSG) VALUE(' カーソルの位置は (' + 0065.00 *CAT &ROWC *TCAT ',' *CAT &COLUMNC + 0066.00 *TCAT ') です。 ') 0067.00 CHGVAR VAR(&MSGTYPE) VALUE('*DIAG') 0068.00 GOTO SNDMSG 0069.00 0070.00 APIERR: 0071.00 CHGVAR VAR(&MSGID) VALUE(%SST(&APIERR 9 7)) 0072.00 CHGVAR VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100)) 0073.00 CHGVAR VAR(&MSGF) VALUE('Q' *CAT %SST(&MSGID 1 + 0074.00 3) *CAT 'MSG') 0075.00 IF COND(&MSGF *EQ 'QCPEMSG') THEN(CHGVAR + 0076.00 VAR(&MSGF) VALUE('QCPFMSG')) 0077.00 CHGVAR VAR(&MSGFLIB) VALUE('QSYS ') 0078.00 GOTO SNDMSG 0079.00 0080.00 ERROR: RCVMSG MSGTYPE(*FIRST) RMV(*NO) KEYVAR(&MSGKEY) + 0081.00 MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) + 0082.00 SNDMSGFLIB(&MSGFLIB) 0083.00 IF COND(&MSGID *EQ 'CPF9999') THEN(DO) 0084.00 CHGVAR VAR(&ERRDTA) VALUE(&MSGDTA) 0085.00 RCVMSG MSGTYPE(*PRV) MSGKEY(&MSGKEY) RMV(*NO) + 0086.00 MSG(&MSG) MSGDTA(&MSGDTA) MSGID(&MSGID) + 0087.00 MSGF(&MSGF) MSGFLIB(&MSGFLIB) 0088.00 CHGVAR VAR(&STMMSG) VALUE(' プログラム ' *CAT + 0089.00 %SST(&ERRDTA 8 10) *TCAT + 0090.00 ' のステートメント ' *CAT %SST(&ERRDTA + 0091.00 24 8) *CAT ' で次のエラーが発生しました。 ') 0092.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&STMMSG) + 0093.00 TOMSGQ(&TOPGMQ) MSGTYPE(*DIAG) 0094.00 ENDDO 0095.00 SNDMSG: IF COND(&MSGID *EQ ' ') THEN(DO) 0096.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) + 0097.00 TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE) 0098.00 MONMSG MSGID(CPF2400) EXEC(RETURN) 0099.00 ENDDO 0100.00 ELSE CMD(DO) 0101.00 SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) + 0102.00 MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) + 0103.00 MSGTYPE(&MSGTYPE) 0104.00 MONMSG MSGID(CPF2400) EXEC(RETURN) 0105.00 ENDDO 0106.00 /******************************/ 0107.00 SUBR SUBR(CURSOR) /* 現在のカーソル位置を取得 */ 0108.00 /******************************/ 0109.00 CALLPRC PRC('QsnGetCsrAdr') PARM((&ROW) (&COLUMN) + 0110.00 (&NULL4) (&APIERR)) 0111.00 IF COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO) 0112.00 SNDPGMMSG MSG('DSPWINCL API: + 0113.00 QsnGetCsrAdr の実行で次のエラーが発生しました。 + 0114.00 ') MSGTYPE(*DIAG) 0115.00 RTNSUBR 0116.00 ENDDO 0117.00 ENDSUBR 0118.00 ENDPGM
[解説]
カーソルを取得しているのはサブ・ルーチン: CURSOR の
0109.00 CALLPRC PRC('QsnGetCsrAdr') PARM((&ROW) (&COLUMN) +
0110.00 (&NULL4) (&APIERR))
の部分だけである。
IBMのマニュアルには 画面ハンドルの取得と指定が必要であると描かれているが
実際は NULLをこのAPIに渡すと適切なハンドルが祝されるようになっているので
ハンドルの取得と指定は必要ない。
[注意]
このCLPソースはソース・タイプはCLPではなくCLLEとして作成しコンパイルはCRTCLPGM ではなく
CRTBNDCLを使ってコンパイルすること。コンパイル・コマンドはこのソースの最初の注記を参照のこと。
_