Logo2

Demonstrating  a dropdown box

Oceans
[Home] [Web & .json] [Oceans]

The code for the dropdown box


The SQLRPGLE for the Oceans F4 dropdown with .json web service.
      //  ______________________________________________________________________
      //   ___             _    _     __ __             _    _
      //  | . > ___  ___ _| |_ | |_  |  \  \ ___  _ _ _| |_ <_>._ _
      //  | . \/ . \/ . \ | |  | . | |     |<_> || '_> | |  | || ' |
      //  |___/\___/\___/ |_|  |_|_| |_|_|_|<___||_|   |_|  |_||_|_|
      //
      //    Nov, 2019                                   booth@martinvt.com
      //  ______________________________________________________________________
      //    Comments:
      //    Web demo of Seas & Oceans drop-down box
      //
      //  ______________________________________________________________________
       ctl-opt
       copyright('(C) Copyright 2019, All rights reserved.')
       option(*nodebugio) dftactgrp(*no) actgrp(*new);

       dcl-f WEBSEASF4D workstn sfile(SFL1: SF1NUM);

      *  ..................................................
       dcl-c cYLW x'32';
       dcl-c cURL 'http://the.service/api/';
       dcl-s URL varchar(400);

       //  ...................... Prototype
       dcl-s wNbrCols int(10);
       dcl-pr GetScreenSize extproc('QsnRtvScrDim');
        *n int(10) options(*omit); // NbrRows
        *n int(10) options(*omit); // NbrCols
        *n int(10) options(*omit); // Handle
        *n char(32767) options(*varsize: *omit); // ErrorCode
       end-pr;

       dcl-s wSeas varchar(20);
       dcl-s wCount int(5);
       dcl-s wNdx int(5);

       dcl-pr WEBSEASF4;
        *n char(20);
        *n char(2);
        *n char(3);
       end-pr;
       // ....................... Procedure interface
       dcl-pi WEBSEASF4;
        pOCEAN char(20);
        pRow char(2);
        pCol char(3);
       end-pi;

      /free
        //====================================================================*
        // SQL definitions (must be first lines of all sql lines in source.)  *
        //====================================================================*
        // The immediately following /EXEC SQL is SQL's version of RPG's H Spec
        // It is never executed.  Just used at compile time.
         exec sql set option
           Commit = *Chg,
           DatFmt = *ISO,
           SrtSeq = *LangIDShr;   // allows sort & search with upper/lower
        //====================================================================*
        // MAINLINE-Begin                                                     *
        //====================================================================*
         if %parms = 3;   // position the dropdown box under the correct field
           WROW = %int(pRow);
           WCOL = %int(PCol);
         endif;
         //check current screen size, configure to match
         GetScreenSize(*omit:wNbrCols:*omit:*omit);
         if wNbrCols = 132;
           *in91 = *on;
         else;
           *in91 = *off;
         endif;
         // Clear subfile.
         *in90 = *off;
         write FMT01;
         *in90 = *on;
         // Fill the subfile:
         SF1NUM = *zero;
         SFLTOP = 1;
         // Read the file.
         URL = cURL + 'oceans';
         exec sql select * into :wCount
         from json_table(systools.httpgetclob(:URL, ''), '$'
             columns(entries dec(5) path '$.wData_length') );

         exec sql declare C1 cursor for
           select * from json_table(systools.httpgetclob(:URL, ''),
            'lax $.SeasOceans[*]'
             columns(oceans varchar(20)  path 'lax $')
             );
         exec sql open C1;
         for wNdx = 1 to wCount;
           exec sql fetch C1 into :wSeas;
           if sqlcode = 0;
             S1OCEAN = wSeas;
             SF1NUM += 1;
             write SFL1;
           endif;
         endfor;
         exec sql close C1;

         // If subfile is empty, make a line
         if SF1NUM = *zero;
           S1OCEAN = cYLW + 'No records';
           SF1NUM += 1;
           write SFL1;
         endif;
         SFL1RECS = SF1NUM;
         SFL1RECS = RRNA;
         if WROW = 0;
           WROW = 5;
         endif;
         if WCOL = 0;
           WCOL =  3;
         endif;
         exfmt FMT01;

       // If a choice was made, save it to PARM for return:
       if %parms > 0 and RRNA > *zeros and not *inkl;
         chain RRNA SFL1;
         pOCEAN = S1OCEAN;
       endif;
       *inlr = *on;
        //====================================================================*
        // MAINLINE-End                                                       *
        //====================================================================*
      /end-free  




