here a program to give an RPG400 program color (IF, END, DO structure
in color)
create user defined option: NV CALL PGM(EUISPH02O/NVCL)
PARM(&L &F &N) cl src:==>
---------------------------------------------------------------------------------
PGM PARM(&LIB &FILE &MBR)
DCL VAR(&LIB) TYPE(*CHAR) LEN(10)
DCL VAR(&FILE) TYPE(*CHAR) LEN(10)
DCL VAR(&MBR) TYPE(*CHAR) LEN(10)
OVRDBF FILE(QRPGSRC) TOFILE(&LIB/&FILE) +
MBR(&MBR)
CALL PGM(EUISPH02O/NV)
ENDPGM
--------------------------------------------------------------------------------
RPG src:==>
H
FQRPGSRC UF F 92 DISK
E EX 99 2 ELSE
E CL 30 1 IFC
IQRPGSRC NS 01 18 CC 19NC* 19NC/
I 13 14 APR
I 40 41 OP2
I 40 42 OP3
I 40 43 OP4
I 40 44 OP5
IQRPGSRC NS 02
I 1 12 ZZZ
I 13 15 TIME
I 16 92 XXX
I/EJECT
C *IN10 IFEQ '0' B001
C Z-ADD0 AANT 30 001
C MOVE '1' *IN10 001
C ENDIF E001
C READ QRPGSRC LR
C *INLR DOWEQ'0' B001
ÌC *IN02 IFEQ '1' B002
C MOVE '0' *IN02 002
C TIME COMP '**' LR LR 002
C LR RETRN 002
ÌC ENDIF E002
ÌC *IN01 IFEQ '1' B002
C MOVE ' ' CHR 1 002
C MOVE *ALL' ' TXT 15 002
C MOVE '0' *IN51 002
ãC OP5 IFEQ 'BEGSR' B003
C EXSR TSTNIV 003
ãC ENDIF E003
C MOVE *OFF *IN49 002
ãC OP2 IFEQ 'IF' B003
C OP2 OREQ 'DO' 0003 0003
C OP3 OREQ 'CAS' 0003 0003
C OP5 OREQ 'SELEC' 0003 0003
C MOVE *ON *IN49 003 003
C N50 ADD 1 NIV 30 003 003
C N50 MOVE 'B' CHR 003 003
éC N50 OP3 IFEQ 'CAS' B004 004
C MOVE 'CS' EX,NIV 004 004
éC ELSE X004 X004
ÙC OP5 IFEQ 'SELEC' B005 005
C MOVE 'SL' EX,NIV 005
ÙC ELSE X005
C MOVE OP2 EX,NIV 005
ÙC ENDIF E005
éC ENDIF E004
**
C N50 OP3 COMP 'CAS' 50 003
ãC ENDIF E003
ãC OP3 IFEQ 'END' B003
C OP5 ANDNE'ENDSR' A003
C MOVE *ON *IN49 003
C MOVE 'E' CHR 003
C MOVEA'01' *IN,50 003
ãC ENDIF E003
ãC OP5 IFEQ 'ELSE' B003
C MOVE *ON *IN49 003
C MOVE 'X' CHR 003
ãC ENDIF E003
ãC OP2 IFEQ 'OR' B003
C MOVE '0' CHR 003
ãC ENDIF E003
ãC OP3 IFEQ 'AND' B003
C MOVE 'A' CHR 003
ãC ENDIF E003
ãC NIV IFLT *ZERO B003
C MOVE *ALL'*' NUM 3 003
ãC ELSE X003
éC NIV IFEQ *ZERO B004
C MOVE *ALL' ' NUM 004
éC ELSE X004
C MOVE NIV NUM 004
éC ENDIF E004
ãC ENDIF E003
** AANPASSEN BESTAND
C Z-ADDNIV B 30 002
ãC B IFLE 0 B003
C Z-ADD1 B 003
C MOVE *BLANKS EX,B 003
ãC ENDIF E003
C EXCPTBTH 002
C 51 SUB 1 NIV 002
ÌC ENDIF E002
C**
C MOVEA'00' *IN,1 001
C READ QRPGSRC LR 001
C ENDDO E001
CLR EXSR TSTNIV
CLR MOVE AANT RTCD 3
** BIJ ENDSR MOET NIV = 0 ANDERS IS ER EEN END TEVEEL OF TE WEINIG
C TSTNIV BEGSR
C NIV IFNE 0 B001
C ADD 1 AANT 001
C Z-ADD0 NIV 001
C ENDIF E001
C ENDSR
**
** FIRST CYCLE
C *INZSR BEGSR
C BITOF'01234567'@NRML 1
C BITON'1' @NRML
C BITOF'01234567'@WHITE 1
C BITON'26' @WHITE
C BITOF'01234567'@RED 1
C BITON'24' @RED
C BITOF'01234567'@PINK 1
C BITON'234' @PINK
C BITOF'01234567'@BLUE 1
C BITON'2346' @BLUE
C BITOF'01234567'@TURQS 1
C BITON'23' @TURQS
C BITOF'01234567'@YELLW 1
C BITON'236' @YELLW
C MOVE @YELLW CL,1
C MOVE @RED CL,2
C MOVE @PINK CL,3
C MOVE @BLUE CL,4
C MOVE @TURQS CL,5
C MOVE @WHITE CL,6
C MOVE @YELLW CL,7
C MOVE @RED CL,8
C MOVE @PINK CL,9
C MOVE @BLUE CL,10
C MOVE @TURQS CL,11
C MOVE @YELLW CL,12
C MOVE @WHITE CL,13
C MOVE @RED CL,14
C MOVE @PINK CL,15
C MOVE @BLUE CL,16
C MOVE @TURQS CL,17
C MOVE @YELLW CL,18
C ENDSR
OQRPGSRC E BTH
O 49CL,B 17
O 51EX,B 44
O CHR 83
O NUM 86
O 49@NRML 87
---------------------------------------------------------------------------------
compile these programs once,
to use: put NV in pdm before the RPG source and enter, that 's it
note: positions 9 -> 10 must be blanco, if not, not all the lines
become in color
-------------------------------------------------------------------------------------
best regards,
Peter
Citeren manish soni <pesfunk@xxxxxxxxx>:
Hi All,
I saw someone with an RPG source code to use different colors for different
lines.
Is there a way to change the source code color of RPG programs ?
Regards
Manish
--
This is the RPG programming on the IBM i / System i (RPG400-L) mailing list
To post a message email: RPG400-L@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/rpg400-l
or email: RPG400-L-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/rpg400-l.
midrange.com
