星期二, 10月 31, 2023

2000-07-10 如何針對畫面 Subfile data 動態排序?



□ Tips :  如何針對畫面 Subfile data  動態排序?

--------------------------------
Usage: 
1. Create SQLSFLPF PF
2. Create SQLSFLSRTD DSPF
3. Create SQLSFLSRTR
4. Call SQLSFLSRTR, Press F4 to select key

--------------------------------
QDDSSRC: SQLSFLPF  Type: PF
     A                                      UNIQUE
     A          R SFL001
     A            DBLNAM        12
     A            DBFNAM        10
     A            DBMINI         1
     A            DBNNAM        10
     A          K DBLNAM
     A          K DBFNAM

QDDSSRC: SQLSFLSRTD  Type: DSPF
     A                                      DSPSIZ(24 80 *DS3)
     A                                      PRINT ERRSFL
     A                                      CA03 CA12 CF04
     A*
     A          R SFL1                      SFL
     A            DBLNAM    R        O  5  2REFFLD(DBLNAM SQLSFLPF)
     A            DBFNAM    R        O  5 26REFFLD(DBFNAM SQLSFLPF)
     A            DBMINI    R        O  5 50REFFLD(DBMINI SQLSFLPF)
     A            DBNNAM    R        O  5 55REFFLD(DBNNAM SQLSFLPF)
     A*
     A          R SF1CTL                    SFLCTL(SFL1)
     A                                      SFLSIZ(0050) SFLPAG(0017)
     A                                      OVERLAY
     A N32                                  SFLDSP
     A N31                                  SFLDSPCTL
     A  31                                  SFLCLR
     A  90                                  SFLEND(*MORE)
     A            RRN1           4S 0H      SFLRCDNBR
     A                                  4  2'Last Name'  DSPATR(HI)
     A                                  4 26'First Name' DSPATR(HI)
     A                                  4 50'MI'         DSPATR(HI)
     A                                  4 55'Nick Name'  DSPATR(HI)
     A                                  1  2'PGM :SQLSFLSRTR'
     A                                  2  2'DSPF:SQLSFLSRTD'
     A                                  1 26'Dynamic Sort with Embedded SQL'
     A                                      DSPATR(HI)
     A                                  1 71DATE EDTCDE(Y)
     A                                  2 71TIME
     A*
     A          R FKEY1
     A                                 23  2'F3=Exit'    COLOR(BLU)
     A                                    +3'F4=Prompt'  COLOR(BLU)
     A                                    +3'F12=Cancel' COLOR(BLU)
     A          R WINDOW1
     A                                      WINDOW(*DFT 11 25)
     A            TAB1           1   B  3  2
     A                                  3  5'Last Name'
     A            TAB2           1   B  4  2
     A                                  4  5'First Name'
     A            TAB3           1   B  5  2
     A                                  5  5'Middle Initial'
     A            TAB4           1   B  6  2
     A                                  6  5'Nick Name'
     A                                 10  1'F3=Exit'    COLOR(BLU)
     A                                 10 11'F12=Cancel' COLOR(BLU)
     A                                  1  3'Select a sort field'
     A                                      DSPATR(HI)

