Display attributes made simple

What do you do when a legacy application you're maintaining is out of indicators and you want to control the display attributes? Steve Croy has the solution -- a very simple service program -- right here. He has created a prototyped procedure that makes it simple to manipulate the value of the display attribute in the P-type field.

Everybody enjoys writing new code, but there is still legacy code out there to maintain. (And as I keep reminding myself, the pay is the same whether I write fixed-format RPG or free-format RPG.) This service program and RPG/DDS test source was the result of a situation where a legacy application happened to be out of indicators, raising the issue of how to control display attributes without the use of an indicator.

I knew that I could control the display attributes of a field through the use of the DDS keyword DSPATR and a P-type (program-to-system) variable. To make the process simple and re-useable, I decided to create a prototyped procedure that makes it simple to manipulate the value of the display attribute in the P-type field.

The following source code describes a very simple service program, a display file and a bound RPG program. The objects may serve as an example for application development on a couple of levels. It demonstrates how an RPG program can be made to manipulate display attributes without using indicators. It also provides a step-by-step description of how to create a service program, and how to use a service program procedure via a bound RPGLE program.

The RPG source (Fig. 1) of the service program used to set field display color and other field attributes is represented below. The program's procedure accepts up to three parameters as input and returns the hex character that is necessary to define the display field's attribute.

The first parameter is designed to reflect the color attribute. The second parameter may be used to define an attribute other than color, such as UL (underline) or RI (reverse image). The third parameter is used to determine if the field is to be protected.

Fig. 1

     H/TITLE ** Display Attribute Service Program **
     H DEBUG(*YES)
     H nomain

     D SetColor        PR             1A
     D   colorValue                   3    CONST OPTIONS(*OMIT:*NOPASS)
     D   colorAttr                    2    CONST OPTIONS(*NOPASS)
     D   fieldPr                      2    CONST OPTIONS(*NOPASS)

     P SetColor        B                   export
     D SetColor        PI             1A
     D   colorValue                   3    CONST OPTIONS(*OMIT:*NOPASS)
     D   colorAttr                    2    CONST OPTIONS(*NOPASS)
     D   fieldPr                      2    CONST OPTIONS(*NOPASS)

     D Up              C                   'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
     D Lo              C                   'abcdefghijklmnopqrstuvwxyz'
      *---
      * Define constants
      *---
     D Blue            C                   Const(X'3A')
     D Green           C                   Const(X'20')
     D Pink            C                   Const(X'38')
     D Red             C                   Const(X'28')
     D Turquoise       C                   Const(X'30')
     D White           C                   Const(X'22')
     D Yellow          C                   Const(X'32')

     D Blink           C                   CONST(X'2A')
     D NonDisplay      C                   CONST(X'27')
     D Protect         C                   Const(X'80')
     D Reverse         C                   Const(X'01')
     D Underline       C                   Const(X'04')

     D   color         S              3A
     D   attr          S              2A
     D   pr            S              2A
     D   attribute     S              1A

      /free
         IF %parms < 1  or %addr(colorvalue) = *null                ;
           color = 'GRN'                                            ;
         ELSE                                                       ;
           color = %xlate(lo: up: colorValue)                       ;
         ENDIF                                                      ;
         IF %parms < 2                                              ;
           attr  = '  '                                             ;
         ELSE                                                       ;
           attr  = %xlate(lo: up: ColorAttr)                        ;
         ENDIF                                                      ;
         IF %parms > 2                                              ;
           pr = 'PR'                                                ;
         ELSE                                                       ;
           pr = *blank                                              ;
         ENDIF                                                      ;

         SELECT                                                     ;
             WHEN Color = 'BLU'                                     ;
                attribute = Blue                                    ;
             WHEN Color = 'PNK'                                     ;
                attribute = Pink                                    ;
             WHEN Color = 'RED'                                     ;
                attribute = Red                                     ;
             WHEN Color = 'TRQ'                                     ;
                attribute = Turquoise                               ;
             WHEN Color = 'WHT'                                     ;
                attribute = White                                   ;
             WHEN Color = 'YLW'                                     ;
                attribute = Yellow                                  ;
             OTHER                                                  ;
                attribute = Green                                   ;
         ENDSL                                                      ;

         IF attr = 'UL' or attr = 'UR'                              ;
             attribute = %bitOr(attribute:Underline)                ;
         ENDIF                                                      ;
         IF attr = 'RI' or attr = 'UR'                              ;
             attribute = %bitOr(attribute:Reverse)                  ;
         ENDIF                                                      ;
         IF attr = 'BL'                                             ;
             attribute = Blink                                      ;
         ENDIF                                                      ;
         IF attr = 'ND'                                             ;
             attribute = NonDisplay                                 ;
         ENDIF                                                      ;

         IF pr = 'PR'                                               ;
             attribute = %bitOr(attribute:Protect)                  ;
         ENDIF                                                      ;

         RETURN attribute                                           ;
      /end-free
     P SetColor        E

