IBMi (AS400) fans only * Subfile window with mouse Selection - DoubleLeftClick - MOUBTN(*ULD CA04)

By -





#IBMiSample

Subfile window with mouse selection - DoubleLeftClick - MOUBTN(*ULD CA04)




This example uses DoubleLeftClick MOUBTN(*ULD CA04) to select a subfile row.

Please note:
the mouse works with "Personal Communications iSeries Access" and does not work with a simple 5250 emulator (for example Mocha TN5250 does not detect the mouse). If you don't have "Personal Communications iSeries Access" it doesn't matter, the mouse doesn't work but the function keys work as usual.





First of all look at this post and compile and populate CLANA00F to use this example.

Don't forget to set the screen to 132 columns!

  





This is the display file:

CL01SFV.DSPF
      **************************************************************
      *  CLANA01L Subfile with select option
      **************************************************************
                                            DSPSIZ(27 132 *DS4)
                                            INDARA
                                            CA03(03 'F3=Exit')
                                            REF(CLANA00F)
                                            CHGINPDFT(CS UL HI)
      *-------------------------------------------------------------
                R SFL1                      SFL
      *-------------------------------------------------------------
                  S1OPT          1A  B  8  1VALUES(' ' '1')
                  S1ANN0    R        O   + 1REFFLD(CLANN0)
                  S1CCL0    R        O    +2REFFLD(CLCCL0) EDTCDE(Z)
                  S1NOM0    R        O    +1REFFLD(CLNOM0)
      *-------------------------------------------------------------
                R F01                       SFLCTL(SFL1)
      *-------------------------------------------------------------
                                            OVERLAY
                                            WINDOW(3 48 19 71)
                                            SFLPAG(0010)
                                            SFLSIZ(&NBRRECS)
       N50                                  SFLDSP
       N50                                  SFLDSPCTL
        50                                  SFLCLR
        91                                  SFLEND(*MORE)
                                            RTNCSRLOC(&PM_RCD &PM_FLD)
                                            SFLCSRRRN(&RRNA)
                                            MOUBTN(*ULD CA04)
                                            CA04(04 'Sel Row')
                  PM_RCD        10A  H
                  PM_FLD        10A  H
                  SF1NUM         4S 0H
                  NBRRECS        5S 0P
                  RRNA           5S 0H
                                        1 28'Customers'
                                            DSPATR(HI)
      * Text
                  F1DESCR       60A  O  2  2COLOR(RED)
      * Text
                  F1DESC2       60A  O  3  2COLOR(RED)
      * Text
                  F1DESC3       60A  O  4  2COLOR(RED)
      * Funtion explanation
                                        5  1'1 or Double Click=Select row'
                                            COLOR(BLU)
                                         +02'F3=Exit'
                                            COLOR(BLU)
      * Column header
                                        6  3'A'
                                         + 1'CustCode'
                                          +1'Name'
      * Filters
                  F1ANN0    R        B  7  3REFFLD(CLANN0)
                  F1CCL0    R        B    +2REFFLD(CLCCL0) EDTCDE(Z)
                  F1NOM0    R        B    +1REFFLD(CLNOM0) DSPATR(PC)
                                            CHECK(LC)
                R DUMMY
                                            TEXT('Prevents Previous +
                                            SCREEN FROM BEING CLEARED')
                                            ASSUME
                                        5  9' ' 



This is the SQLRPGLE file:
CL01SF.SQLRPGLE
      **FREE
       ctl-opt option(*nodebugio:*srcstmt:*nounref) dftactgrp(*no);

       dcl-f CL01SFV workstn indds(Dspf) sfile(SFL1 : SF1NUM);

       dcl-c MaxSFLrec 9999 ;

       dcl-s ReLoadSFL  ind         inz(*on)    ;

       dcl-s F1ANN0lke  varchar(35) inz('%')    ;
       dcl-s F1ANN0prv  varchar(35) inz(*blanks);



       dcl-s wF1CCL0str zoned(07)   inz(*zeros);
       dcl-s wF1CCL0end zoned(07)   inz(*hival);
       dcl-s F1CCL0prv  zoned(07)   inz(*loval);

       dcl-s F1NOM0lke  varchar(50) inz('%')    ;
       dcl-s F1NOM0prv  varchar(52) inz(*blanks);

       // indicators
       dcl-ds Dspf qualified ;
         Exit            ind pos(03) inz(*off);
       //  LeftClick       ind pos(04) inz(*off);
         DoubleLeftClick ind pos(04) inz(*off);
         SflClr          ind pos(50) inz(*off);
         SflEnd          ind pos(91) inz(*off);
       end-ds ;

       dcl-ds RecordDs;
         CLANN0 char(1);
         CLCCL0 zoned(7);
         CLNOM0 char(50);
       end-ds;


       dcl-pi CL01SF extpgm('CL01SF');
         ppCCL0 packed(7:0);
       end-pi;

       // Both "exec sql" is not executed but needed at compile time.
       // It must be placed just after the last "dcl" declaration.
       // LANGIDSHR defines the sort sequence as a "shared-weight sort table",
       // upper/lower insensitive, special characters are treated
       // "à" as "A"
       // "é" as "E" and so on.
       exec sql set option Commit = *None;
       exec sql set option SRTSEQ = *LANGIDSHR;
       // preapre the data recordset
       exec sql declare C1 cursor for
         select     CLANA00F.CLANN0,
                    CLANA00F.CLCCL0,
                    CLANA00F.CLNOM0
         from       CLANA00F
         where      CLANN0 like :F1ANN0lke
         and        CLCCL0 between :wF1CCL0str and :wF1CCL0end
         and        CLNOM0 like :F1NOM0lke
         order by   CLNOM0
         for read only;
       //*********************************************************
       // Start working...
       //*********************************************************
       ReLoadSFL = *on;
       dow Dspf.Exit = *off;
         if ReLoadSFL;
           LoadSFL();
         endif;
         exfmt F01;
         select;
         when Dspf.Exit;              // F3=Exit
           leave;
         when Dspf.DoubleLeftClick and RRNA > *zeros; // Row selected
           chain RRNA SFL1;
               // ... whatever you want to happen when a subfile row is doubleLeftClicked.
           ppCCL0 = S1CCL0;
           leave;
         other; // Read user options
           dow 1 = 1;
             readc SFL1;
             if Not %eof;
               if S1OPT = '1';
                 // call a program or a subroutine
                 ppCCL0 = S1CCL0;
                 leave;
               endif;
               if S1OPT = '2';
                 // call a program or a subroutine
               endif;
               S1OPT = '>';
               update SFL1;
               S1OPT = ' ';
             else;
               leave;
             endif;
           enddo;
           if S1OPT = '1';
             leave;
           endif;
         endsl;
         SetFilters();
       enddo;
       exec sql close C1;
       *inlr = *on;
       //*****************************************************************
       dcl-proc LoadSFL; // Load subfile
       //*****************************************************************
         ReLoadSFL = *off;
         // Clear subfile
         Dspf.SflClr = *on;
         write F01;
         Dspf.SflClr = *off;
         // Load SFL
         SF1NUM = *zero;
         exec sql close C1;
         exec sql open C1;
         // Read recordset
         dow Sqlcode = 0 and SF1NUM < MaxSFLrec;
           exec sql fetch C1 into :RecordDS;
           if sqlcode = 0;
             S1ANN0 = CLANN0;
             S1CCL0 = CLCCL0;
             S1NOM0 = CLNOM0;
             SF1NUM += 1;
             write SFL1;
           else;
             Dspf.SflEnd = *on; // SFLEND *END
         endif;
       enddo;

       NBRRECS = SF1NUM;
       //S1MSG = %Editc(NBRRECS:'X') + ' record loaded. No more records +
       //to load';
       if sqlcode = 0 and NBRRECS >= MaxSFLrec; // MaxSFLrec reached
       //  S1MSG = %Editc(NBRRECS:'X') + ' records loaded. Use filters field +
       //  to limit the records to be loaded.';
       endif;

       if NBRRECS = 0;
         clear SFL1;
         SF1NUM += 1;
         S1ANN0 = '*';
       //  S1MSG = 'No records loaded';
         write SFL1;
       endif;

       end-proc;
       //*****************************************************************
       dcl-proc SetFilters; // Set filters filed
       //*****************************************************************
         if (F1ANN0 <> F1ANN0prv); // char filter
           F1ANN0prv = F1ANN0;
           F1ANN0lke = '%' + %trim(F1ANN0) + '%';
           ReLoadSFL = *on;
         endif;
         if (F1CCL0 <> F1CCL0prv); // numeric filter need str & end
           F1CCL0prv = F1CCL0;
           wF1CCL0str = F1CCL0;
           wF1CCL0end = F1CCL0;
           ReLoadSFL = *on;
         endif;
         if (F1CCL0 = 0);          // numeric filter: if 0 set from 0 to HiVal
           F1CCL0prv = F1CCL0;
           wF1CCL0str = *zeros;
           wF1CCL0end = *HiVal;
         endif;
         if (F1NOM0 <> F1NOM0prv); // Name
           F1NOM0prv = F1NOM0;
           F1NOM0lke = '%' + %trim(F1NOM0) + '%';
           ReLoadSFL = *on;
         endif;
       end-proc;

Now try this:

CALL PGM(CL01SF) PARM(X'0000000F')

The Parm value is Packed 7,0, 

       dcl-pi CL01SF extpgm('CL01SF');
         ppCCL0 packed(7:0);
       end-pi;

so, give it as 0 packed to the program.

The Parm value is returned by doubleclicking on customer row.


To check the selected value try with this:


CL01SFCL.CLP

             PGM                                         
             DCL        VAR(&PPCCL0) TYPE(*DEC)  LEN(7 0)
             DCL        VAR(&PPCCLS) TYPE(*CHAR) LEN(7)  
             CALL       PGM(CL01SF) PARM(&PPCCL0)        
             CHGVAR     VAR(&PPCCLS) VALUE(&PPCCL0)      
             SNDUSRMSG  MSG(&PPCCLS) MSGTYPE(*INFO)      
             ENDPGM


Now call the CLP:

call cl01sfcl





                                      
Double click a row... I click row 1484 **Renzioli...



 


That's it. 


I appreciate all the comments made on this blog.

Comments

Post a Comment

Popular posts from this blog

(IBM i fans only) Efficient WRKSPLF with WSF - How to Search string into spooled files, Sort, and Generate PDFs on IBMi

By -
Image
Searching Spooled Files Made Easy: A Unique Solution Managing spooled files efficiently is crucial for users dealing with numerous rows of print data. IBM's WRKSPLF command provides a standard way to interact with spooled files, but it lacks certain features that can significantly enhance user experience. In this article, we'll delve into a powerful functionality that IBM doesn't offer — the ability to search among spooled file lists. Our goal is to highlight the advantages of this capability and introduce a practical solution. The Limitations of Standard WRKSPLF While the WRKSPLF command is a handy tool for working with spooled files, it falls short in certain aspects. One prominent limitation is the inability to search efficiently through the list of spooled file rows. Users often find it challenging to quickly locate specific files based on criteria like creation date, status, or content. Introducing a Unique Solution: WSF (WorkSpooledFiles) To address the limitations of...
Read more

(IBM i fans only) Detecting and Handling Non-Printable Characters in DB2 SQL Using LOCATE() and REPLACE() Functions

By -
Image
When working with DB2 SQL on the IBMi platform, one of the challenges we might encounter is dealing with non-printable characters in our data. These are characters that don't have a direct representation on a standard keyboard and can cause display programs to crash if not handled properly. For this example, we'll be working with the CLANA00F file, which contains customer data. You can find details on how to create this file on my blog post here . Non-printable characters can sneak into our records for various reasons, and to prevent issues, we can run an SQL query that uses the LOCATE() function. This function returns the position of the first occurrence of a substring within a string, allowing us to detect these problematic characters. Suppose we have a customer name with a non-printable character, specifically the EBCDIC '0D' character, which corresponds to the "Carriage Return" (CR) control character in ASCII. To find this character in our records, we can ...
Read more

(IBM i fans only) How to Sniff User Access

By -
Image
If you need to monitor user access on your IBM i system, you can use SQL to query the history log. Note: At the end of this post, you'll find a request directly addressed to you, the readers. Here’s a simple example of how you can do this: SELECT MESSAGE_ID,        MESSAGE_TIMESTAMP,        FROM_USER,        MESSAGE_TEXT     FROM TABLE (             QSYS2.HISTORY_LOG_INFO()         )     WHERE message_id IN ('CPF1164', 'CPF1124')           AND FROM_USER IN ('QSECOFR', 'QSYS', 'QSYSOPR')     ORDER BY MESSAGE_TIMESTAMP In this query: - QSYS2.HISTORY_LOG_INFO(): This function retrieves information from the history log. -  message_id IN ('CPF1164', 'CPF1124') : Filters the results to include only specific message IDs, which indicate sign-on and sign-off events. - FROM_USER in ('QSECOFR', 'QSYS', 'QSYSOPR'): Filters the resu...
Read more