midrange.com code scratchpad
Name:
RPG subfile program with SQL forward and backward scrolling
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
10/22/2008 08:28:15 pm
IP:
Logged
Description:
Some example code from an RPG program that provides forward and backward scrolling using SQL
Code:
  1.        //
  2.        // Mainline logic
  3.        DoU gDisplayFileControl.exit
  4.              or gDisplayFileControl.cancel;
  5.          //
  6.          // Check for existing subfile records to condition SFLDSP
  7.          if gDtlSubfRrn > 0;
  8.            gDisplayFileControl.displaySubfile = *ON;
  9.          Else;
  10.            gDisplayFileControl.displaySubfile = *OFF;
  11.          endif;
  12.  
  13.          gDisplayFileControl.subfileDropMode = dspfSubfMode;
  14.  
  15.          Write MsgSubfCtl;
  16.          ExFmt DtlSubfCtl;
  17.          RmvMsgsFrmQ();
  18.  
  19.          select;
  20.            when gDisplayFileControl.exit
  21.             or gDisplayFileControl.cancel;
  22.              iter;
  23.            when UserEnteredNewCriteria();
  24.              OpenCursor();
  25.              LoadSubFile(READ_START);
  26.            when gDisplayFileControl.printList;
  27.              PrintListing();
  28.              LoadSubFile(READ_START);
  29.            when gDisplayFileControl.pagedown;
  30.              LoadSubFile(READ_FORWARD);
  31.            when gDisplayFileControl.pageup;
  32.              LoadSubFile(READ_BACKWARD);
  33.          endsl;
  34.        enddo;
  35.        //
  36.        // End of program
  37.        *INLR = *ON;
  38.        return;
  39.       /end-free
  40.  
  41.  
  42.      p LoadSubfile     b
  43.        //
  44.        //==============================================================*
  45.        // Load subfile records                                         *
  46.        //
  47.        //==============================================================*
  48.        //
  49.      d LoadSubfile     pi
  50.      d  pDirectionToRead...
  51.      d                                1a   value
  52.  
  53.      d wNbrRecsRead    s              5i 0 static
  54.      d wEOF            s               n   static
  55.      d wCurRecNbr      s             10i 0 static
  56.      d wRelativePos    s              5i 0
  57.      d wIdx            s              5i 0
  58.      d wIdxLimit       s              5i 0
  59.      d wNbrRowsToFetch...
  60.      d                 s              5i 0 inz(MAX_RECORDS_FETCHED)
  61.  
  62.      d wReturnedData   ds                  occurs(MAX_RECORDS_FETCHED)
  63.      d  wChkReqNbr                    7a
  64.      d  wInvoiceNbr                  10a
  65.      d  wCheckNbr                    10a
  66.      d  wAcctNbr                     10a
  67.      d  wAmount                       9p 2
  68.      d  wTfrDate                      4p 0
  69.      d  wCheckDate                    4p 0
  70.      d  wPaidDate                     4p 0
  71.      d  wVoidDate                     4p 0
  72.      d  wPlantCode                    3a
  73.      d  wPurOrd                       8a
  74.      d  wVendNbr                      6a
  75.      d  wVendName                    40a
  76.  
  77.       /free
  78.  
  79.          //
  80.          // Clear subfile
  81.          gDisplayFileControl.clearSubfile = *ON;
  82.          Write DtlSubfCtl;
  83.          gDisplayFileControl.clearSubfile = *OFF;
  84.  
  85.          // where do we start fetching from?
  86.          select;
  87.            when pDirectionToRead = READ_START;
  88.              //First screen
  89.              wRelativePos = 1;
  90.              wCurRecNbr = 0;
  91.            when pDirectionToRead = READ_BACKWARD
  92.               and wCurRecNbr <= MAX_RECORDS_FETCHED;
  93.              // Start over at begining
  94.              wRelativePos = 1 - wNbrRecsRead;
  95.              wCurRecNbr = 0;
  96.            when pDirectionToRead = READ_BACKWARD;
  97.              // back to top of prior screen
  98.              wRelativePos = 1 - MAX_SUBFILE_RECORDS - wNbrRecsRead;
  99.              wCurRecNbr += wRelativePos - 1;
  100.            // must be READ_FORWARD
  101.            when wEOF;
  102.              // top of current screen (redisplay)
  103.              wRelativePos = 1 - wNbrRecsRead;
  104.              wCurRecNbr += wRelativePos - 1;
  105.            other;
  106.              //last record fetched was never displayed
  107.              wRelativePos = 0;
  108.              wCurRecNbr -= 1;
  109.          endsl;
  110.  
  111.       /end-free
  112.      c/exec SQL
  113.      c+  fetch relative :wRelativePos from C1
  114.      c+     for :wNbrRowsToFetch rows
  115.      c+     into :wReturnedData
  116.      c/end-exec
  117.       /free
  118.  
  119.          wNbrRecsRead = SqlEr3;
  120.          wCurRecNbr += wNbrRecsRead;
  121.          if wNbrRecsRead < MAX_SUBFILE_RECORDS + 1;
  122.            wEOF = *ON;
  123.            wIdxLimit = wNbrRecsRead;
  124.          else;
  125.            wEOF = *OFF;
  126.            wIdxLimit = MAX_SUBFILE_RECORDS;
  127.          endif;
  128.  
  129.          for wIdx = 1 to wIdxLimit;
  130.            %occur(wReturnedData) = wIdx;
  131.            dspfChkReqNbr = wChkReqNbr;
  132.            dspfInvoiceNbr = wInvoiceNbr;
  133.            dspfCheckNbr = wCheckNbr;
  134.            dspfAcctNbr = wAcctNbr;
  135.            dspfAmount = wAmount;
  136.            dspfTfrDate = wTfrDate;
  137.            dspfCheckDate = wCheckDate;
  138.            dspfPaidDate = wPaidDate;
  139.            dspfPlantCode = wPlantCode;
  140.            dspfPurOrd = wPurOrd;
  141.            dspfVendNbr = wVendNbr;
  142.            dspfVendName = wVendName;
  143.            gDtlSubfRrn = wIdx;
  144.            write DtlSubfile;
  145.          endfor;
  146.  
  147.          gDisplayFileControl.endOfSubfile = wEOF;
  148.          return;
  149.       /end-free
  150.      p LoadSubfile     e
  151.  
  152.  
© 2004-2019 by midrange.com generated in 0.009s valid xhtml & css