PGM                                                                
/*---------------------------------------------------------------------*/       
/*   TESTCURSOR :   カーソル位置の取得サンプル                         */       
/*                                                                     */       
/*   2023/11/27  作成                                                  */       
/*   SRCTYPE: CLLE                                                     */       
/*   ﾗCOMPILEﾝ                                                         */       
/*   CRTBNDCL OBJLIB/TESTCURSOR SRCFILE(R610SRC/QCLSRC) DFTACTGRP(*NO) */       
/*            ACTGRP(*NEW) AUT(*ALL) DBGVIEW(*SOURCE)                  */       
/*---------------------------------------------------------------------*/       
             DCL        VAR(&MSG) TYPE(*CHAR) LEN(132)                          
             DCL        VAR(&STMMSG) TYPE(*CHAR) LEN(132)                       
             DCL        VAR(&MSGID) TYPE(*CHAR) LEN(7)                          
             DCL        VAR(&MSGF) TYPE(*CHAR) LEN(10)                          
             DCL        VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)                       
             DCL        VAR(&MSGKEY) TYPE(*CHAR) LEN(4)                         
             DCL        VAR(&MSGDTA) TYPE(*CHAR) LEN(132)                       
             DCL        VAR(&ERRDTA) TYPE(*CHAR) LEN(132)                       
             DCL        VAR(&TYPE) TYPE(*CHAR) LEN(1)                           
             DCL        VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)                        
             DCL        VAR(&MSGTYPE) TYPE(*CHAR) LEN(10) +                     
                          VALUE('*ESCAPE   ')                                   
             DCL        VAR(&APIERR) TYPE(*CHAR) LEN(116) +                     
                          VALUE(X'0000007400000000') /* 2 進数  */              
             DCL        VAR(&ERR) TYPE(*CHAR) LEN(1)                            
             DCL        VAR(&NULL4) TYPE(*CHAR) LEN(4) +                        
                          VALUE(X'00000000')                                    
/*( CURSOR の変数 )*/                                                           
             DCL        VAR(&ROW) TYPE(*CHAR) LEN(4)                            
             DCL        VAR(&ROWD) TYPE(*DEC) LEN(4 0)                          
             DCL        VAR(&ROWC) TYPE(*CHAR) LEN(4)                           
             DCL        VAR(&COLUMN) TYPE(*CHAR) LEN(4)                         
             DCL        VAR(&COLUMND) TYPE(*DEC) LEN(4 0)                       
             DCL        VAR(&COLUMNC) TYPE(*CHAR) LEN(4)                        
             MONMSG     MSGID(CPF9999) EXEC(GOTO CMDLBL(ERROR))                 
                                                                                