The DSPL file for the Oceans F4 dropdown box

      *     ___             _    _     __ __             _    _
      *    | . > ___  ___ _| |_ | |_  |  \  \ ___  _ _ _| |_ <_>._ _
      *    | . \/ . \/ . \ | |  | . | |     |<_> || '_> | |  | || ' |
      *    |___/\___/\___/ |_|  |_|_| |_|_|_|<___||_|   |_|  |_||_|_|
      *
      *    11/2019
      *  _______________________________________________________________________
      *    Web demo of Seas & Oceans, drop-down box
      *
      *  _______________________________________________________________________
                                            DSPSIZ(*DS3 *DS4)
                                            CHGINPDFT
                                            ERRSFL
                                            CA03 CA12
      *  _______________________________________________________________________
                R SFL1                      SFL
                  S1OCEAN       20      1  2
      *  -----------------------------------------------------------------------
                R FMT01                     SFLCTL(SFL1)
                                            SFLSIZ(&SFL1RECS)
                                            SFLPAG(8)
                                            WINDOW(&WROW &WCOL 8 25 *NOMSGLIN)
                                            OVERLAY
                                            MOUBTN(*ULP ENTER)
                                            SFLCSRRRN(&RRNA)
       N90                                  SFLCLR
        90                                  SFLDSP SFLDSPCTL SFLEND(*SCRBAR)
        91                                  DSPMOD(*DS4)
                  SFLTOP         4S 0H      SFLRCDNBR(CURSOR *TOP)
                  SF1NUM         4S 0H
                  RRNA           5S 0H
                  SFL1RECS       5S 0P
                  WROW           2S 0P
                  WCOL           3S 0P
      *  -----------------------------------------------------------------------
                R DUMMY
                                            TEXT('Prevents previous screen-
                                             from being cleared.')
                                            ASSUME
                                        5  9' ' 



The code for the prompt screen


The SQLRPGLE for the Oceans prompt screen
      //  ______________________________________________________________________
      //   ___             _    _     __ __             _    _
      //  | . > ___  ___ _| |_ | |_  |  \  \ ___  _ _ _| |_ <_>._ _
      //  | . \/ . \/ . \ | |  | . | |     |<_> || '_> | |  | || ' |
      //  |___/\___/\___/ |_|  |_|_| |_|_|_|<___||_|   |_|  |_||_|_|
      //
      //    Nov, 2019                                        booth@martinvt.com
      //  ______________________________________________________________________
      //    Web demo of Seas & Oceans drop-down box
      //
      //  ______________________________________________________________________
       ctl-opt
       copyright('(C) Copyright, 2019, All rights reserved.')
       option(*nodebugio) dftactgrp(*no) actgrp(*new);

       dcl-f WEBSEASD workstn;

       dcl-c cTrq x'30';

       dcl-ds *n PSDS;
        USERID char(10) pos(358);
       end-ds;

       dcl-pr ShowDropDown extpgm('WEBSEASF4');
        *n char(20);
        *n char(2) const;
        *n char(3) const;
       end-pr;

        //==================================================================== *
        // MAINLINE                                                            *
        //==================================================================== *
        // The immediately following /EXEC SQL set options is SQL's version
        // of RPG's H Spec.  It is never executed.  Just used at compile time.
        // MUST be in source code above any other exec SQL statements.
          exec sql set option
           Commit = *None,
           SrtSeq = *LangIDShr;   // allows sort & search with upper/lower
        //  ____________________________________________________________________
       /free
         exsr GetHeading;
         dow *inkc = *off;
           exsr ChangeColors;
           exfmt FMT01;
           select;
             when *inkc;        // exit
             when *inkd or CSRFLD = 'F4PROMPT'
                        or (*in71 and CSRFLD = 'S1OCEAN');
               ShowDropDown(S1OCEAN: '11': '19'); // Drop-down box (row&column)
             other;
           endsl;
         enddo;
         *inlr = *on;
        //====================================================================*
        // MAINLINE-END                                                       *
        //====================================================================*
        //-------------------------------*  Sub-Routine  *
        // GetHeading()                  *---------------*
        //-----------------------------------------------*
        begsr GetHeading;
          HDG5X40 =
                    '   _      __    __                      '
                  + '  | | /| / /__ / /    -= Prompt for a =-'
                  + '  | |/ |/ / -_) _ \   -= Sea/Ocean w/ =-'
                  + '  |__/|__/\__/_.__/   -= drop-down.   =-';
          HDG7X23 =
                    '                       '
                  + '                       '
                  + '          ,,,          '
                  + '         (O-O)         '
                  + '  ----oo0-(_)-0oo----  '
                  + '                       '
                  + '                       ';
         exec SQL                              // Get user's name to display.
           select CID.ODOBTX
             into :S1USERNAME
             from Table( QSYS2/USERS() ) AS CID
             where CID.ODOBNM = :USERID;
         evalr S1USERNAME = 'with' + cTrq + %trim(S1USERNAME);
        endsr;
        //-------------------------------*  Sub-Routine  *
        // Change Heading Colors         *---------------*
        //-----------------------------------------------*
        begsr ChangeColors;
          select;
            when *in61;
              *in61 = *off;
              *in62 = *on;
            when *in62;
              *in62 = *off;
              *in63 = *on;
            when *in63;
              *in63 = *off;
              *in64 = *on;
            when *in64;
              *in64 = *off;
              *in65 = *on;
            when *in65;
              *in65 = *off;
              *in66 = *on;
            when *in66;
              *in66 = *off;
              *in67 = *on;
            other;
              *in67 = *off;
              *in61 = *on;
          endsl;
        endsr; 




The DSPL file for the Oceans prompt screen

      *     ___             _    _     __ __             _    _
      *    | . > ___  ___ _| |_ | |_  |  \  \ ___  _ _ _| |_ <_>._ _
      *    | . \/ . \/ . \ | |  | . | |     |<_> || '_> | |  | || ' |
      *    |___/\___/\___/ |_|  |_|_| |_|_|_|<___||_|   |_|  |_||_|_|
      *
      *    11/2019
      *  _______________________________________________________________________
      *    Web demo of Seas & Oceans, drop-down box
      *
      *  _______________________________________________________________________
                                            DSPSIZ(*DS3)
                                            ERRSFL
                                            CA03 CA04 PAGEDOWN(71)
      *  _______________________________________________________________________
                R FMT01                     MOUBTN(*ULP ENTER)
                                            RTNCSRLOC(&CSRRCD &CSRFLD)
                  CSRRCD        10   H
                  CSRFLD        10   H
                                        1  2'System i'
                                        2  2'WEBSEAS'
                  HDG5X40      200   B  1 12CNTFLD(40) CHGINPDFT
                                            DSPATR(PR)
        67                                  COLOR(GRN)
        61                                  COLOR(PNK)
        62                                  COLOR(TRQ)
        63                                  COLOR(WHT)
        64                                  COLOR(BLU)
        65                                  COLOR(RED)
        66                                  COLOR(YLW)
                  HDG7X23      161   B  1 56CNTFLD(23) CHGINPDFT
                                            DSPATR(PR)
        61                                  COLOR(GRN)
        62                                  COLOR(PNK)
        63                                  COLOR(TRQ)
        64                                  COLOR(WHT)
        65                                  COLOR(BLU)
        66                                  COLOR(RED)
        67                                  COLOR(YLW)
                  S1USERNAME    50      6  2COLOR(YLW)
                  HDG50         50      7  2COLOR(BLU) DSPATR(UL)
                                       10 12'Sea/Ocean'
                  S1OCEAN       20   B   + 1COLOR(WHT) CHECK(LC)
                  F4PROMPT       4   B   + 1COLOR(BLU) DFTVAL('(F4)')
                  PB1            2Y 0B 23  3PSHBTNFLD((*GUTTER 2))
                                            PSHBTNCHC(1 'Done' CA03)
                                            PSHBTNCHC(2 'Drop-down  F4' CA04)
                                            CHCAVAIL((*COLOR PNK))
                                       22 50'F-4, mouse-click on'
                                            COLOR(BLU)
                                         + 1'(F4)' DSPATR(UL) COLOR(BLU)
                                       23 50'or Page-down for drop-down.'
                                            COLOR(BLU) 



Please contact our Webmaster with questions or comments.

© Copyright 2010-2019, Contract Programming  All rights reserved.