Windows がこれほど普及している現在で RPG プログラムでも
マウスで操作させたいと思うのは当然である。
かのスティーブ・ジョブズは XEROX 社のマウスを初めて見たときに
「なぜマウスを商品化しないのか?!」と驚いたそうである。
Windows ではマウスを操作しない日はないが私達の 5250 エミュレータの
世界ではエンド・ユーザーにマウス操作を提供している機会は
少ないのではないだろうか?
例えば、項目を選択するのに 「1=選択」 のように入力させたり
機能キーを押させる操作よりはマウスでクリックするほうが
はるかにやさしく洗練されている操作であると言える。
5250 エミュレータで GUI コントロールを表現するには
仮想端末 API に 5250 表示装置が GUI コントロールをサポートしている端末であると
宣言しなければならない。
PCOMM や CA400 (=iAccess,= Client Access) では GUI コントロール・サポートの
フラグはオンではないので GUI コントロールを表現することができない。
AutoWeb ではGUI コントロール・サポートのフラグがオンであるので
様々な GUI コントロールを表現することができるのである。
ところがマウスに関しては DSPF の DDS キー・ワードだけで
マウスが使えるようになるのでここで紹介する。
IBM はマウス操作でロール・アップ / ダウンの操作を紹介しているが
マウスのクリックによるスクロール操作は Windows やブラウザでも例がないので
マウスを使うサンプルとしては説得力に欠けるのである。
ここではマウス・クリックによる POPUP 表示の例を紹介する。
あなたの適用業務をよりスタイリッシュなものにすることは間違いない。
【 PGM201:受注の入力 】
マウスでクリックすると POPUP 表示される。
【 POPUP表示 】
【 マウス操作の定義 】
..マウスの左ボタンを押すと CF04 キーを押したのと同じにする。
: A MOUBTN(*ULP CF04) :
これはレコード・レベルでマウスをクリックすると CF04 キーを押したことになり
なおかつマウス・カーソル (=正しくは) の位置もプログラムに伝える。
【 DSPF: PGM201FM :受注の入力画面 】
0001.00 A*%%TS SD 20070731 210529 QTR REL-V5R4M0 5722-WDS
0002.00 A*-----------------------------------------------*
0003.00 A* SFLENT : サブ・ファイル入力
0004.00 A*
0005.00 A* 受注の入力
0006.00 A*
0007.00 A* CRTEXDSPF QTROBJ/PGM201FM +
0008.00 A* SRCFILE(QTRSRC/QDSPSRC) LVLCHK(*NO) AUT(*ALL)
0009.00 A*-----------------------------------------------*
0010.00 A DSPSIZ(27 132 *DS4 24 80 *DS3)
0011.00 A *DS4 MSGLOC(27)
0012.00 A *DS3 MSGLOC(24)
0013.00 A PRINT
0014.00 A HELP
0015.00 A ALTHELP(CA01)
0016.00 A HLPPNLGRP(PGM201H QTROBJ/PGM201H)
0017.00 A HLPTITLE(' 受注の入力 ')
0018.00 A R DSPHEAD
0019.00 A TEXT(' 初期画面 ')
0020.00 A CF03(03 ' 終了 ')
0021.00 A SETOF(99)
0022.00 A BLINK
0023.00 A H HLPARA(2 12 2 17)
0024.00 A HLPPNLGRP('PGM201/JUCNO' -
0025.00 A QTROBJ/PGM201H)
0026.00 A 1 27' 受注の入力 '
0027.00 A DSPATR(HI)
0028.00 A* COLOR(PNK)
0029.00 A 2 2' 受注№ '
0030.00 A JUCNO 5Y 0B 2 12TEXT(' 受注№ ')
0031.00 A CHECK(RZ)
0032.00 A CHECK(ER)
0033.00 A 11 15' 必要な項目を打鍵して実行キーを押 +
0034.00 A して下さい。 '
0035.00 A* DSPATR(HI)
0036.00 A 11 63HTML('<IMG SRC="/AS400-NET.USR/IMAG+
0037.00 A E/AUTOWEB.GIF">')
0038.00 A 23 2'F3= 終了 '
0039.00 A COLOR(BLU)
0040.00 A 24 2' これはメッセージ・テストです '
0041.00 A R SFREC01 SFL
0042.00 A TEXT(' ＳＦＬレコード ')
0043.00 A 20
0044.00 AO 99 SFLNXTCHG
0045.00 A GYO 4A B 9 2TEXT(' № ')
0046.00 A 03 DSPATR(UL)
0047.00 A JHCODE R B 9 7REFFLD(SHOHINR/SHCODE QTRFIL/SHOHIN)
0048.00 A TEXT('*POPUP SHCODE,SHNAME,SHTANK')
0049.00 A 66 DSPATR(PC)
0050.00 A 66 DSPATR(RI)
0051.00 A SHNAME R O 9 18REFFLD(SHOHINR/SHNAME QTRFIL/SHOHIN)
0052.00 A TEXT(' 商品名 ')
0053.00 A JUSUR 3Y 0B 9 48TEXT(' 受注数 ')
0054.00 A EDTCDE(Z)
0055.00 A CHECK(RB)
0056.00 A DSPATR(CS)
0057.00 A 71 DSPATR(PC)
0058.00 A JUTANK R 7Y 0B 9 55REFFLD(SHOHINR/SHTANK QTRFIL/SHOHIN)
0059.00 A TEXT(' 単価 ')
0060.00 A EDTCDE(K)
0061.00 A CHECK(RB)
0062.00 A DSPATR(CS)
0063.00 A JUKING 7Y 0B 9 67TEXT(' 受注金額 ')
0064.00 A EDTCDE(K)
0065.00 A CHECK(RB)
0066.00 A DSPATR(CS)
0067.00 A ZKSU 5Y 0O 9 82TEXT(' 在庫数 ')
0068.00 A EDTCDE(K)
0069.00 A THSU 5Y 0O 9 92TEXT(' 手配数 ')
0070.00 A EDTCDE(K)
0071.00 A*
0072.00 A R SFCTL01 SFLCTL(SFREC01)
0073.00 A*%%TS SD 20070731 174853 QTR REL-V5R4M0 5722-WDS
0074.00 A SFLSIZ(0013)
0075.00 A *DS3 SFLSIZ(0011)
0076.00 A SFLPAG(0012)
0077.00 A *DS3 SFLPAG(0010)
0078.00 A TEXT(' ＳＦＬコントロール ')
0079.00 A ROLLUP(14 ' 次頁 ')
0080.00 A ROLLDOWN(15 ' 前頁 ')
0081.00 A CF03(03 ' 終了 ')
0082.00 A CF04(04 'ﾌﾟﾛﾝﾌﾟﾄ')
0083.00 A CF05(05 ' 照会 ')
0084.00 A CF10(10 ' 更新 ')
0085.00 A CF23(23 ' 削除 ')
0086.00 A CF12(12 ' 前画面 ')
0087.00 A SETOF(99)
0088.00 A BLINK
0089.00 A OVERLAY
0090.00 A 42 SFLDSP
0091.00 A 41 SFLDSPCTL
0092.00 A 43 SFLINZ
0093.00 A 46 SFLDLT
0094.00 A 44 SFLCLR
0095.00 A 45 SFLEND(*MORE)
0096.00 A* 45 SFLEND(*SCRBAR)
0097.00 A* SFLDROP(CF11)
0098.00 A MOUBTN(*ULP CF04)
0099.00 A 61 SFLMSGID(EDT0411 QPDA/QEDTMSG 61)
0100.00 A 62 SFLMSGID(EDT0410 QPDA/QEDTMSG 62)
0101.00 A 66 SFLMSGID(CPF9897 QSYS/QCPFMSG +
0102.00 A 66 &MSGDTA)
0103.00 A 67 SFLMSGID(CPD6A6D QSYS/QCPFMSG 67)
0104.00 A RTNCSRLOC(&RCD &FLD &CSRP)
0105.00 A H HLPARA(2 12 2 17)
0106.00 A HLPPNLGRP('PGM201/JUCNO' -
0107.00 A QTROBJ/PGM201H)
0108.00 A H HLPARA(4 17 4 20)
0109.00 A HLPPNLGRP('PGM201/JUTKCD' -
0110.00 A QTROBJ/PGM201H)
0111.00 A H HLPARA(3 71 3 78)
0112.00 A HLPPNLGRP('PGM201/JUDATE' -
0113.00 A QTROBJ/PGM201H)
0114.00 A H HLPARA(4 71 4 78)
0115.00 A HLPPNLGRP('PGM201/JUNOKI' -
0116.00 A QTROBJ/PGM201H)
0117.00 A H HLPARA(6 13 6 14)
0118.00 A HLPPNLGRP('PGM201/JUKBN' -
0119.00 A QTROBJ/PGM201H)
0120.00 A H HLPARA(6 45 6 46)
0121.00 A HLPPNLGRP('PGM201/JUSHOR' -
0122.00 A QTROBJ/PGM201H)
0123.00 A H HLPARA(6 68 6 71)
0124.00 A HLPPNLGRP('PGM201/JUTANT' -
0125.00 A QTROBJ/PGM201H)
0126.00 A H HLPARA(9 7 18 16)
0127.00 A HLPPNLGRP('PGM201/JHCODE' -
0128.00 A QTROBJ/PGM201H)
0129.00 A H HLPARA(9 48 18 50)
0130.00 A HLPPNLGRP('PGM201/JUSUR' -
0131.00 A QTROBJ/PGM201H)
0132.00 A H HLPARA(9 55 18 61)
0133.00 A HLPPNLGRP('PGM201/JUTANK' -
0134.00 A QTROBJ/PGM201H)
0135.00 A H HLPARA(9 67 18 73)
0136.00 A HLPPNLGRP('PGM201/JUKING' -
0137.00 A QTROBJ/PGM201H)
0138.00 A DSPREC 4S 0H SFLRCDNBR(CURSOR)
0139.00 A RCD 10A H
0140.00 A FLD 10A H
0141.00 A CSRP 4S 0H TEXT('SFL 表示 ﾚｺｰﾄﾞ № ')
0142.00 A MSGDTA 60A P
0143.00 A 1 27' 受注の入力 '
0144.00 A DSPATR(HI)
0145.00 A* COLOR(PNK)
0146.00 A DSPMOD 6A O 1 72DSPATR(HI)
0147.00 A 2 2' 受注№ '
0148.00 A JUCNO 5Y 0O 2 12TEXT(' 受注№ ')
0149.00 A 3 80' 受注日 '
0150.00 A *DS3 3 62
0151.00 A JUDATE 8Y 0B 3 89TEXT(' 受注日 ')
0152.00 A *DS3 3 71
0153.00 A 64 ERRMSG(' 受注日の誤りです。 -
0154.00 A ' 64)
0155.00 A* 編集コード :W を日付のフィールドとみなしてカレンダーを追加します。
0156.00 A EDTCDE(W)
0157.00 A 4 2' 得意先コード '
0158.00 A JUTKCD R 4A B 4 17TEXT('*POPUP TKCODE, TKNMJ, TKNM, -
0159.00 TKKBN')
0160.00 A REFFLD(TOKMASR/TKCODE QTRFIL/TOKMAS)
0161.00 A 63 ERRMSG(' 得意先コードの誤りです。 -
0162.00 A ' 63)
0163.00 A TKNAME R O 4 22REFFLD(TOKMASR/TKNMJ QTRFIL/TOKMAS)
0164.00 A 4 80' 納期 '
0165.00 A *DS3 4 62
0166.00 A JUNOKI 8Y 0B 4 89TEXT(' 納期 ')
0167.00 A *DS3 4 71
0168.00 A 65 ERRMSG(' 納期の誤りです。 -
0169.00 A ' 65)
0170.00 A* 編集コード :W を日付のフィールドとみなしてカレンダーを追加します。
0171.00 A EDTCDE(W)
0172.00 A 6 2' 受注区分 '
0173.00 A JUKBN 2 B 6 13
0174.00 A VALUES('01' '02')
0175.00 A TEXT('" 売上 " " 返品 "')
0176.00 A JUNAME 6A O 6 16
0177.00 A 08 DSPATR(ND)
0178.00 A 6 34' 処理区分 '
0179.00 A JUSHOR 2 B 6 45
0180.00 A VALUES('01' '02')
0181.00 A TEXT('" 今月 " " 来勘 "')
0182.00 A JSNAME 6A O 6 48
0183.00 A 08 DSPATR(ND)
0184.00 A 6 57' 担当者 '
0185.00 A JUTANT R 4A B 6 66REFFLD(TANTOMR/TACODE QTRFIL/TANTO)
0186.00 A TEXT('*COMBO *KEY')
0187.00 A TTNAM R 8A O 6 71REFFLD(TANTOMR/TTNAM QTRFIL/TANTO)
0188.00 A TEXT('*COMBO *DATA')
0189.00 A 8 2' № '
0190.00 A DSPATR(HI)
0191.00 A 8 7' 商品コード '
0192.00 A DSPATR(HI)
0193.00 A 8 21' 商品名 '
0194.00 A DSPATR(HI)
0195.00 A 8 45' 受注数 '
0196.00 A DSPATR(HI)
0197.00 A 8 57' 単価 '
0198.00 A DSPATR(HI)
0199.00 A 8 67' 受注金額 '
0200.00 A DSPATR(HI)
0201.00 A 8 81' 現在庫数 '
0202.00 A DSPATR(HI)
0203.00 A 8 92' 手配数 '
0204.00 A DSPATR(HI)
0205.00 A*
0206.00 A R DSPEND01
0207.00 A*%%TS SD 20070731 210529 QTR REL-V5R4M0 5722-WDS
0208.00 A TEXT(' 機能キーの表示 ')
0209.00 A OVERLAY
0210.00 A* PUTRETAIN
0211.00 A 23 2'F3= 終了 '
0212.00 A COLOR(BLU)
0213.00 A 23 17'F4= プロンプト '
0214.00 A COLOR(BLU)
0215.00 A 23 34'F10= 更新 '
0216.00 A COLOR(BLU)
0217.00 A 23 51'F23= 削除 '
0218.00 A COLOR(BLU)
0219.00 A 23 68'F12= 前画面 '
0220.00 A COLOR(BLU)
0221.00 A R ENDOPT
0222.00 A*%%TS SD 19930612 150356 NIK REL-V2R1M0 5738-PW1
0223.00 A TEXT(' 終了画面 ')
0224.00 A* CF03(03 ' 終了 ')
0225.00 A CSRLOC(LIN POS)
0226.00 A 1 34' 終了 '
0227.00 A COLOR(PNK)
0228.00 A DSPATR(HI)
0229.00 A 3 2' 処理されたレコード数 '
0230.00 A 5 10' 追加 . . . . . :'
0231.00 A ADDREC 5Y 0O 5 35EDTCDE(4)
0232.00 A 6 10' 変更 . . . . . :'
0233.00 A CHGREC 5Y 0O 6 35EDTCDE(4)
0234.00 A 7 10' 削除 . . . . . :'
0235.00 A DLTREC 5Y 0O 7 35EDTCDE(4)
0236.00 A 11 2' 選択項目を打鍵して，実行キーを押 +
0237.00 A してください。 '
0238.00 A COLOR(BLU)
0239.00 A 13 5' データ入力の終了 . . . . . .'
0240.00 A ANS 1A B 13 39VALUES('Y' 'N')
0241.00 A 13 53'Y=YES, N=NO'
0242.00 A 23 2'F3= 終了 '
0243.00 A COLOR(BLU)
0244.00 A 23 15'F12= 前画面 '
0245.00 A COLOR(BLU)
0246.00 A LIN 3S 0H
0247.00 A POS 3S 0H
【 解説 】
注目はレコード : SFCTL01 に記述されている、
0098.00 A MOUBTN(*ULP CF04)
だけである。
【 RPG: PGM201:受注の入力 】
0001.00 H DFTNAME(PGM201) DATEDIT(*YMD/)
0002.00 F********** 受注の入力 ******************************************
0003.00 FPGM201FM CF E WORKSTN
0004.00 F SFILE(SFREC01:RRN1)
0005.00 F INFDS(INFDS)
0006.00 FJUCHU UF A E K DISK
0007.00 FTOKMAS IF E K DISK
0008.00 FSHOHIN IF E K DISK
0009.00 FSHZAIKO IF E K DISK
0010.00 FTANTO IF E K DISK
0011.00 F*****************************************************************
0012.00
0013.00 * CRTBNDRPG QTROBJ/PGM201 SRCFILE(QTRSRC/QRPGLESRC)
0014.00 * DFTACTGRP(*NO) ACTGRP(*NEW) AUT(*ALL)
0015.00
0016.00 D AR S 1 DIM(80)
0017.00 D SAVDTA S 1 DIM(1024) SAVE-ﾃﾞｰﾀ
0018.00 D*
0019.00 D* -( ｻﾌﾞ･ﾌｧｲﾙ の ﾌｧｲﾙ 情報 )-
0020.00 D*
0021.00 D* SAVE-RESTORE のための ﾌｧｲﾙ の DATA-STRUCTURE
0022.00 D* 読み取り ﾌｧｲﾙ の FORMAT を外部 DS として READ
0023.00 D SAVEDS E DS EXTNAME(JUCHU)
0024.00 D DSPDTA 1 1024
0025.00 D DIM(1024) 入力 ﾃﾞｰﾀ
0026.00 D INFDS DS
0027.00 D NUM_ROWS 152 153B 0
0028.00 D NUM_COLS 154 155B 0
0029.00 D NUM_RCDS 156 159I 0
0030.00 D*( ｶｰｿﾙ の行と桁の取り込み )
0031.00 D LINE 370 371B 0
0032.00 D* TOPRRN: 今表示している ｻﾌﾞ･ﾌｧｲﾙ の先頭の RRN
0033.00 D TOPRRN 378 379B 0
0034.00 D* BRRN : ｻﾌﾞﾌｧｲﾙ の ﾚｺｰﾄﾞNO ( 2 進数 )
0035.00 D BRRN 376 377B 0
0036.00 D*( WORK 日付 YYMMDD ﾃﾞｰﾀ 構造 )
0037.00 D DATEDS DS
0038.00 D SRY 1 2 0
0039.00 D SRYMD 1 8 0
0040.00 D YYMMDD 3 8 0
0041.00 D YYMM 3 6 0
0042.00 D MMDD 5 8 0
0043.00 D YY 3 4 0
0044.00 D MM 5 6 0
0045.00 D DD 7 8 0
0046.00 D*( 在庫数の配列 )
0047.00 D DS
0048.00 D DDS001 E DS EXTNAME(TOKMAS)
0049.00 D DDS002 E DS EXTNAME(SHOHIN)
0050.00 D PNLOBJ DS
0051.00 D GRP 1 10
0052.00 D GRPLIB 11 20
0053.00 D* ＬＩＢ名付きＰＧＭ名 *
0054.00 D JHCOD C CONST('JHCODE ')
0055.00 D ANS005 C CONST('QTROBJ/POP005')
0056.00 D WEBFAC C CONST('ASNET.COM/WEBFACE')
0057.00 D PGM101 C CONST('QTROBJ/PGM101')
0058.00 D MSG01 C CONST(' 商品コード ')
0059.00 D MSG02 C CONST(' の誤りです。 ')
0060.00
0061.00 C*
0062.00 C*( 初期画面 )
0063.00 C*----------------------------------------------------+
0064.00 C START TAG |
0065.00 C EXFMT DSPHEAD |
0066.00 C*----------------------------------------------------+
0067.00 C SETOFF 99
0068.00 C*( CF03 )- 終了
0069.00 C *IN03 IFEQ *ON CF03
0070.00 C SETON LR
0071.00 C LR EXSR LRRTN
0072.00 C LR RETURN
0073.00 C GOTO START
0074.00 C END CF03
0075.00 C*( CF05 )- 得意先マスターの登録
0076.00 C *IN05 IFEQ *ON CF05
0077.00 C CALL PGM101
0078.00 C GOTO START
0079.00 C END CF03
0080.00 C*( 実行キー )
0081.00 C* : ＫＥＹをファイルにセット
0082.00 C*----------------------------------------------------+
0083.00 C SETKEY KLIST |
0084.00 C KFLD JUCNO |
0085.00 C KFLD JUGYO |
0086.00 C*----------------------------------------------------+
0087.00 C MOVE *ZEROS JUGYO
0088.00 C EXSR SFLCLR
0089.00 C SETKEY SETLL JUCHU
0090.00 C* : ファイルの読み取り
0091.00 C MOVE ' 入力 ' DSPMOD 6
0092.00 C Z-ADD 1 TOPRRN
0093.00 C EXSR READ
0094.00 C Z-ADD 1 DSPREC
0095.00 C*( サブ・ファイルの表示 )
0096.00 C*----------------------------------------------------+
0097.00 C DSPLY TAG |
0098.00 C WRITE DSPEND01 |
0099.00 C SETON 4142 |SFL-DSPLY
0100.00 C EXFMT SFCTL01 |
0101.00 C SETOFF 4142 |
0102.00 C*----------------------------------------------------+
0103.00 C SETOFF 99
0104.00 C*( CF03 )- 終了
0105.00 C *IN03 IFEQ *ON CF03
0106.00 C SETON LR
0107.00 C LR EXSR LRRTN
0108.00 C LR RETURN
0109.00 C GOTO DSPLY
0110.00 C END CF03
0111.00 C*( CF04 )- プロンプト
0112.00 C *IN04 IFEQ *ON CF04
0113.00 C FLD IFEQ JHCOD
0114.00 C CSRP ANDGT *ZEROS
0115.00 C EXSR PROMPT
0116.00 C 99 GOTO DSPLY
0117.00 C ELSE
0118.00 C SETON 6799 ERR
0119.00 C GOTO DSPLY
0120.00 C END
0121.00 C END CF04
0122.00 C*
0123.00 C*( CF12 )- 前画面
0124.00 C *IN12 IFEQ *ON CF12
0125.00 C SETOFF 12
0126.00 C EXSR SFLDLT
0127.00 C EXSR CLEAR
0128.00 C GOTO START
0129.00 C END CF12
0130.00 C* |
0131.00 C*( ROLL UP )- 次ページ
0132.00 C *IN14 IFEQ *ON ROLLUP
0133.00 C EXSR ROLLUP
0134.00 C GOTO DSPLY
0135.00 C END ROLLUP
0136.00 C*-( ROLL DOWN )- 前ページ
0137.00 C *IN15 IFEQ *ON ROLLDOWN
0138.00 C Z-ADD 1 DSPREC
0139.00 C SETON 6299 ERRMSG
0140.00 C GOTO DSPLY
0141.00 C END ROLLDOWN
0142.00 C* |
0143.00 C TOPRRN IFNE *ZEROS
0144.00 C Z-ADD TOPRRN DSPREC
0145.00 C END
0146.00 C* : 見出し画面のチェック
0147.00 C N23 EXSR MIDCHK
0148.00 C 99 GOTO DSPLY
0149.00 C* : 見出し項目のＳＡＶＥ
0150.00 C MOVE JUCNO MIB001
0151.00 C *LIKE DEFINE JUCNO MIB001
0152.00 C MOVE JUTKCD MIB002
0153.00 C *LIKE DEFINE JUTKCD MIB002
0154.00 C MOVE JUDATE MIB003
0155.00 C *LIKE DEFINE JUDATE MIB003
0156.00 C MOVE JUNOKI MIB004
0157.00 C *LIKE DEFINE JUNOKI MIB004
0158.00 C MOVE TKNAME MIB005
0159.00 C *LIKE DEFINE TKNAME MIB005
0160.00 C MOVE JUSHOR MIB006
0161.00 C *LIKE DEFINE JUSHOR MIB006
0162.00 C MOVE JSNAME MIB007
0163.00 C *LIKE DEFINE JSNAME MIB007
0164.00 C* : 明細画面のチェック
0165.00 C 1 DO *HIVAL RRN1 RRN1=1-*HIVAL
0166.00 C SETOFF 50
0167.00 C*( 実行キー )
0168.00 C N10
0169.00 CANN23 READC SFREC01 50
0170.00 C*
0171.00 C*( CF10 )- 更新
0172.00 C*( CF23 )- 削除
0173.00 C 10
0174.00 COR 23RRN1 CHAIN SFREC01 50
0175.00 C*
0176.00 C 50 GOTO RECEND
0177.00 C* : ﾌﾞﾗﾝｸ ｷｰ 入力の ｵﾐｯﾄ
0178.00 C JHCODE IFEQ *BLANKS
0179.00 C JUKING ANDEQ *ZEROS
0180.00 C GOTO UPDBPS
0181.00 C END
0182.00 C Z-ADD BRRN DSPREC
0183.00 C MOVE MIB001 JUCNO
0184.00 C MOVE MIB002 JUTKCD
0185.00 C MOVE MIB003 JUDATE
0186.00 C MOVE MIB004 JUNOKI
0187.00 C MOVE MIB005 TKNAME
0188.00 C MOVE MIB006 JUSHOR
0189.00 C MOVE MIB006 JSNAME
0190.00 C N23 EXSR MIDCHK
0191.00 C* |
0192.00 C*---------------------+
0193.00 C* 入力明細行のチェック
0194.00 C*---------------------+
0195.00 C MOVEL GYO FLD1 1
0196.00 C FLD1 IFNE 'D' 削除 ?
0197.00 C *IN23 ANDNE '1'
0198.00 C MOVE RRN1 DSPREC 4 0 表示 RRN
0199.00 C EXSR CHECK
0200.00 C 99 GOTO SFLWRT
0201.00 C END
0202.00 C* |
0203.00 C*---------------------+
0204.00 C* データ・ベース更新
0205.00 C*---------------------+
0206.00 C* |
0207.00 C *IN10 IFEQ *ON F10,F23
0208.00 C *IN23 OREQ *ON
0209.00 C*----------------------------------------------------+
0210.00 C TRNKEY KLIST |
0211.00 C KFLD JUCNO |
0212.00 C KFLD JUGYO |
0213.00 C*----------------------------------------------------+
0214.00 C* : 更新キーを生成
0215.00 C*
0216.00 C MOVE DSPDTA SAVDTA
0217.00 C* : データ・ベース検索
0218.00 C EXSR CLEAR
0219.00 C SETOFF 90
0220.00 C TRNKEY CHAIN JUCHU 90
0221.00 C 90 GOTO ADDCHG
0222.00 C* |
0223.00 C* : 変更 / 削除
0224.00 C MOVEL GYO FLD1 1
0225.00 C FLD1 CABEQ 'D' TRNUPD 削除 ?
0226.00 C 23 GOTO TRNUPD
0227.00 C* |
0228.00 C* : 追加 / 変更
0229.00 C ADDCHG TAG
0230.00 C MOVE SAVDTA DSPDTA
0231.00 C MOVE MIB001 JUCNO
0232.00 C MOVE MIB002 JUTKCD
0233.00 C MOVE MIB003 JUDATE
0234.00 C MOVE MIB004 JUNOKI
0235.00 C MOVE MIB005 TKNAME
0236.00 C MOVE MIB006 JUSHOR
0237.00 C MOVE MIB006 JSNAME
0238.00 C* |
0239.00 C TRNUPD TAG
0240.00 C MOVEL GYO FLD1 1
0241.00 C FLD1 COMP 'D' 50
0242.00 C 23 SETON 50
0243.00 C* : データ・ベースへ追加・更新
0244.00 C*----------------------------------------------------+
0245.00 C 90
0246.00 CANN50 WRITE JUCHUR | ADD
0247.00 C N90
0248.00 CANN50 UPDATE JUCHUR | CHG
0249.00 C N90
0250.00 CAN 50 DELETE JUCHUR | DLT
0251.00 C*----------------------------------------------------+
0252.00 C N50 MOVE BRRN GYO
0253.00 C 90 ADD 1 ADDREC 5 0
0254.00 C N90
0255.00 CANN50 ADD 1 CHGREC 5 0
0256.00 C N90
0257.00 CAN 50 ADD 1 DLTREC 5 0
0258.00 C END F10,F23
0259.00 C* |
0260.00 C*---------------------+
0261.00 C* サブ・ファイル更新
0262.00 C*---------------------+
0263.00 C SFLWRT TAG
0264.00 C MOVE TOPRRN TOPSAV
0265.00 C*----------------------------------------------------+
0266.00 C UPDATE SFREC01 |
0267.00 C*----------------------------------------------------+
0268.00 C Z-ADD BRRN DSPREC
0269.00 C MOVE TOPSAV TOPRRN
0270.00 C UPDBPS TAG
0271.00 C 99 GOTO DSPLY エラー
0272.00 C END RRN1=1-*HIVAL
0273.00 C* : 実行キーの終了
0274.00 C RECEND TAG
0275.00 C* : コマンド部のチェック ( DSPEND01
0276.00 C N23 EXSR CMDCHK
0277.00 C 99 GOTO DSPLY
0278.00 C*
0279.00 C *IN10 IFEQ *ON
0280.00 C *IN23 OREQ *ON
0281.00 C GOTO START
0282.00 C END
0283.00 C GOTO DSPLY
0284.00 C*
0285.00 C END TAG
0286.00 C******************************************************
0287.00 C *INZSR BEGSR
0288.00 C******************************************************
0289.00 C* 初期 ｻｲｸﾙ のみの実行
0290.00 C *LIKE DEFINE TOPRRN TOPSAV
0291.00 C CLEAR SAVEDS
0292.00 C MOVE *ZEROS JUDATE
0293.00 C MOVE *ZEROS JUNOKI
0294.00 C CLEAR DATEDS
0295.00 C MOVE 910101 DATE 6 0
0296.00 C*( U8 = HTML インターフェースで実行中 )
0297.00 C U8 SETON 08
0298.00 C N08NUM_COLS COMP 132 08
0299.00 C*( ｻﾌﾞﾌｧｲﾙ END-FLAG を ON にする )
0300.00 C SETON 45
0301.00 C SETON 2310
0302.00 C SETOFF 2310
0303.00 C N08 MOVE 10 GYOSU 2 0 行数
0304.00 C 08 MOVE 12 GYOSU 行数
0305.00 C*( DS の数字 ﾌｨｰﾙﾄﾞ の ｸﾘﾔｰ )
0306.00 C CLEAR SFREC01
0307.00 C MOVE 09 STRGYO 2 0 開始行№
0308.00 C Z-ADD UDATE JUDATE 初期値
0309.00 C Z-ADD 1 JUCNO
0310.00 C Z-ADD 0 CSRP
0311.00 C INZEND ENDSR
0312.00 C******************************************************
0313.00 C MIDCHK BEGSR
0314.00 C******************************************************
0315.00 C*( 見出しチェック )
0316.00 C*----------------------------------------------------*
0317.00 C*( JUTKCD : 得意先コード :( CHAIN ファイル )
0318.00 C*----------------------------------------------------*
0319.00 C MOVE *BLANKS TKNMJ
0320.00 C SETOFF 99
0321.00 C JUTKCD CHAIN TOKMAS 99
0322.00 C 99 SETON 63 99 ERRMSG
0323.00 C 99 GOTO MIDEND
0324.00 C MOVEL TKNMJ TKNAME
0325.00 C*
0326.00 C*----------------------------------------------------*
0327.00 C*( JUDATE : 受注日 :( DATCHK 日付 )
0328.00 C*----------------------------------------------------*
0329.00 C JUDATE IFEQ *ZEROS 省略値
0330.00 C MOVEL UDATE JUDATE
0331.00 C END 省略値
0332.00 C*
0333.00 C JUDATE IFNE *ZEROS IF-
0334.00 C MOVE JUDATE DATE 6 0
0335.00 C EXSR DATCHK
0336.00 C END ENDRTN
0337.00 C 99 SETON 64 ERRMSG
0338.00 C 99 GOTO MIDEND GOTO XXX
0339.00 C JUNOKI IFNE *ZEROS JUNOKI=
0340.00 C*----------------------------------------------------*
0341.00 C*( JUNOKI : 納期 :( DATCHK 日付 )
0342.00 C*----------------------------------------------------*
0343.00 C JUNOKI IFNE *ZEROS IF-
0344.00 C MOVE JUNOKI DATE 6 0
0345.00 C EXSR DATCHK
0346.00 C END ENDRTN
0347.00 C 99 SETON 65 ERRMSG
0348.00 C 99 GOTO MIDEND GOTO XXX
0349.00 C END
0350.00 C*----------------------------------------------------*
0351.00 C*( JUKBN : 受注区分
0352.00 C*----------------------------------------------------*
0353.00 C MOVE *BLANKS JUNAME
0354.00 C JUKBN IFNE *BLANKS
0355.00 C JUKBN IFEQ '01'
0356.00 C MOVE ' 売上 ' JUNAME
0357.00 C END
0358.00 C JUKBN IFEQ '02'
0359.00 C MOVE ' 返品 ' JUNAME
0360.00 C END
0361.00 C END
0362.00 C*----------------------------------------------------*
0363.00 C*( JUSHOR : 処理区分
0364.00 C*----------------------------------------------------*
0365.00 C MOVE *BLANKS JSNAME
0366.00 C JUSHOR IFNE *BLANKS
0367.00 C JUSHOR IFEQ '01'
0368.00 C MOVE ' 通常 ' JSNAME
0369.00 C END
0370.00 C JUSHOR IFEQ '02'
0371.00 C MOVE ' 来勘 ' JSNAME
0372.00 C END
0373.00 C END
0374.00 C*----------------------------------------------------*
0375.00 C*( JUTANT : 担当者コード :( CHAIN ファイル )
0376.00 C*----------------------------------------------------*
0377.00 C MOVE *BLANKS TTNAM
0378.00 C SETOFF 99
0379.00 C JUTANT CHAIN TANTO 99
0380.00 C 99 SETON 63 99 ERRMSG
0381.00 C 99 GOTO MIDEND
0382.00 C MIDEND ENDSR
0383.00 C******************************************************
0384.00 C READ BEGSR
0385.00 C******************************************************
0386.00 C*( データ・ベースの検索 )
0387.00 C*----------------------------------------------------+
0388.00 C EQLKEY KLIST |
0389.00 C KFLD JUCNO |
0390.00 C*----------------------------------------------------+
0391.00 C SETON 51
0392.00 C SETOFF 71
0393.00 C RTNRED TAG
0394.00 C*
0395.00 C TOPRRN ADD GYOSU ENDRRN 4 0
0396.00 C SUB 1 ENDRRN
0397.00 C*
0398.00 C Z-ADD TOPRRN DSPREC
0399.00 C TOPRRN DO ENDRRN RRN1 4 0 READ
0400.00 C SETOFF 50
0401.00 C EQLKEY READE JUCHU 50
0402.00 C *IN50 IFEQ *ON EOF
0403.00 C SETOFF 1129
0404.00 C CLEAR SFREC01
0405.00 C U8 SETON 08
0406.00 C N08NUM_COLS COMP 132 08
0407.00 C Z-ADD 0 SZZSU
0408.00 C ELSE EOF
0409.00 C MOVE ' 変更 ' DSPMOD
0410.00 C U8 SETON 08
0411.00 C N08NUM_COLS COMP 132 08
0412.00 C*( CHECK : READ した ﾚｺｰﾄﾞ の ﾁｪｯｸ )
0413.00 C 51 EXSR MIDCHK
0414.00 C EXSR CHECK
0415.00 C END EOF
0416.00 C*( 行 NO に入れる )
0417.00 C MOVE RRN1 GYO
0418.00 C MOVE TOPRRN TOPSAV
0419.00 C*( ｻﾌﾞﾌｧｲﾙ へ更新 )
0420.00 C*----------------------------------------------------+
0421.00 C WRITE SFREC01 |
0422.00 C*----------------------------------------------------+
0423.00 C 51 MOVE RRN1 DSPREC
0424.00 C 51 SETOFF 51
0425.00 C Z-ADD RRN1 LSTRRN 4 0
0426.00 C MOVE TOPSAV TOPRRN
0427.00 C END READ
0428.00 C REDEND TAG
0429.00 C *IN11 IFEQ *ON
0430.00 C ENDRRN ADD 1 TOPRRN
0431.00 C GOTO RTNRED
0432.00 C END
0433.00 C ENDSR
0434.00 C******************************************************
0435.00 C CHECK BEGSR
0436.00 C******************************************************
0437.00 C*( 明細チェック )
0438.00 C MOVE GYO JUGYO
0439.00 C*----------------------------------------------------*
0440.00 C*( JHCODE : 商品 ｺｰﾄﾞ :( CHAIN ファイル )
0441.00 C*----------------------------------------------------*
0442.00 C CLEAR DDS002 外部 DS
0443.00 C SETOFF 99
0444.00 C JHCODE CHAIN SHOHIN 99
0445.00 C *IN99 IFEQ *ON
0446.00 C SETON 66 99 ERRMSG
0447.00 C MSG01 CAT(P) JHCODE:0 MSGDTA
0448.00 C CAT MSG02:0 MSGDTA
0449.00 C GOTO CHKEND
0450.00 C ENDIF
0451.00 C*
0452.00 C JUTANK IFEQ *ZEROS JUTANK=
0453.00 C Z-ADD SHTANK JUTANK
0454.00 C END
0455.00 C JUSUR MULT JUTANK JUKING
0456.00 C*----------------------------------------------------*
0457.00 C* SHZAIKO : 在庫マスターより在庫数を取得
0458.00 C* 在庫数は HTML にのみ表示されます
0459.00 C*----------------------------------------------------*
0460.00 C Z-ADD 0 SZZSU
0461.00 C SETOFF 99
0462.00 C JHCODE CHAIN SHZAIKO 99
0463.00 C SETOFF 99
0464.00 C Z-ADD SZZSU ZKSU
0465.00 C CHKEND ENDSR
0466.00 C******************************************************
0467.00 C CMDCHK BEGSR
0468.00 C******************************************************
0469.00 C* : コマンド部のチェック ( DSPEND01
0470.00 C READ DSPEND01 50
0471.00 C 50 GOTO CMDEND
0472.00 C CMDEND ENDSR
0473.00 C******************************************************
0474.00 C SFLCLR BEGSR
0475.00 C******************************************************
0476.00 C*( ｻﾌﾞﾌｧｲﾙ の ｸﾘﾔｰ )
0477.00 C*----------------------------------------------------+
0478.00 C SETON 44 |
0479.00 C WRITE SFCTL01 |
0480.00 C SETOFF 44 |
0481.00 C*----------------------------------------------------+
0482.00 C ENDSR
0483.00 C******************************************************
0484.00 C SFLDLT BEGSR
0485.00 C******************************************************
0486.00 C*( ｻﾌﾞﾌｧｲﾙ の削除 )
0487.00 C*----------------------------------------------------+
0488.00 C SETON 46 |
0489.00 C WRITE SFCTL01 |
0490.00 C SETOFF 46 |
0491.00 C*----------------------------------------------------+
0492.00 C ENDSR
0493.00 C******************************************************
0494.00 C INZVAR BEGSR
0495.00 C******************************************************
0496.00 C*( 初期値 )
0497.00 C Z-ADD UDATE JUDATE 初期値
0498.00 C ENDSR
0499.00 C******************************************************
0500.00 C ROLLUP BEGSR
0501.00 C******************************************************
0502.00 C SETOFF 45
0503.00 C ENDRRN ADD 1 TOPRRN
0504.00 C EXSR READ
0505.00 C SETON 45
0506.00 C UPEND ENDSR
0507.00 C******************************************************
0508.00 C CLEAR BEGSR
0509.00 C******************************************************
0510.00 C *NOKEY CLEAR JUCHUR
0511.00 C EXSR INZVAR 初期値
0512.00 C ENDSR
0513.00 C*****************************************************
0514.00 C LRRTN BEGSR
0515.00 C*****************************************************
0516.00 C*( 終了画面 )
0517.00 C ADDREC IFGT *ZEROS
0518.00 C CHGREC ORGT *ZEROS
0519.00 C DLTREC ORGT *ZEROS
0520.00 C MOVE 'Y' ANS 1
0521.00 C*----------------------------------------------------+
0522.00 C EXFMT ENDOPT |
0523.00 C*----------------------------------------------------+
0524.00 C SETOFF 99
0525.00 C*( CF12 )- 前画面
0526.00 C *IN12 IFEQ *ON CF12
0527.00 C SETOFF 12LR
0528.00 C GOTO LREND
0529.00 C END CF12
0530.00 C*( 実行キー )
0531.00 C ANS IFEQ 'N'
0532.00 C SETOFF LR
0533.00 C GOTO LREND
0534.00 C END
0535.00 C END
0536.00 C*
0537.00 C LREND ENDSR
0538.00 C******************************************************
0539.00 C DATCHK BEGSR
0540.00 C******************************************************
0541.00 C*( 日付 ﾁｪｯｸ ｻﾌﾞ･ﾙｰﾁﾝ ) FOR YY/MM/DD
0542.00 C MOVE *IN51 IN51 1
0543.00 C MOVE *IN52 IN52 1
0544.00 C DATE MULT .0001 #YEAR 2 0 99
0545.00 C** SUB 88 #YEAR 平成
0546.00 C N99DATE MULT .01 #MONTH 2 0 99
0547.00 C N99 Z-ADD DATE #DAY 2 0 99
0548.00 C N99#MONTH COMP 12 99
0549.00 C N99#YEAR MULT .25 #CHKLY 1 1 50
0550.00 C N99#MONTH COMP 2 51
0551.00 C N99#MONTH MULT(H) 1.07 #MONTH
0552.00 C N99#MONTH DIV 2 #CHKLY 52
0553.00 C N99
0554.00 CANN51
0555.00 CAN 52#DAY COMP 30 99
0556.00 C N99
0557.00 CANN51
0558.00 CANN52#DAY COMP 31 99
0559.00 C N99
0560.00 CAN 51
0561.00 CANN50#DAY COMP 28 99
0562.00 C N99
0563.00 CAN 51
0564.00 CAN 50#DAY COMP 29 99
0565.00 C MOVE IN51 *IN51
0566.00 C MOVE IN52 *IN52
0567.00 C DATEND ENDSR
0568.00 C******************************************************
0569.00 C PROMPT BEGSR
0570.00 C******************************************************
0571.00 C EXSR CURSOR
0572.00 C EXSR LINCHK
0573.00 C 99 GOTO DSPLY
0574.00 C*( ポップ・アップ・ウインドウ・パネルの呼出し )
0575.00 C*----------------------------------------------------+
0576.00 C CALL ANS005 |ｳｨﾝﾄﾞｳ 表示
0577.00 C PARM SEL001 10 |
0578.00 C*----------------------------------------------------+
0579.00 C*( 選択結果を更新 )
0580.00 C MOVEL SEL001 JHCODE
0581.00 C SEL001 IFNE *BLANKS
0582.00 C MOVE *ZEROS JUTANK
0583.00 C MOVE *ZEROS JUSUR
0584.00 C MOVE *ZEROS JUKING
0585.00 C EXSR CHECK
0586.00 C SETON 71
0587.00 C*----------------------------------------------------+
0588.00 C UPDATE SFREC01 |
0589.00 C*----------------------------------------------------+
0590.00 C SETOFF 71
0591.00 C END
0592.00 C ENDSR
0593.00 C*****************************************************
0594.00 C CURSOR BEGSR
0595.00 C*****************************************************
0596.00 C LINE DIV 256 LIN 3 0 ｶﾞﾒﾝ の行数
0597.00 C MVR POS 3 0 ｶﾞﾒﾝ の桁数
0598.00 C ENDSR
0599.00 C******************************************************
0600.00 C LINCHK BEGSR
0601.00 C******************************************************
0602.00 C STRGYO ADD GYOSU ENDGYO 2 0
0603.00 C SUB 1 ENDGYO
0604.00 C* ｶｰｿﾙ は開始行と終了行とのあいだにあるか
0605.00 C LIN COMP STRGYO 50 50
0606.00 C 50LIN COMP ENDGYO 5050
0607.00 C* 94: ｶｰｿﾙ が適切な位置になかった
0608.00 C N50 SETON 9967
0609.00 C 99 GOTO LINEND
0610.00 C LIN SUB STRGYO RRN1
0611.00 C ADD TOPRRN RRN1
0612.00 C SETOFF 90
0613.00 C RRN1 CHAIN SFREC01 90
0614.00 C 90 GOTO LINEND
0615.00 C Z-ADD RRN1 DSPREC
0616.00 C*( 更新する ﾌｧｲﾙ に CHAIN )
0617.00 C SETOFF 90
0618.00 C TRNKEY CHAIN(N) JUCHU 90
0619.00 C*( DUMMY EXCPT )
0620.00 C*----------------------------------------------------+
0621.00 C* N90 UPDATJUCHUR | CHG
0622.00 C*----------------------------------------------------+
0623.00 C LINEND ENDSR
【 解説 】
CF04 キーを押したときには
0111.00 C*( CF04 )- プロンプト 0112.00 C *IN04 IFEQ *ON CF04 0113.00 C FLD IFEQ JHCOD 0114.00 C CSRP ANDGT *ZEROS 0115.00 C EXSR PROMPT 0116.00 C 99 GOTO DSPLY 0117.00 C ELSE 0118.00 C SETON 6799 ERR 0119.00 C GOTO DSPLY 0120.00 C END 0121.00 C END CF04
のようにして POPUP を表示しているがマウス操作を追加したからといっても
RPG は何ら変更を加えてはいない。