/*( 環境の取得 )*/                                                              
             RTVJOBA    TYPE(&TYPE)                                             
             IF         COND(&TYPE *EQ '0') THEN(DO) /*  バッチ  */             
             CHGVAR     VAR(&TOPGMQ) VALUE('*SYSOPR   ')                        
             ENDDO      /*  バッチ  */                                          
             ELSE       CMD(DO) /*  対話式  */                                  
             CHGVAR     VAR(&TOPGMQ) VALUE('*TOPGMQ   ')                        
             ENDDO      /*  対話式  */                                          
                                                                                
          /*---------------------------*/                                       
             CALLSUBR   SUBR(CURSOR)                                            
          /*---------------------------*/                                       
             IF         COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)             
             GOTO       APIERR                                                  
             ENDDO                                                              
             CHGVAR     VAR(&ROWD) VALUE(%BIN(&ROW))                            
             CHGVAR     VAR(&ROWC) VALUE(&ROWD)                                 
 NXTROW:     IF         COND(%SST(&ROWC 1 1) = '0') THEN(DO)                    
             CHGVAR     VAR(&ROWC) VALUE(%SST(&ROWC 2 3) *TCAT ' ')             
             GOTO       NXTROW                                                  
             ENDDO                                                              
             CHGVAR     VAR(&COLUMND) VALUE(%BIN(&COLUMN))                      
             CHGVAR     VAR(&COLUMNC) VALUE(&COLUMND)                           
 NXTCOL:     IF         COND(%SST(&COLUMNC 1 1) = '0') THEN(DO)                 
             CHGVAR     VAR(&COLUMNC) VALUE(%SST(&COLUMNC 2 3) *TCAT ' ')       
             GOTO       NXTCOL                                                  
             ENDDO                                                              
             CHGVAR     VAR(&MSG) VALUE(' カーソルの位置は (' +                 
                          *CAT &ROWC *TCAT ',' *CAT &COLUMNC +                  
                          *TCAT ') です。 ')                                    
             CHGVAR     VAR(&MSGTYPE) VALUE('*DIAG')                            
             GOTO       SNDMSG                                                  
                                                                                
 APIERR:                                                                        
             CHGVAR     VAR(&MSGID) VALUE(%SST(&APIERR 9 7))                    
             CHGVAR     VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))                
             CHGVAR     VAR(&MSGF) VALUE('Q' *CAT %SST(&MSGID 1 +               
                          3) *CAT 'MSG')                                        
             IF         COND(&MSGF *EQ 'QCPEMSG') THEN(CHGVAR +                 
                          VAR(&MSGF) VALUE('QCPFMSG'))                          
             CHGVAR     VAR(&MSGFLIB) VALUE('QSYS      ')                       
             GOTO       SNDMSG                                                  
                                                                                
 ERROR:      RCVMSG     MSGTYPE(*FIRST) RMV(*NO) KEYVAR(&MSGKEY) +              
                          MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +           
                          SNDMSGFLIB(&MSGFLIB)                                  
             IF         COND(&MSGID *EQ 'CPF9999') THEN(DO)                     
             CHGVAR     VAR(&ERRDTA) VALUE(&MSGDTA)                             
             RCVMSG     MSGTYPE(*PRV) MSGKEY(&MSGKEY) RMV(*NO) +                
                          MSG(&MSG) MSGDTA(&MSGDTA) MSGID(&MSGID) +             
                          MSGF(&MSGF) MSGFLIB(&MSGFLIB)                         
             CHGVAR     VAR(&STMMSG) VALUE(' プログラム ' *CAT +                
                          %SST(&ERRDTA 8 10) *TCAT +                            
                          ' のステートメント ' *CAT %SST(&ERRDTA +              
                          24 8) *CAT ' で次のエラーが発生しました。 ')          
             SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&STMMSG) +          
                          TOMSGQ(&TOPGMQ) MSGTYPE(*DIAG)                        
             ENDDO                                                              
 SNDMSG:     IF         COND(&MSGID *EQ ' ') THEN(DO)                           
             SNDPGMMSG  MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +             
                          TOMSGQ(&TOPGMQ) MSGTYPE(&MSGTYPE)                     
             MONMSG     MSGID(CPF2400) EXEC(RETURN)                             
             ENDDO                                                              
             ELSE       CMD(DO)                                                 
             SNDPGMMSG  MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +                    
                          MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +                     
                          MSGTYPE(&MSGTYPE)                                     
             MONMSG     MSGID(CPF2400) EXEC(RETURN)                             
             ENDDO                                                              
         /******************************/                                       
             SUBR       SUBR(CURSOR)   /* 現在のカーソル位置を取得 */           
         /******************************/                                       
             CALLPRC    PRC('QﾍﾄGｵﾎCﾍﾈAｴﾈ') PARM((&ROW) (&COLUMN) +             
                          (&NULL4) (&APIERR))                                   
             IF         COND(%SST(&APIERR 5 4) *NE &NULL4) THEN(DO)             
             SNDPGMMSG  MSG('DSPWINCL API: +                                    
                          QﾍﾄGｵﾎCﾍﾈAｴﾈ の実行で次のエラーが発生しました。 +     
                          ') MSGTYPE(*DIAG)                                     
             RTNSUBR                                                            
             ENDDO                                                              
             ENDSUBR                                                            
             ENDPGM