The D specs (in Fig.1) define the hex patterns that represent color and other attributes. The source code performs some simple tests up front to determine how many parameters have been passed. Since *OMIT is used in conjunction with *NOPASS, %ADDR is used instead of %PARM to see if the first parameter was passed, because *OMIT will be counted as a parameter even if it contains no value (null). 

The body of the program logic sets the attributes and uses the %BITOR BIF to manipulate the bits representing combinations of color, underline, reverse image, and the protect attributes. The hex value passed back to the requesting application will cause fields referencing the P-type variable to show the resulting display attribute, defined by the bit-pattern.

To demonstrate the use of this application, first create a module from the source:

(CRTRPGMOD MODULEMYLIB/UTDATRRI))

Then create a service program from the module:

CRTSRVPGM SRVPGM(MYLIB/UTDATRRI) EXPORT(*ALL) TEXT('Display attribute service program') ACTGRP(QILE)

In most cases, a service program will have multiple procedures defined. It is best to create a service source member to contain the procedures to be exported rather than specifying EXPORT(*ALL) on the command. But for the purpose of this example, and since this small service program contains only one procedure, EXPORT(*ALL) will suffice when you create the object.

Next create a binding directory:

CRTBNDDIR BNDDIR(MYLIB/UTDATRRI) TEXT('Binding directory for display attributes')

Add a binding directory entry: ADDBNDDIRE BNDDIR(MYLIB/UTDATRRI) OBJ((UTDATRRI *SRVPGM))

The binding directory serves as documentation and will allow you to use the 'H' spec within your RPGLE program, simplifying the program creation.

