l4wdev05_0180

[ |../../index.htm#lansa/l4wdev05_0180.htm]
現在地:

4.3.12 ページ単位のリスト・ビュー(前後にスクロール可能)

処理対象ファイル
DEMNACをキーとする物理ファイル「DEMNAME」(氏名と住所の対応ファイル)と、DEMNAMをキーとする論理ビュー「DEMNAMEN」。

 
RDMLプログラム/サブルーチン
以下に示すプログラムは「検索」サブルーチンとして働き、他のプログラムから呼び出される形で処理を行います。
ユーザーが直接起動することは想定していません。このプログラムは、顧客の氏名を画面にリスト・ビューします。ユーザーがいずれかを選択すると、
該当するレコードの「コード」と氏名が呼び出し元プログラムに返されるので、これを使ってさらに別の処理を実行できます。
ユーザーはこのとき、画面をスクロールして「次の」ページを表示できるだけでなく、「前の」ページに戻ることもできます。さらに、任意のページに直接「ジャンプ」することも可能です。
********* Define work variables and constants DEFINE     #PAGESIZE REFFLD(#LISTCOUNT) DEFAULT(14) DEFINE     #LISTSIZE REFFLD(#LISTCOUNT) DEFINE     #WORKSIZE REFFLD(#LISTCOUNT) DEFINE     FIELD(#SEARCHNAM) REFFLD(#DEMNAM)             LABEL('Search for') DEFINE     FIELD(#TOPPAGNAM) REFFLD(#DEMNAM) DEFAULT(X'FF') DEFINE     FIELD(#BOTPAGNAM) REFFLD(#DEMNAM) DEFAULT(*BLANKS) ********** Define identical list to display and list to work with DEF_LIST   NAME(#LIST01) FIELDS((#SELECTOR             *SELECT)(#DEMNAC)(#DEMNAM)(#DEMAD1)(#DEMPCD))             COUNTER(#LISTSIZE) DEF_LIST   NAME(#WORK01)             FIELDS((#DEMNAC)(#DEMNAM)(#DEMAD1)(#DEMPCD))             COUNTER(#WORKSIZE) TYPE(*WORKING) ENTRYS(14) ********** Define a permanent exchange list and file open options EXCHANGE   FIELDS(#DEMNAC #DEMNAM) OPTION(*ALWAYS) OPEN       FILE(DEMNAMEN) USE_OPTION(*ONDEMAND) ********** Process search requests until a name is selected or ********** function key 24 is used to end the program BEGIN_LOOP    REQUEST    FIELDS((#SEARCHNAM)) BROWSELIST(#LIST01)                EXIT_KEY(*NO) MENU_KEY(*NO) USER_KEYS((*ROLLUP                'Up')(*ROLLDOWN 'Down') (24 'End'))       CASE       OF_FIELD(#IO$KEY)          WHEN       ('= UP')            / Roll up key   /          EXECUTE    ROLL (UP #BOTPAGNAM)          WHEN       ('= DN')            / Roll down key /          EXECUTE    ROLL (DOWN #TOPPAGNAM)          WHEN       ('= ''24''')         / Fnc key 24    /          CHANGE     FIELD(#DEMNAC)  TO('''?''')          CHANGE     FIELD(#DEMNAM)  TO(*BLANKS)          RETURN          OTHERWISE                        / Enter key     /                 SELECTLIST #LIST01 GET_ENTRYS(*SELECT)                 RETURN                 ENDSELECT          EXECUTE    ROLL (UP #SEARCHNAM)       ENDCASE END_LOOP **********     ROLL      :Roll page backwards/forwards **********     DIRECTION :Direction to roll (UP/DN) **********     STARTNAM  :Name at which to start roll SUBROUTINE ROLL PARMS((#DIRECTION *RECEIVED)            (#STARTNAM *RECEIVED)) DEFINE     FIELD(#DIRECTION) TYPE(*CHAR) LENGTH(4) DEFINE     FIELD(#STARTNAM)  REFFLD(#DEMNAM) CLR_LIST   NAMED(#WORK01) *********  Handle a roll up request IF         COND('#DIRECTION = UP') SELECT     FIELDS((#WORK01)) FROM_FILE(DEMNAMEN)             WHERE('#WORKSIZE *LT #PAGESIZE')             WITH_KEY(#STARTNAM) OPTIONS(*STARTKEY              *ENDWHERE) ADD_ENTRY  TO_LIST(#WORK01) ENDSELECT *********  Handle a roll down request ELSE SELECT     FIELDS((#WORK01)) FROM_FILE(DEMNAMEN)             WHERE('#WORKSIZE *LT #PAGESIZE')             WITH_KEY(#STARTNAM)             OPTIONS(*STARTKEY *ENDWHERE *BACKWARDS) ADD_ENTRY  TO_LIST(#WORK01) ENDSELECT SORT_LIST  NAMED(#WORK01) BY_FIELDS((#DEMNAM)) / Important */ ENDIF ********* Map work list to browse list for display CLR_LIST   NAMED(#LIST01) SELECTLIST NAMED(#WORK01) ADD_ENTRY  TO_LIST(#LIST01) ENDSELECT ********* Set/save pointers to top and bottom of displayed page IF         COND('#WORKSIZE = 0') CHANGE     FIELD(#TOPPAGNAM) TO(X'FF') CHANGE     FIELD(#BOTPAGNAM) TO(*BLANKS) MESSAGE    MSGTXT('Search request is beyond start or end of names             file') ELSE GET_ENTRY  NUMBER(1) FROM_LIST(#WORK01) CHANGE     FIELD(#TOPPAGNAM) TO(#DEMNAM) GET_ENTRY  NUMBER(#WORKSIZE) FROM_LIST(#WORK01) CHANGE     FIELD(#BOTPAGNAM) TO(#DEMNAM) ENDIF ENDROUTINE The type of RDML program that calls this program would probably include code like this: ********* Ask user to input a customer name code REQUEST    FIELDS((#DEMNAC) .... etc, etc) ********* Validate name code (with optional search allowed) BEGINCHECK    IF         COND('#DEMNAC = ''?''')    CALL       PROCESS(XXXXXXXXXX) FUNCTION(YYYYYYY)    ENDIF    FILECHECK  FIELD(#DEMNAC) WITH_FILE(DEMNAME)                MSGTXT('No customer with name & address                        code exists') ENDCHECK
 
呼び出し元プログラムでは、ユーザーが入力したコード(#DEMNAC)がDEMNAMEファイルに存在するコードかどうか確認し、存在すれば次の処理に進みます。存在しない場合はREQUESTコマンドに制御を戻し、エラー・メッセージを表示します。
ユーザーがコードの代わりに「?」と入力した場合は、上述のファンクションを呼び出しています。画面には顧客リストが現れるので、ユーザーはこの中からいずれかの顧客を選択できます。
実際にユーザーがある氏名を選択すると、対応するコード(DEMNAC)の値が返されます。これをFILECHECKコマンドで確認しています。
一方、ユーザーがどの氏名も選択せず、ファンクション・キー24を押して検索終了を指示した場合は、DEMNACの値として「?」が返されます。この場合、FILECHECKコマンドではレコードが見つからないので、エラー処理が起動されることになります。
[ |../../index.htm#lansa/l4wdev05_0180.htm]