分类： 系统运维
2012-03-06 21:59:32
代码是参考网上给的，增加以下代码就可以使注释行显示白色
EVAL %SUBST(SOURCESTMT:6:1) =X'22'
常用的颜色属性有：
x'21' 反白 Reverse
x'22' 高亮度 HI
x'23' 高亮度反白 HI reverse
x'28' 红色 Red
x'29' 红色反白 Red reverse
x'2A' 闪烁 Blink
使用方法：seu在编辑代码的模式下 按shift+F1 在最后一个参数 EXIT PROGRAM 填写以下代码编译的pgm就可以了
H**********************************************************************
H* SOURCE的注释功能,在代码行中按下F7在注释和非注释行之间进行切换
H* 注释行颜色显示白色 .
H*
H* RPGLE - SEUCMT - ADD COMMENT IN SEU *
* *
* COPYRIGHT (C) 2005 YAO ZHONGGUANG. ALL RIGHTS RESERVED. *
H**********************************************************************
H DATEDIT(*YMD)
H TIMFMT(*HMS)
**********************************************************************
* DEFINITION SPECIFICATIONS
**********************************************************************
**********************************************************************
* Entry Parameters declarations
**********************************************************************
D ParmSeuInput S *
D ParmSeuOut S *
D ParmSeuLine S *
**********************************************************************
* Header information
**********************************************************************
D HeaderInfo DS BASED(ParmSeuInput)
D RecLength 1 4B 0
D CursorRRN 5 8B 0
D CursorPos 9 12B 0
D CCSID 13 16B 0
D InRecords 17 20B 0
D MemberName 21 30
D FileName 31 40
D LibraryName 41 50
D MemberType 51 60
D CmdKey 61 61
D Mode 62 62
D SplitSess 63 63
D Res 64 64
**********************************************************************
* Return Codes
**********************************************************************
D ReturnInfo DS BASED(ParmSeuOut)
D RetCode 1 1
D Res2 2 4
D OutRecords 5 8B 0
D InsertSeq 9 15
D Res3 16 37
**********************************************************************
* Line Command and Text
**********************************************************************
D LineInfo DS BASED(ParmSeuLine)
D LineCmd 7
D LineRetCode 1
D SourceSeq 6
D SourceDate 6
D SourceStmt 256
**********************************************************************
* Send message API
**********************************************************************
D SndPgmMsg PR ExtPgm('QMHSNDPM')
D MsgID 7 Const
D MsgFile 20 Const
D MsgData 256 Const
D MsgDataLen 10i 0 Const
D MsgType 10 Const
D MsgStackEnt 10 Const
D MsgStackCnt 10i 0 Const
D MsgKey 4 Const
D MsgAPIError like(APIError)
**********************************************************************
* API error structure
**********************************************************************
D APIError DS inz
D ErrSSize 10i 0 inz(%len(APIError))
D ErrSUse 10i 0
D ErrSMsgID 7
D ErrSResrv 1
D ErrSData 80
**********************************************************************
* Work Variables
**********************************************************************
D wMsgID S 7
D wSource S 256 Varying
D wPos S 3S 0
D wSourceLen S 10i 0
D wBlankLine S Like(LineCmd)
D wFirstLine S *
D wWorkLine S *
**********************************************************************
* Work Const
**********************************************************************
D wCmtS C Const('/*')
D wCmtE C Const('*/')
**********************************************************************
* CALCULATION SPECIFICATIONS
**********************************************************************
*
C *Entry Plist
C Parm ParmSeuInput
C Parm ParmSeuOut
C Parm ParmSeuLine
*
**********************************************************************
* M A I N - R O U T I N E
**********************************************************************
C*
C* Update Mode
C If Mode = 'U'
C*
C CmdKey CasNE '0' SubLineKey
C Endcs
C*
C Else
C* Browse Mode
C Eval RetCode = '1'
C Eval wMsgID = 'EDT1202'
C Exsr SubSndMsg
C*
C Endif
C* Return
C Eval *InLr = *On
C Eval *InRt = *On
C*
**********************************************************************
*
**********************************************************************
C SubLineKey Begsr
C*
C If CmdKey = '7'
C*
C If CursorPos = 0
C Eval RetCode = '1'
C Eval wMsgID = 'EDT2010'
C Exsr SubSndMsg
C Else
C Exsr SubSltType
C Endif
C*
C Else
C*
C Eval RetCode = '1'
C Eval wMsgID = 'EDT0001'
C Exsr SubSndMsg
C*
C Endif
C*
C Endsr
**********************************************************************
*
**********************************************************************
C SubSltType Begsr
C*
C Select
C*
C When %Subst(MemberType:1:3) = 'CLP'
C Exsr SubClpCmt
C When %Subst(MemberType:1:3) = 'RPG' Or
C %Subst(MemberType:4:3) = 'RPG' Or
C %Subst(MemberType:1:2) = 'PF' Or
C %Subst(MemberType:1:2) = 'LF' Or
C %Subst(MemberType:1:4) = 'DSPF' Or
C %Subst(MemberType:1:4) = 'PRTF'
C Exsr SubRpgCmt
C*
C Endsl
C*
C Endsr
**********************************************************************
*
**********************************************************************
C SubClpCmt Begsr
C*
C Eval SourceStmt = %Subst(SourceStmt:1:RecLength)
C Eval %Len(wSource) = RecLength
C Eval wSource = %Trim(SourceStmt)
C*
C If wSource = *Blanks
C Eval RetCode = '1'
C Goto SubClpCmtEnd
C Endif
C*
C* Remove Comment
C If %Subst(wSource:1:2) = wCmtS
C*
C Eval wPos = %Scan(wCmtS:SourceStmt)
C Eval %Subst(SourceStmt:wPos:2) = ' '
C Eval wPos = %Scan(wCmtE:SourceStmt)
C Eval %Subst(SourceStmt:wPos:2) = ' '
C* Add Comment
C Else
C*
C Eval wSource = wCmtS
C + ' '
C + %Trim(wSource)
C + ' '
C + wCmtE
C*
C ' ' Check SourceStmt wPos
C*
C If wPos < 4
C Eval SourceStmt = wSource
C Else
C Eval SourceStmt = *Blanks
C Eval %Subst(SourceStmt:wPos-3) = wSource
C Endif
C*
C Endif
C*
C Exsr SubUpd
C*
C SubClpCmtEnd Endsr
**********************************************************************
*
**********************************************************************
C SubRpgCmt Begsr
C*
C If %Subst(SourceStmt:7:1) = '*'
C EVAL %Subst(SourceStmt:7:1) = ' '
C EVAL %SUBST(SOURCESTMT:6:1) =' '
C
C Else
C EVAL %Subst(SourceStmt:7:1) = '*'
C EVAL %SUBST(SOURCESTMT:6:1) =X'22'
C
C Endif
C*
C Exsr SubUpd
C*
C Endsr
**********************************************************************
*
**********************************************************************
C SubSndMsg Begsr
C*
C Callp SndPgmMsg(wMsgID:
C 'QEDTMSG QPDA ':
C *Blanks:
C *Zero:
C '*INFO':
C '*':
C 2:
C *Blanks:
C APIError)
C*
C Endsr
**********************************************************************
*
**********************************************************************
C SubUpd Begsr
C*
C Eval Retcode = '0'
C Eval OutRecords = 1
C*
C Endsr
参考网址 以便回看
