Url: http://bbs.chinaunix.net/forum.php?mod=viewthread&tid=533052
Member Type
CHGSEUC CLP
CHGSEUCLR CMD
CHGSEUD DSPF
CHGSEUR RPG
CHGSEUC CLP
0001.00 PGM PARM(&L &F &N)
0002.00 DCL VAR(&L) TYPE(*CHAR) LEN(10)
0003.00 DCL VAR(&F) TYPE(*CHAR) LEN(10)
0004.00 DCL VAR(&N) TYPE(*CHAR) LEN(10)
0005.00 OVRDBF FILE(TXTFILE) TOFILE(&L/&F) MBR(&N)
0006.00 CALL PGM(CHGSEUR) PARM(&L &F &N)
0007.00 ENDPGM
CHGSEUCLR CMD
0001.00 CMD PROMPT(' 更改 SEU 的颜色 ')
0002.00 PARM KWD(LIB) TYPE(*NAME) LEN(10) MIN(1) +
0003.00 PROMPT(' 库名 ')
0004.00 PARM KWD(FILE) TYPE(*NAME) LEN(10) MIN(1) +
0005.00 PROMPT(' 源文件 ')
0006.00 PARM KWD(MBR) TYPE(*NAME) LEN(10) MIN(1) +
0007.00 PROMPT(' 成员名 ')
CHGSEUD DSPF
0001.00 A DSPSIZ(24 80 *DS3)
0002.00 A PRINT
0003.00 A ERRSFL
0004.00 A HELP
0005.00 A CF03(03 'EXIT')
0006.00 A CF01(03)
0007.00 A VLDCMDKEY(25 'VALID COMMAND KEY'
0008.00 A R SFLRCD SFL
0009.00 A POSRRN 7S 0H
0010.00 A SCTXT 78A O 4 2
0011.00 A R SFLCTL SFLCTL(SFLRCD)
0012.00 A CF09(09 'COLOR TEXT')
0013.00 A CF10(10 'POSITION TO TOP')
0014.00 A CF19(19 'VIEW LEFT')
0015.00 A CF20(20 'VIEW RIGHT')
0016.00 A ROLLUP(50 'ROLL UP')
0017.00 A ROLLDOWN(51 'ROLL DOWN')
0018.00 A CSRLOC(ROW COL)
0019.00 A OVERLAY
0020.00 A SFLCSRRRN(&CRRN)
0021.00 A 61 SFLDSP
0022.00 A 60 SFLDSPCTL
0022.02 A 62 SFLCLR
0022.03 A 63 SFLEND(*MORE)
0023.00 A SFLSIZ(16)
0024.00 A SFLPAG(16)
0025.00 A 80 SFLMSG('YOU HAVE REACHED THE BOTTOM-
0026.00 A OF THE LIST')
0027.00 A 81 SFLMSG('YOU HAVE REACHED TO TOP OF -
0028.00 A OF THE LIST')
0029.00 A 82 SFLMSG('WINDOW STARTS AT POSITION 1-
0030.00 A ')
0030.01 A 83 SFLMSG('WINDOW STARTS AT POSITION 1-
0030.02 A 20')
0033.00 A 84 SFLMSG('CURSOR MUST BE AT BLANK POS-
0034.00 A ITION IN RECORD')
0035.00 A 85 SFLMSG('CURSOR OUTSIDE RANGE.ROWS -
0036.00 A 4 - 19 COLUMNS 2 - 78.')
0036.01 A CRRN 5S 0H
0036.02 A ROW 3S 0H
0036.03 A COL 3S 0H
0037.00 A 1 26'LIBRARY '
0037.01 A DSPATR(UL)
0038.00 A 1 38'FILE '
0038.01 A DSPATR(UL)
0039.00 A 1 50'MEMBER '
0040.00 A DSPATR(UL)
0041.00 A 2 2'WINDOW:'
0042.00 A W 3Y 0B 2 10CHECK(RB)
0043.00 A EDTCDE(4)
0044.00 A RANGE(1 198)
0045.00 A SCLIB 10A O 2 26DSPATR(HI)
0045.01 A COLOR(BLU)
0046.00 A SCFILE 10A O 2 38DSPATR(HI)
0046.01 A COLOR(BLU)
0047.00 A SCMBR 10A O 2 50DSPATR(HI)
0047.01 A COLOR(BLU)
0048.00 A 3 2'_________________________________-
0049.00 A __________________________________-
0050.00 A _________'
0050.01 A COLOR(WHT)
0051.00 A R BOTTOM
0052.00 A 21 2'_________________________________-
0053.00 A __________________________________-
0054.00 A _________'
0055.00 A COLOR(WHT)
0056.00 A 23 2'F3 = EXIT'
0056.01 A COLOR(BLU)
0057.00 A 23 15'F9 = COLOR AT POSITION'
0057.01 A COLOR(BLU)
0058.00 A 23 40'F19 = LEFT'
0058.01 A COLOR(BLU)
0059.00 A 23 53'F20 = RIGHT'
0059.01 A COLOR(BLU)
0060.00 A R COLORW
0061.00 A CF15(15 'BLANK OUT POSITION')
0062.00 A KEEP
0063.00 A WINDOW(2 2 16 20)
0064.00 A HX001 1A B 1 2
0065.00 A HX002 1A B 2 2
0066.00 A HX003 1A B 3 2
0067.00 A HX004 1A B 4 2
0068.00 A HX005 1A B 5 2
0069.00 A HX006 1A B 6 2
0070.00 A HX007 1A B 7 2
0071.00 A HX008 1A B 8 2
0072.00 A HX009 1A B 9 2
0073.00 A HX010 1A B 10 2
0074.00 A HX011 1A B 11 2
0075.00 A HX012 1A B 12 2
0076.00 A HX013 1A B 13 2
0077.00 A HX014 1A B 1 12
0078.00 A HX015 1A B 2 12
0079.00 A HX016 1A B 3 12
0081.00 A HX017 1A B 4 12
0082.00 A HX018 1A B 5 12
0083.00 A HX019 1A B 6 12
0084.00 A HX020 1A B 7 12
0085.00 A HX021 1A B 8 12
0086.00 A HX022 1A B 9 12
0087.00 A HX023 1A B 10 12
0088.00 A HX024 1A B 11 12
0089.00 A HX025 1A B 12 12
0090.00 A HX026 1A B 13 12
0091.00 A FLD01 3A O 1 4
0092.00 A FLD02 3A O 2 4
0093.00 A FLD03 3A O 3 4
0094.00 A FLD04 3A O 4 4
0095.00 A FLD05 3A O 5 4
0096.00 A FLD06 3A O 6 4
0097.00 A FLD07 3A O 7 4
0098.00 A FLD08 3A O 8 4
0099.00 A FLD09 3A O 9 4
0100.00 A FLD10 3A O 10 4
0101.00 A FLD11 3A O 11 4
0102.00 A FLD12 3A O 12 4
0103.00 A FLD13 3A O 13 4
0104.00 A FLD14 3A B 1 14
0105.00 A FLD15 3A B 2 14
0106.00 A FLD16 3A B 3 14
0107.00 A FLD17 3A B 4 14
0108.00 A FLD18 3A B 5 14
0109.00 A FLD19 3A B 6 14
0110.00 A FLD20 3A B 7 14
0111.00 A FLD21 3A B 8 14
0112.00 A FLD22 3A B 9 14
0113.00 A FLD23 3A B 10 14
0114.00 A FLD24 3A B 11 14
0115.00 A FLD25 3A B 12 14
0116.00 A FLD26 3A B 13 14
0117.00 A 15 2'RESET TO BLANK
0118.00 A COLOR(BLU)
0119.00 A R DUMMY
0120.00 A ASSUME
0121.00 A 1 3' '
CHGSEUR RPG
0001.00 FCHGSEUD CF E WORKSTN
0002.00 F RRN KSFILE SFLRCD
0003.00 F KINFDS INFDS
0004.00 FTXTFILE UF F 210 DISK
0005.00 E COLR 1 27 2
0006.00 E HX 26 1
0007.00 E HC 26 1
0008.00 E CLR 26 2
0009.00 E DTA 198 1
0010.00 E FLD 26 3
0011.00 ITXTFILE AA 01
0012.00 I 13 210 DTA
0013.00 I DS
0014.00 I 1 78 FLDDS
0015.00 I 1 3 FLD01
0016.00 I 4 6 CLD02
0017.00 I 7 9 CLD03
0018.00 I 10 12 CLD04
0019.00 I 13 15 CLD05
0020.00 I 16 18 CLD06
0021.00 I 19 21 FLD07
0022.00 I 22 24 FLD08
0023.00 I 25 27 FLD09
0024.00 I 28 30 FLD10
0025.00 I 31 33 FLD11
0026.00 I 34 36 FLD12
0027.00 I 37 39 FLD13
0028.00 I 40 42 FLD14
0029.00 I 43 45 FLD15
0030.00 I 46 48 FLD16
0031.00 I 49 51 FLD17
0032.00 I 52 54 FLD18
0033.00 I 55 57 FLD19
0034.00 I 58 60 FLD20
0035.00 I 61 63 FLD21
0036.00 I 64 66 FLD22
0037.00 I 67 69 FLD23
0038.00 I 70 72 FLD24
0039.00 I 73 75 FLD25
0040.00 I 76 78 FLD26
0040.01 I DS
0040.02 I 1 26 HX
0041.00 I 1 1 HX001
0042.00 I 2 2 HX002
0043.00 I 3 3 HX003
0044.00 I 4 4 HX004
0045.00 I 5 5 HX005
0046.00 I 6 6 HX006
0047.00 I 7 7 HX007
0048.00 I 8 8 HX008
0049.00 I 9 9 HX009
0050.00 I 10 10 HX010
0051.00 I 11 11 HX011
0052.00 I 12 12 HX012
0053.00 I 13 13 HX013
0054.00 I 14 14 HX014
0055.00 I 15 15 HX015
0056.00 I 16 16 HX016
0057.00 I 17 17 HX017
0058.00 I 18 18 HX018
0059.00 I 19 19 HX019
0060.00 I 20 20 HX020
0061.00 I 21 21 HX021
0062.00 I 22 22 HX022
0063.00 I 23 23 HX023
0064.00 I 24 24 HX024
0065.00 I 25 25 HX025
0066.00 I 26 26 HX026
0067.00 I DS
0068.00 I 1 3 FIELD
0069.00 I 1 1 HEX
0070.00 I 2 3 CHAR
0071.00 IINFDS DS
0072.00 I 369 369 KEY
0073.00 I B 370 3710CURSOR
0074.00 I B 378 3790PAGRRN
0074.01 C*
0075.00 C *IN03 DOWEQ*OFF
0076.00 C Z-ADDW WW
0077.00 C WRITEBOTTOM
0078.00 C EXFMTSFLCTL
0079.00 C CURSOR DIV 256 ROW
0080.00 C MVR COL
0081.00 C MOVEA'000000' *IN,80 80 - 85
0081.01 C*
0082.00 C *IN03 IFEQ *ON
0083.00 C MOVE *ON *INLR
0084.00 C LEAVE
0085.00 C ENDIF
0086.00 C*
0086.01 C *IN09 IFEQ *ON
0087.00 C COL IFLT 2
0088.00 C COL ORGT 78
0089.00 C ROW ORLT 4
0090.00 C ROW ORGT 19
0091.00 C MOVE *ON *IN85
0092.00 C ITER
0093.00 C ENDIF
0094.00 C*
0095.00 C CRRN IFNE 0
0096.00 C CRRN CHAINSFLRCD 95
0097.00 C *IN95 IFEQ *OFF
0098.00 C EXSR @COLOR
0099.00 C MOVEADTA,W SCTXT
0100.00 C UPDATSFLRCD
0101.00 C ITER
0102.00 C ENDIF
0103.00 C ENDIF
0104.00 C ENDIF
0105.00 C*
0106.00 C *IN10 IFEQ *ON
0107.00 C CRRN IFNE 0
0108.00 C CRRN CHAINSFLRCD 95
0109.00 C *IN95 IFEQ *OFF
0110.00 C MOVE *OFF *IN63
0111.00 C Z-ADDPOSRRN RRNUM
0112.00 C EXSR @UPRTN
0113.00 C ENDIF
0114.00 C ENDIF
0115.00 C ITER
0116.00 C ENDIF
0117.00 C*
0118.00 C *IN19 IFEQ *ON
0118.01 C MOVE *OFF *IN25
0118.02 C MOVE *OFF *IN63
0119.00 C SUB 78 W
0120.00 C W IFLT 1
0121.00 C Z-ADD1 W
0122.00 C MOVE *ON *IN82
0123.00 C ENDIF
0124.00 C ENDIF
0125.00 C*
0126.00 C *IN20 IFEQ *ON
0126.01 C MOVE *OFF *IN25
0126.02 C MOVE *OFF *IN63
0126.03 C ADD 78 W
0126.04 C W IFGT 198
0127.00 C Z-ADD120 W
0128.00 C MOVE *ON *IN83
0129.00 C ENDIF
0130.00 C ENDIF
0131.00 C*
0132.00 C *IN50 IFEQ *ON
0133.00 C *IN80 ANDEQ*OFF
0134.00 C EXSR @UPRTN
0135.00 C ITER
0136.00 C ENDIF
0137.00 C*
0138.00 C *IN51 IFEQ *ON
0139.00 C *IN80 ANDEQ*OFF
0140.00 C EXSR @DWRTN
0141.00 C ITER
0142.00 C ENDIF
0143.00 C*
0144.00 C *IN25 IFEQ *OFF
0145.00 C *IN61 IFEQ *ON
0146.00 C 1 CHAINSFLRCD 95
0147.00 C Z-ADDPOSRRN RRNUM
0148.00 C ENDIF
0149.00 C EXSR @UPRTN
0150.00 C ENDIF
0151.00 C ENDDO
0152.00 C*
0153.00 C @CLEAR BEGSR
0154.00 C MOVEA'001' *IN,60
0155.00 C WRITESFLCTL
0156.00 C MOVEA'100' *IN,60
0157.00 C MOVE *OFF *IN69
0158.00 C ENDSR
0159.00 C*
0160.00 C @UPRTN BEGSR
0161.00 C *IN63 IFEQ *ON
0162.00 C MOVE *ON *IN80
0163.00 C ELSE
0164.00 C EXSR @CLEAR
0165.00 C Z-ADD0 RRN
0166.00 C Z-ADD0 X
0167.00 C X DOUEQSFSIZE
0168.00 C *IN69 IFEQ *OFF
0169.00 C RRNUM CHAINTXTFILE 69
0170.00 C *IN69 IFEQ *ON
0171.00 C MOVE *ON *IN63
0172.00 C LEAVE
0173.00 C ENDIF
0174.00 C*
0175.00 C MOVEADTA,W SCTXT
0176.00 C Z-ADDRRNUM POSRRN
0177.00 C ADD 1 RRN 61
0178.00 C ADD 1 X
0179.00 C WRITESFLRCD
0180.00 C ADD 1 RRNUM
0181.00 C ENDIF
0182.00 C ENDDO
0183.00 C*
0184.00 C *IN69 IFEQ *ON
0185.00 C RRNUM CHAINTXTFILE 69
0186.00 C *IN69 IFEQ *ON
0187.00 C *IN81 ANDNE*ON
0188.00 C MOVE *ON *IN80
0189.00 C ENDIF
0189.01 C ENDIF
0189.02 C ENDIF
0190.00 C ENDSR
0191.00 C @DWRTN BEGSR
0192.00 C MOVE *OFF *IN63
0193.00 C *IN61 IFEQ *ON
0194.00 C 1 CHAINSFLRCD 95
0195.00 C POSRRN SUB SFSIZE RRNUM
0196.00 C ENDIF
0197.00 C RRNUM IFLT 1
0198.00 C Z-ADD1 RRNUM
0199.00 C MOVE *ON *IN81
0200.00 C ENDIF
0201.00 C EXSR @UPRTN
0202.00 C ENDSR
0203.00 C*
0204.00 C @COLOR BEGSR
0205.00 C POSRRN CHAINTXTFILE 95
0206.00 C *IN95 IFEQ *OFF
0207.00 C COL SUB 2 O 30
0208.00 C ADD WW O
0209.00 C DTA,O IFNE ' '
0210.00 C Z-ADD1 X
0211.00 C DTA,O LOKUPHC,X 99
0212.00 C ELSE
0213.00 C MOVE *ON *IN99
0214.00 C ENDIF
0215.00 C ENDIF
0216.00 C*
0217.00 C *IN99 IFEQ *ON
0218.00 C EXFMTCOLORW
0219.00 C *IN15 IFEQ *ON
0220.00 C MOVE *BLANK HX
0221.00 C Z-ADD1 C 30
0222.00 C ELSE
0223.00 C Z-ADD1 C
0224.00 C 'X' LOKUPHX,C 15
0225.00 C ENDIF
0226.00 C *IN15 IFEQ *ON
0227.00 C MOVELHC,C SEL 1
0228.00 C MOVE SEL DTA,O
0229.00 C EXCPTUPDTXT
0230.00 C ENDIF
0231.00 C ELSE
0232.00 C MOVE *ON *IN84
0233.00 C ENDIF
0234.00 C ENDSR
0235.00 C*
0236.00 C *INZSR BEGSR
0237.00 C *ENTRY PLIST
0238.00 C PARM SCLIB
0239.00 C PARM SCFILE
0240.00 C PARM SCMBR
0241.00 C *LIKE DEFN W WW
0242.00 C Z-ADD1 W
0243.00 C Z-ADD0 X 30
0244.00 C Z-ADD16 SFSIZE 30
0245.00 C Z-ADD0 RRN 30
0246.00 C Z-ADD1 RRNUM 60
0247.00 C MOVEACOLR CLR
0248.00 C MOVELX'20' HC,1
0248.01 C MOVELX'21' HC,2
0248.02 C MOVELX'24' HC,3
0248.03 C MOVELX'25' HC,4
0248.04 C MOVELX'22' HC,5
0248.05 C MOVELX'23' HC,6
0248.06 C MOVELX'26' HC,7
0248.07 C MOVELX'2A' HC,8
0249.00 C MOVELX'2B' HC,9
0250.00 C MOVELX'2C' HC,10
0251.00 C MOVELX'2D' HC,11
0252.00 C MOVELX'2E' HC,12
0253.00 C MOVELX'30' HC,13
0254.00 C MOVELX'31' HC,14
0255.00 C MOVELX'34' HC,15
0256.00 C MOVELX'35' HC,16
0257.00 C MOVELX'3A' HC,17
0258.00 C MOVELX'3B' HC,18
0259.00 C MOVELX'3E' HC,19
0260.00 C MOVELX'32' HC,20
0261.00 C MOVELX'33' HC,21
0262.00 C MOVELX'36' HC,22
0263.00 C MOVELX'38' HC,23
0264.00 C MOVELX'39' HC,24
0265.00 C MOVELX'3C' HC,25
0266.00 C MOVELX'3D' HC,26
0267.00 C Z-ADD1 LP 20
0268.00 C LP DOWLT26
0269.00 C MOVE HC,LP HEX
0270.00 C MOVE COLR,LP CHAR
0271.00 C MOVE FIELD FLD,LP
0272.00 C ADD 1 LP
0273.00 C ENDDO
0274.00 C MOVEAFLD FLDDS
0275.00 C EXSR @UPRTN
0276.00 C ENDSR
0277.00 C******************************************
0278.00 OTXTFILE E UPDTXT
0279.00 O DTA 210
0280.00 **
0281.00 20
0282.00 21
0283.00 24
0284.00 25
0285.00 22
0286.00 23
0287.00 26
0288.00 2A
0289.00 2B
0290.00 2C
0291.00 2D
0292.00 2E
0293.00 30
0294.00 31
0295.00 34
0296.00 35
0297.00 3A
0298.00 3B
0299.00 3E
0300.00 32
0301.00 33
0302.00 36
0303.00 38
0304.00 39
0305.00 3C
0306.00 3D 
扫一扫
443
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
