- 论坛徽章:
- 0
|
按照别人的指点，做了一个可以增加，修改，删除和看详细的PGM，界面如下。
现在想增加一个查询功能，在对E No.进行查询后，能够将光标自动移到查询结果的前面，该如何实现？（如：查询FB00004，在输入后敲执行，光标自动移到FB00004那一行的前面白色输入那里，有可能是不同页的……）想了好久都没有个头绪，望高手不吝指教，谢谢～～
反正只是自己练习用……把代码贴出来了.望高手看看啊～怎么才能实现捏？:wink:
A*%%TS SD 20081106 085934 ROCKYLAU REL-V5R3M0 5722-WDS
A*%%EC
A DSPSIZ(24 80 *DS3)
A INDARA
A CF03(03 'Exit')
A CA12(12 'Cancel')
A R SFL01 SFL
A*%%TS SD 20081105 192348 LIU
A OPTX 1A I 9 3DSPATR(HI)
A HR_EMPNO R O 9 7REFFLD(HR_FMT1/HR_EMPNO ROCKYLAU2/H-
A RPF)
A HR_NAME R O 9 15REFFLD(HR_FMT1/HR_NAME ROCKYLAU2/HR-
A PF)
A HR_POS R O 9 30REFFLD(HR_FMT1/HR_POS ROCKYLAU2/HRP-
A F)
A HR_DEPT R O 9 55REFFLD(HR_FMT1/HR_DEPT ROCKYLAU2/HR-
A PF)
A HR_JDATE R H REFFLD(HR_JDATE ROCKYLAU2/HRPF)
A R SFL01C SFLCTL(SFL01)
A*%%TS SD 20081106 085934 ROCKYLAU REL-V5R3M0 5722-WDS
A PAGEDOWN(21 'Page Down')
A PAGEUP(20 'Page Up')
A RTNCSRLOC(*WINDOW &GETROW1 &GETCOL1)
A BLINK
A CSRLOC(PUTROW1 PUTCOL1)
A OVERLAY
A PRINT
A SFLCSRRRN(&SFLRRN)
A N30 SFLDSP
A N30 SFLDSPCTL
A 30 SFLCLR
A 90 SFLEND
A SFLSIZ(0013)
A SFLPAG(0013)
A 1 33'Employee Management'
A DSPATR(HI)
A COLOR(YLW)
A 1 66USER
A COLOR(PNK)
A 2 66SYSNAME
A COLOR(TRQ)
A 1 2DATE
A EDTCDE(Y)
A 6 3'#'
A DSPATR(HI)
A 7 3'- ------- ------------ --------
A --------- ---------------'
A 6 8'E No.'
A 6 19'Name'
A 6 34'Position'
A 6 57'Department'
A 3 40'5=Display Details'
A COLOR(BLU)
A OPTA 1A I 8 3
A HR_EMPNOA R I 8 7REFFLD(HR_FMT1/HR_EMPNO ROCKYLAU2/H-
A RPF)
A 31 ERRMSG('The Record is Existed.PRESS-
A CTRL Cancel Mistake')
A 3 7'1=Add'
A COLOR(BLU)
A 3 18'2=Modify'
A COLOR(BLU)
A 3 29'4=Delete'
A COLOR(BLU)
A GETROW1 3S 0H
A GETCOL1 3S 0H
A PUTROW1 3S 0H
A PUTCOL1 3S 0H
A*
A SFLRRN 5S 0H
A R SFL01T
A*%%TS SD 20081105 192632 LIU
A 23 45'F3=Exit'
A COLOR(BLU)
A 23 57'Enter=Confirm'
A COLOR(BLU)
A MSGLINE 77 O 24 3DSPATR(HI)
A COLOR(RED)
A R DSP01W
A*%%TS SD 20081105 162634 LIU
A WINDOW(9 12 10 60)
A 1 25'Display Details'
A 3 10'EmpNO:'
A HR_EMPNO R O 3 21REFFLD(HR_FMT1/HR_EMPNO ROCKYLAU2/H-
A RPF)
A 4 10'NAME:'
A HR_NAME R O 4 21REFFLD(HR_FMT1/HR_NAME ROCKYLAU2/HR-
A PF)
A 5 10'POSITION:'
A HR_POS R O 5 21REFFLD(HR_FMT1/HR_POS ROCKYLAU2/HRP-
A F)
A 6 8'DEPARTMENT:'
A HR_DEPT R O 6 21REFFLD(HR_FMT1/HR_DEPT ROCKYLAU2/HR-
A PF)
A 7 10'JOIN DATE:'
A HR_JDATE R O 7 21REFFLD(HR_FMT1/HR_JDATE ROCKYLAU2/H-
A RPF)
A 9 14'Press Enter To Continue'
A COLOR(BLU)
A R CHG01W
A*%%TS SD 20081105 162833 LIU
A WINDOW(9 12 10 60)
A 1 25'Modify Details'
A 3 10'EmpNO:'
A HR_EMPNO R O 3 21REFFLD(HR_FMT1/HR_EMPNO ROCKYLAU2/H-
A RPF)
A 4 10'NAME:'
A HR_NAMEX R B 4 21REFFLD(HR_FMT1/HR_NAME ROCKYLAU2/HR-
A PF)
A 5 10'POSITION:'
A HR_POSX R B 5 21REFFLD(HR_FMT1/HR_POS ROCKYLAU2/HRP-
A F)
A 6 8'DEPARTMENT:'
A HR_DEPTX R B 6 21REFFLD(HR_FMT1/HR_DEPT ROCKYLAU2/HR-
A PF)
A 7 10'JOIN DATE:'
A HR_JDATEX R B 7 21REFFLD(HR_FMT1/HR_JDATE ROCKYLAU2/H-
A RPF)
A 9 30'Press Enter To Continue'
A COLOR(BLU)
A 9 14'F12=Cancel'
A COLOR(BLU)
A R DLT01W
A*%%TS SD 20081105 162833 LIU
A WINDOW(9 12 10 60)
A 1 25'Delete Details'
A DSPATR(BL)
A COLOR(RED)
A 3 10'EmpNO:'
A HR_EMPNO R O 3 21REFFLD(HR_FMT1/HR_EMPNO ROCKYLAU2/H-
A RPF)
A 4 10'NAME:'
A HR_NAME R O 4 21REFFLD(HR_FMT1/HR_NAME ROCKYLAU2/HR-
A PF)
A 5 10'POSITION:'
A HR_POS R O 5 21REFFLD(HR_FMT1/HR_POS ROCKYLAU2/HRP-
A F)
A 6 8'DEPARTMENT'
A HR_DEPT R O 6 21REFFLD(HR_FMT1/HR_DEPT ROCKYLAU2/HR-
A PF)
A 7 10'JOIN DATE:'
A HR_JDATE R O 7 21REFFLD(HR_FMT1/HR_JDATE ROCKYLAU2/H-
A RPF)
A 9 30'Press Enter To Continue'
A COLOR(BLU)
A 9 14'F12=Cancel'
A COLOR(BLU)
A R ADD01W
A*%%TS SD 20081105 190821 LIU
A WINDOW(9 12 10 60)
A 1 25'Add Details'
A 3 10'EmpNO:'
A HR_EMPNOA R O 3 21REFFLD(HR_FMT1/HR_EMPNO ROCKYLAU2/H-
A RPF)
A 4 10'NAME:'
A HR_NAMEA R I 4 21REFFLD(HR_FMT1/HR_NAME ROCKYLAU2/HR-
A PF)
A 5 10'POSITION:'
A HR_POSA R I 5 21REFFLD(HR_FMT1/HR_POS ROCKYLAU2/HRP-
A F)
A 6 8'DEPARTMENT'
A HR_DEPTA R I 6 21REFFLD(HR_FMT1/HR_DEPT ROCKYLAU2/HR-
A PF)
A 7 10'JOIN DATE:'
A HR_JDATEA R I 7 21REFFLD(HR_FMT1/HR_JDATE ROCKYLAU2/H-
A RPF)
A 9 30'Press Enter To Continue'
A COLOR(BLU)
A 9 14'F12=Cancel'
A COLOR(BLU)
RPG的：
** Database file
FHRPF UF A E K DISK
**
F* Display file
FHRDSPF1 CF E WORKSTN SFILE(Sfl01:Rn01)
F INDDS(Indicator)
**
**
D Indicator DS 99
D Exit 3 3N
D Refresh 5 5N
D PrintReport 10 10N
D Cancel 12 12N
D SflCtr 30 30N
D ErrDup 31 31N
D PagUp 20 20N
D PagDwn 21 21N
D SFLEnd 90 90N
D SFLBgn 91 91N
D KeyStoreMark 92 92N
D RecExist 99 99N
D Rn01 S 4 0 INZ(0)
D PagSize S 2 0 INZ(13)
D Count S LIKE(PagSize)
D KeyStore S LIKE(HR_EMPNO)
**
D PageMsg S 40 DIM(3) CTDATA PERRCD(1)
**
C *LOVAL SETLL HR_Fmt1
C EXSR ClearSF
C EXSR LoadSF
**
** --- Loop start ---
C DOW NOT Exit
**
C IF PagDwn AND NOT SFLEnd
C EXSR ClearSF
C EXSR LoadSF
C ENDIF
**
C IF PagUp
C EXSR SkipBefore
C EXSR ClearSF
C EXSR LoadSF
C ENDIF
**
C EVAL MsgLine=*BLANK
C IF SFLEnd
C EVAL MsgLine=PageMsg(2)
C ELSE
C IF SFLBgn AND PagUp
C EVAL MsgLine=PageMsg(1)
C ELSE
C IF RecExist
C EVAL MsgLine=PageMsg(3)
C EVAL REcExist=*OFF
C ENDIF
C ENDIF
C ENDIF
**
C WRITE SFL01t
C EXFMT SFL01c
C EVAL PutRow1=GetRow1
C EVAL PutCol1=GetCol1
** Reset option number to *zero ReRead the SubFile
**
C* ADD Record subrutine when option='1'
C EXSR AddSub
C* Option='2' to......n subrutine
C EXSR OptSub
C IF OptX<>*BLANK
C EVAL OptX=*BLANK
C KeyStore SETLL HRPF
C EXSR ClearSF
C EXSR LoadSF
C ENDIF
**
C ENDDO
C* ---- Loop end --------
C EVAL *INLR=*ON
C RETURN
**
C*------- End of program -------------------------
C*
C* Clear subfile
C ClearSF BEGSR
C EVAL SflCtr=*ON
C WRITE Sfl01c
C* Prepare full subfile
C EVAL SflCtr=*OFF
C EVAL Rn01=0
C ENDSR
C* Initialize
C LoadSF BEGSR
C EVAL KeyStoreMark=*ON
C DO PagSize
C READ(N) HRPF
** Store Key for Refesh screen
C IF KeyStoreMark
C EVAL KeyStore=HR_EMPNO
C EVAL KeyStoreMark=*OFF
C ENDIF
**
C EVAL SflEnd=%EOF(HRPF)
C IF SflEnd
C LEAVE
C ELSE
C EVAL Rn01=Rn01+1
C WRITE Sfl01
C ENDIF
C ENDDO
C ENDSR
**
**
**Skip Current DataBase record position to Pre PagSize x 2 to
**ReRead DataBase record
**
C SkipBefore BEGSR
**
C EVAL Count=PagSize+PagSize
C IF SFLEnd
C *HIVAL SETGT HRPF
C EVAL Count=PagSize+Rn01
C ENDIF
**
C DOU Count=0
C EVAL Count=Count-1
**
C READP(N) HRPF
C EVAL SFLBgn=%EOF(HRPF)
**
C IF SFLBgn
C EVAL HR_EMPNO=*LOVAL
C LEAVE
C ENDIF
C ENDDO
**
C HR_EMPNO SETLL HRPF
**
C ENDSR
**---------
C AddSub BEGSR
**
C IF OptA='1' AND (HR_EMPNOA <> *BLANK)
C* Check code if the record not in file so add it.
C HR_EMPNOA CHAIN HRPF
C IF NOT %Found(HRPF)
C EXFMT Add01W
**
C IF NOT Cancel
C EVAL HR_EMPNO=HR_EMPNOA
C EVAL HR_Name=HR_NameA
C EVAL HR_POS=HR_POSA
C EVAL HR_DEPT=HR_DEPTA
C EVAL HR_JDATE=HR_JDATEA
C* Add one record to file
C WRITE HR_Fmt1
C ENDIF
**
C* After add reset memory var
C CLEAR Add01W
C ELSE
C EVAL RecExist=*ON
C ENDIF
**
C ENDIF
C ENDSR
**----------
C OptSub BEGSR
C READC SFL01
C DOW NOT %EOF
C* read changed subfile record
C SELECT
C* Modify record
C WHEN OptX='2'
C EXSR ChgSub
**
C WHEN OptX='4'
C EXSR DltSub
**
C WHEN OptX='5'
C EXSR DspSub
**
C ENDSL
C* --End of select--
C READC Sfl01
C ENDDO
C ENDSR
C* ------------
C DspSub BEGSR
C EXFMT Dsp01W
C ENDSR
** ------------
C ChgSub BEGSR
C EVAL HR_NameX=HR_Name
C EVAL HR_POSX=HR_POS
C EVAL HR_DEPTX=HR_DEPT
C EVAL HR_JDATEX=HR_JDATE
C EXFMT Chg01W
C* F12 not press mean comfirm change else change cancel.
C IF NOT Cancel
C HR_EMPNO CHAIN HRPF
C IF %FOUND(HRPF)
C EVAL HR_Name=HR_NameX
C EVAL HR_POS=HR_POSX
C EVAL HR_DEPT=HR_DEPTX
C EVAL HR_JDATE=HR_JDATEX
C* Change one record
C UPDATE HR_Fmt1
C ENDIF
C ENDIF
C ENDSR
C* ------------
C DltSub BEGSR
C EXFMT Dlt01W
C* F12=*off confirm delete the Record
C IF NOT Cancel
C HR_EMPNO CHAIN HRPF
C IF %FOUND(HRPF)
C DELETE HR_Fmt1
C ENDIF
C ENDIF
C ENDSR
**
**CTDATA PageMsg
You have reached the top of the list.
You have reached the bottom of the list.
This record is Existed.
[ 本帖最后由 rockylau 于 2008-11-13 14:59 编辑 ] |
-
1.JPG
(49.49 KB, 下载次数: 43)
|
免费注册
发表于 2008-11-12 17:51
发表于 2008-11-13 11:02
