Logo2
Menu
[Home] [Web & .json] [Menu]
webMenu

The SQLRPGLE for a mousable menu
      //  ______________________________________________________________________
      //   ___             _    _     __ __             _    _
      //  | . > ___  ___ _| |_ | |_  |  \  \ ___  _ _ _| |_ <_>._ _
      //  | . \/ . \/ . \ | |  | . | |     |<_> || '_> | |  | || ' |
      //  |___/\___/\___/ |_|  |_|_| |_|_|_|<___||_|   |_|  |_||_|_|
      //
      //                                                     booth@martinvt.com
      //  ______________________________________________________________________
      //    Web demo of Web Menu
      //    Nov, 2019
      //  ______________________________________________________________________
       ctl-opt
       option(*nodebugio) dftactgrp(*no) actgrp(*new);

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

       dcl-c cTrq x'30';
       dcl-c cBLUu x'3E';

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

       dcl-s SavedMENUCAT like(smenucat);
       dcl-s wMenuCat like(smenucat);
       dcl-s wMenuItem like(smenuitem);
       dcl-s wMenuCmd like(smenucmd);
       dcl-s wNbr1 zoned(3);
       dcl-s wNbr2 zoned(3);
       dcl-s wNdx zoned(3);
       dcl-s wCount zoned(3);
       dcl-s Ar1 like(smenuitem) dim(16);
       dcl-s Ar2 like(smenucmd) dim(16);
       dcl-s Ar3 like(smenucat) dim(16);

       dcl-s wcmd varchar(1024);
       dcl-pr qCmd extpgm('QCMDEXC');
        *n char(1024) const;
        *n packed(15: 5) const;
       end-pr;

       // 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
       //==================================================================== *
       // MAINLINE                                                            *
       //==================================================================== *
       exsr FillFMT01;
       dow *inkc = *off;
         exsr ChangeColors;
         write S1CMD;
         exfmt FMT01;
         if SFLTOP2 < NBRREC;
         SFLTOP1 = SFLTOP2;   // Resets screen to same position.
         endif;
         select;
           when *inkc;        // exit
           when *inkp;
             wCmd = 'SIGNOFF';
               monitor;
                 qCmd(wCmd: %len(%trim(wCmd)));
               on-error;
               endmon;
           when SF1PICKED <> 0;
             chain SF1PICKED SFL1;
             wCmd = SMENUCMD;
             monitor;
               qCmd(wCmd: %len(%trim(wCmd)));
             on-error;
             endmon;
           other;
           endsl;
         enddo;
         *inlr = *on;
        //==================================================================== *
        // MAINLINE-END                                                        *
        //==================================================================== *
        //  Get & Set Heading info  --------------------------------------------
        begsr GetHeading;
          HDG5X40 =
                    '   _      __    __     __ __     __     '
                  + '  | | /| / /__ / /    / // /_ __/ /_    '
                  + '  | |/ |/ / -_) _ \  / _  / // / __/    '
                  + '  |__/|__/\__/_.__/ /_//_/\_,_/\__/     ';
          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;
        //  Fill Screen  -------------------------------------------------------
        begsr FillFMT01;
          exsr GetHeading;
          SF1NUM = 0;                 // clear subfile
          *in80=*on;
          clear SFL1;
          write FMT01;
          *in80 = *off;
          SF1NUM = *zero;

          // Fill Array of entries (reduce widows & orphans)
          exec sql declare C1 cursor for  // Get all records
            select MENUCAT, MENUITEM, MENUCMD
              from WEBMENUP
              order by MENUCAT, MENUSEQ;
          exec sql open C1;

          dow Sqlcode = 0;                   // Table read loop
            exec sql fetch C1 into :wMenuCat, :wMenuItem, :wMenuCmd;
            if sqlcode = 0;
              if wMenuCat <> SavedMENUCAT;    // Category change: Show a heading.
                SavedMENUCAT = wMenuCat;
                exsr AddMenuItems;
                wCount += 1;           // top line, blank, blue, underlined
                Ar1(wCount) = cBLUu;
                Ar2(wCount) = *blank;
                Ar3(wCount) = *blank;

                wCount += 1;    // 2nd line, Category centered, blue, underlined
                wNbr1 = (%size(SMENUITEM) + 1) -
                        (%len(%trim(wMenuCat)));
                wNbr2 = wNbr1 / 2;
                clear SMENUITEM;
                %subst(SMENUITEM: wNbr2:    // Center Category on column
                   %len(%trim(wMenuCat))) = %trim(wMenuCat);
                Ar1(wCount) = cBLUu + SMENUITEM;
                Ar2(wCount) = *blank;
                Ar3(wCount) = *blank;
              endif;
              if wMenuItem <> *blank;
                wCount += 1;           // Item shown, normal
                Ar1(wCount) = '  ' + wMenuItem;
                Ar2(wCount) = wMenuCmd;
                Ar3(wCount) = wMenuCat;
              endif;
            endif;
          enddo;
          exec sql close C1;
          exsr AddMenuItems;     // Add entries still in array.
        endsr;
        //  Add Menu Items  ----------------------------------------------------
        //   This step lessens widows & orphans
        begsr AddMenuItems;
            wNbr1 = 16 - %rem(SF1NUM: 16);   // = empty rows left in column
            if wCount > wNbr1;              // array is filled with more rows:
              for wNdx = 1 to wNbr1;        // fill rest of column
                SMENUITEM = *blank;         // with blamk lines.
                SMENUCMD = *blank;
                SMENUCAT = *blank;
                SF1NUM = SF1NUM + 1;
                write SFL1;
              endfor;
            endif;
            for wNdx = 1 to wCount;
              SMENUITEM = Ar1(wNdx);
              SMENUCMD = Ar2(wNdx);
              SMENUCAT = Ar3(wNdx);
              SF1NUM = SF1NUM + 1;
              write SFL1;
            endfor;
          NBRREC = SF1NUM;
          SFLTOP1 = 1;
          clear AR1;
          clear AR2;
          clear AR3;
          clear wCount;
        endsr;
        // --  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 a mousable menu

      *  _______________________________________________________________________
      *   ___             _    _     __ __             _    _
      *  | . > ___  ___ _| |_ | |_  |  \  \ ___  _ _ _| |_ <_>._ _
      *  | . \/ . \/ . \ | |  | . | |     |<_> || '_> | |  | || ' |
      *  |___/\___/\___/ |_|  |_|_| |_|_|_|<___||_|   |_|  |_||_|_|
      *
      *                                                     booth@martinvt.com
      *  _______________________________________________________________________
      *    Web demo of Menu of demos
      *    Nov, 2019
      *  _______________________________________________________________________
                                            DSPSIZ(*DS3)
                                            REF(WEBMENUP)
                                            ERRSFL
                                            CA03 CF15
      *  _______________________________________________________________________
                R SFL1                      SFL
                  SMENUITEM R   +2   O  9  3REFFLD(MENUITEM)
                  SMENUCMD  R        H      REFFLD(MENUCMD)
                  SMENUCAT  R        H      REFFLD(MENUCAT)
      *  _______________________________________________________________________
                R FMT01                     SFLCTL(SFL1)
                                            RTNCSRLOC(&REC &FLD)
                                            OVERLAY
                                            MOUBTN(*ULP ENTER)
       N80                                  SFLDSP SFLDSPCTL
        80                                  SFLCLR
        81                                  SFLEND(*SCRBAR *MORE)
                                            SFLSIZ(&NBRREC)
                                            SFLPAG(0026)
                                            SFLLIN(4)
                                            SFLCSRRRN(&SF1PICKED)
                  SFLTOP1        4S 0H      SFLRCDNBR(CURSOR *TOP)
                  SFLTOP2        5S 0H      SFLSCROLL
                  NBRREC         5S 0P
                  SF1NUM         4S 0H
                  REC           10   H
                  FLD           10   H
                  SF1PICKED      5S 0H
                                        1  2'WEBMENU'
                                        2  2'System i'
                  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 54CNTFLD(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)
                  S1HDG         76      8  2DSPATR(UL) COLOR(BLU)
      *  _______________________________________________________________________
                R S1CMD
                  PB2            2Y 0B 23  3PSHBTNFLD((*GUTTER 2))
                                            PSHBTNCHC(1 'Done' CA03)
                                            PSHBTNCHC(2 'Sign-off' CF15)
                                            CHCAVAIL((*COLOR PNK)) 




The source file for a mousable menu's data

      //  ______________________________________________________________________
      //  Create WEBMENUP file with SQL.
      //
      //   WEBMENUPR   (.sqlrpgle)
      //  ______________________________________________________________________
     h option(*nodebugio) dftactgrp(*no) actgrp(*new)

      /free
        *inlr = *on;
        // 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 = *None;

        // Create WEBMENUP File
        exec sql
          Create Table DVABRMD/WEBMENUP (
            MENUCAT char(30) not null,       // Category
            MENUSEQ decimal(2) not null,     // Seq.# within category
            MENUITEM char(30) not null,      // Label to be displayed on menu
            MENUCMD char(120) not null,      // Command to execute, if chosen.
            primary key(MENUCAT,MENUSEQ) ) RCDFMT WEBMENUPR;
      /end-free 



Please contact our Webmaster with questions or comments.

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