Fig. 2

     A                                      DSPSIZ(24 80 *DS3)
     A                                      PRINT
     A                                      INDARA
     A                                      CA03
     A                                      ROLLUP(90)
     A                                      ROLLDOWN(91)
     A                                      HOME
     A                                      HELP
     A          R COLRDP01
     A                                      ASSUME
     A                                      OVERLAY
     A                                      PUTOVR
     A                                 15  1' '
     A          R COLRDP02
     A*%%TS  SD  20050831  154048  SCROY       REL-V5R2M0  5722-WDS
     A                                      WINDOW(5 7 8 55)
     A                                      OVERLAY
     A                                      WDWBORDER((*DSPATR HI) (*CHAR '...:-
     A                                      ::.:'))
     A                                  2 21'Display Attributes'
     A                                      DSPATR(HI)
     A            DMMY           1A  B  3  1DSPATR(ND)
     A                                  4 10'Attribute:'
     A            Z$TXT1        30A  B  4 21DSPATR(&DSPATR)
     A                                  7 10'F3=Exit'
     A                                      COLOR(BLU)
     A                                  7 21'Enter=Next'
     A                                      COLOR(BLU)
     A            DSPATR         1A  P

To test the service program, I created a simple display file and a program. The source above (Fig. 2) is a small pop-up window display file, UTDATRDP. This contains a record format to allow you to see the results of the display attribute values applied as calls to the service program change the program-to-system variable.

The display attribute of the field, Z$TXT1 is contained in the P-type field DSPATR. The field value manipulated in the RPG program will contain the hex representation of the display attribute, which defines how the device file is to present the field, in normal, high-intensity or underlined and determines whether the field is protected.

CRTDSPF FILE(MYLIB/UTDATRDP) RSTDSP(*YES)

The sample code below (Fig. 3) is a small RPG program using the display and bound to the service program UTDATRRI. Compile the RPG program UTDATRRP using the create bound RPG program command.

CRTBNDRPG PGM(MYLIB/UTDATRRP)

Since the 'H' spec contains the binding directory keyword, option 14 from your PDM member list (CRTBNDRPG) is all you need to create the program -- if you've created the binding directory mentioned in the instructions above. The test program is very simplistic, but does illustrate the basic relationship between a bound process and a service program, prototyping the named procedure from the service program it will use.

Call the program and press the enter key to see the results of the SetColor() procedure as it is invoked by the test program. The procedure with the variable parameter list makes manipulating the display attribute fairly simple. And you won't have to remember the hex values for the various attributes you need to apply to a field.

Fig. 3

     H/TITLE ** Test Display Attribute Service Program **
     H DEBUG(*YES)
     H OPTION(*SRCSTMT : *NODEBUGIO) DFTACTGRP(*NO) ACTGRP('QILE')
     H BNDDIR('UTDATRRI')
      ****************************************************************
     FUTDATRDP  CF   E             WORKSTN

     D SetColor        PR             1A
     D   colorValue                   3    CONST OPTIONS(*OMIT:*NOPASS)
     D   colorAttr                    2    CONST OPTIONS(*NOPASS)
     D   fieldPr                      2    CONST OPTIONS(*NOPASS)

     d ColorText       s              3a
     d attr            s              2a
     d pr              S              2a
     d counter         s              3  0 inz(1)

      /free
         write colrdp01                                             ;
            attr = SetColor('normal')                               ;
            z$txt1 =  attr + 'Press enter to see attrbutes'         ;
         DOU *INKC                                                  ;
            exfmt colrdp02                                          ;
            IF not *INKC                                            ;
               IF *in90                                             ;
                  counter = counter - 2                             ;
               ENDIF                                                ;
               EXSR @next                                           ;
            ENDIF                                                   ;
         ENDDO                                                      ;
         *INLR = *ON                                                ;
         RETURN                                                     ;
         BEGSR @next                                                ;
         SELECT                                                     ;
            WHEN counter = 1                                        ;
                 attr = SetColor('red')                             ;
                 z$txt1 = 'Red text color'                          ;
            WHEN counter = 2                                        ;
                 attr = SetColor('YLW')                             ;
                 z$txt1 = 'Yellow text color'                       ;
            WHEN counter = 3                                        ;
                 attr = SetColor('TRQ')                             ;
                 z$txt1 = 'Cyan, or turquoise'                      ;
            WHEN counter = 4                                        ;
                 attr = SetColor('BLU')                             ;
                 z$txt1 =  'Blue color text'                        ;
            WHEN counter = 5                                        ;
                 attr = SetColor('PNK')                             ;
                 z$txt1  = 'hex 38, pink'                           ;
            WHEN counter = 6                                        ;
                 attr = SetColor('WHT')                             ;
                 z$txt1 = 'White, or high text color'               ;
            WHEN counter = 7                                        ;
                 attr = SetColor('RED':'RI')                        ;
                 z$txt1 =  'Red reverse image color'                ;
            WHEN counter = 8                                        ;
                 attr = SetColor('YLW':'RI')                        ;
                 z$txt1 =  'Yellow reverse image color'             ;
            WHEN counter = 9                                        ;
                 attr = SetColor('TRQ':'RI')                        ;
                 z$txt1 =  'Cyan reverse image color'               ;
            WHEN counter = 10                                       ;
                 attr = SetColor('BLU':'RI')                        ;
                 z$txt1 = 'Blue reverse image color'                ;
            WHEN counter = 11                                       ;
                 attr = SetColor('PNK':'RI')                        ;
                 z$txt1 = 'Pink reverse image color'                ;
            WHEN counter = 12                                       ;
                 attr = SetColor('WHT':'RI')                        ;
                 z$txt1 =  'White reverse image color'              ;
            WHEN counter = 13                                       ;
                 attr = SetColor('GRN':'RI')                        ;
                 z$txt1 = 'green RI, or simply reverse'             ;
            WHEN counter = 14                                       ;
                 attr = SetColor(*OMIT:'BL')                        ;
                 z$txt1 =  'Blink text attribute'                   ;
            WHEN counter = 15                                       ;
                 attr = SetColor(*OMIT:'UL')                        ;
                 z$txt1 =  'Underline attribute'                    ;
            WHEN counter = 16                                       ;
                 attr = SetColor('WHT':'UL')                        ;
                 z$txt1 = 'Underline HI attribute'                  ;
            WHEN counter = 17                                       ;
                 attr = SetColor(*OMIT:'nd')                        ;
                 z$txt1 =   'Non-display'                           ;
            WHEN counter = 18                                       ;
                 attr = SetColor('TRQ':'UL')                        ;
                 z$txt1 =  'Turquoise underlined'                   ;
            WHEN counter = 19                                       ;
                 attr = SetColor('TRQ':'UL':'PR')                   ;
                 z$txt1 = 'Turquoise, protected'                    ;
            WHEN counter = 20                                       ;
                 attr = SetColor('Ylw':'ul')                        ;
                 z$txt1 =  'Yellow underlined'                      ;
            WHEN counter = 21                                       ;
                 attr = SetColor('RED':'UL')                        ;
                 z$txt1 =  'Red underlined'                         ;
            WHEN counter = 22                                       ;
                 attr = SetColor('BLU':'UL')                        ;
                 z$txt1 =  'Blue underlined'                        ;
            WHEN counter = 23                                       ;
                 attr = SetColor('PNK':'UL')                        ;
                 z$txt1 =  'Pink underlined'                        ;
            WHEN counter = 24                                       ;
                 attr = SetColor('PNK':'UR')                        ;
                 z$txt1 =  'Pink underlined'                        ;
            OTHER                                                   ;
                 attr = SetColor('GRN')                             ;
                 z$txt1 =  attr + 'Normal, or green color'          ;
                 counter = 0                                        ;
         ENDSL                                                      ;
         counter = counter + 1                                      ;
         dspatr  = attr                                             ;
         ENDSR                                                      ;
      /end-free

 

With the service program in place, all I have to do is SetColor() to define display attributes. That's all there is to it. Have fun with it!

There are other hex values you might want to include in your service program, such as column separators. If you chose to make a production application from this source, you might want to put some more sophisticated validity checking in the service program, such as a monitor block to manage exceptions, and perhaps you might add an error return code to the parameter list.

I wouldn't recommend this technique to control individual error conditions for a large number of screen fields on the same record format. It could get confusing naming a large number of P-type fields and setting individual values for a large number of fields. The technique could be effective, however, where a screen has all the fields protected (view only) in one mode and unprotected in an update mode. With the display attributes pointed to a common P-type field, all the screen fields could be input-capable, or protected with just a single line of RPG code (SetColor()) and no indicators.

In addition to the display attributes, the program also makes an interesting use of procedure prototypes, demonstrating two very useful options, *OMIT and *NOPASS. It is not usual to see the two used in conjunction. Just be careful of how you test the parameters when using *OMIT, and remember to use %ADDR instead of %PARMS to test whether a value has been passed or not.


 

This was first published in November 2005

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

-ADS BY GOOGLE

SearchEnterpriseLinux

SearchDataCenter

Close