□ 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
A blog about IBM i (AS/400), MQ and other things developers or Admins need to know.
星期二, 10月 31, 2023
2000-07-10 如何針對畫面 Subfile data 動態排序?
訂閱:
張貼留言 (Atom)
沒有留言:
張貼留言