QRPGLESRC: SQLSFLSRTR Type: SQLRPGLE
      *****************************************************************
      *  To compile:
      *    CRTSQLRPGI OBJ(xxx/SFL013RG) SRCFILE(xxx/QRPGLESRC) +
      *                SRCMBR(SFL013RG) RDB(*LOCAL) OBJTYPE(*PGM) +
      *                DLYPRP(*YES) SQLPKG(*OBJ)
      *****************************************************************
     FSQLSFLSRTDcf   e             workstn sfile(sfl1:rrn1)
     F                                     infds(info)
      *
      * Information data structure to hold attention indicator byte.
     Dinfo             ds
     D cfkey                 369    369
      * Constants for attention indicator byte
     Dexit             C                   const(X'33')
     Dprompt           C                   const(X'34')
     Dcancel           C                   const(X'3C')
     Denter            C                   const(X'F1')

     Dorder            S              8    INZ('dblnam')
     Dselct1           S            500A   INZ('SELECT dblnam, dbfnam, -
     D                                     dbmini, dbnnam -
     D                                     FROM sqlsflpf -
     D                                     ORDER BY ')
     Dselct2           S            500A   INZ(' ')

      * Establish the connection to the remote machine. The -842 return
      * code indicates that the connection is already established. If
      * you want to connect to the local machine, use CONNECT.
     C/EXEC SQL
     C+ CONNECT reset
     C/END-EXEC
     C                   exsr      prep
     C                   exsr      sflbld
      *
     C                   dou       (cfkey = exit)
     C                   write     fkey1
     C                   exfmt     sf1ctl
     C                   select
      * prompt to selection sorting criteria
     C                   when      cfkey = prompt
     C                   exsr      sort
     C                   exsr      clean
     C                   exsr      prep
     C                   exsr      sflbld
     C                   when      cfkey = cancel
     C                   leave
     C                   endsl
     C                   enddo
      *
     C                   exsr      clean
      *  Disconnect the current connection.
     C/EXEC SQL
     C+   DISCONNECT CURRENT
     C/END-EXEC
     C                   eval      *inlr = *on
      *****************************************************************
      * Prepare SQL cursor
      *****************************************************************
     C     prep          begsr
      *
      * Prepare the SQL statement for validation, since the program was
      * compiled with DLYPRP (*YES), it will wait until it is used before
      * it prepares the cursor.
      *
     C                   eval      selct2 = %trimr(selct1) + ' ' + order
      *
     C/EXEC SQL
     C+ PREPARE sel FROM :selct2
     C/END-EXEC
      *
      * Declare the SQL cursor to hold the data retrieved from the SELECT
     C/EXEC SQL
     C+ DECLARE MYCSR SCROLL CURSOR FOR SEL
     C/END-EXEC
      *
      * Open the SQL cursor.
     C/EXEC SQL
     C+ OPEN MYCSR
     C/END-EXEC
      *
     C                   endsr
      *****************************************************************
      * Clean up before exiting
      *****************************************************************
     C     clean         begsr
      *
      *  Close the SQL cursor after all processing is complete.
     C/EXEC SQL
     C+   CLOSE MYCSR
     C/END-EXEC
      *
     C                   endsr
      *****************************************************************
      * Build the subfile
      *****************************************************************
     C     sflbld        begsr
      *
      * Clear the subfile
     C                   eval      *in31 = *on
     C                   write     sf1ctl
     C                   eval      *in31 = *off
     C                   eval      rrn1 = 0
      *
      * Process the records in the SQL cursor until the return not = 0
     C                   dou       sqlcod <> 0
      * Get the next row from the SQL cursor.
     C/EXEC SQL
     C+   FETCH NEXT FROM MYCSR
     C+      INTO :dblnam, :dbfnam, :dbmini, :dbnnam
     C/END-EXEC
     C                   if        sqlcod = 0
     C                   eval      rrn1  = rrn1  + 1
     C                   write     sfl1
     C                   endif
     C                   enddo
      *
     C                   if        rrn1 = 0
     C                   eval      *in32 = *on
     C                   else
     C                   eval      rrn1 = 1
     C                   endif
      *
     C                   eval      *in90 = *on
      *
     C                   endsr
      *****************************************************************
      * SORT - prompt to select sort criteria
      *****************************************************************
     C     sort          begsr
      *
     C                   exfmt     window1
      *
     C                   select
     C                   when      tab1 <> *blank
     C                   movel(p)  'dblnam'      order
     C                   clear                   tab1
     C                   when      tab2 <> *blank
     C                   movel(p)  'dbfnam'      order
     C                   clear                   tab2
     C                   when      tab3 <> *blank
     C                   movel(p)  'dbmini'      order
     C                   clear                   tab3
     C                   when      tab4 <> *blank
     C                   movel(p)  'dbnnam'      order
     C                   clear                   tab4
     C                   endsl
      *
     C                   endsr



沒有留言: