RE: Indicators

["Tim Kredlo" <TKredlo@xxxxxxxxxxxxxxxx>]

Buck,

I like it. I have never used a variable for the DSPATR value, but I'll give
it a try.
Thanks, this solution should resolve all my issues.
Well, at least as far as 'double-negatives' and screen indicators are
concerned.
I still have problems with the current administration.  :>)

Tim Kredlo
Exterior Wood, Inc

-----Original Message-----
From: rpg400-l-bounces@xxxxxxxxxxxx [mailto:rpg400-l-bounces@xxxxxxxxxxxx]
On Behalf Of Buck Calabro
Sent: Thursday, September 09, 2004 8:49 AM
To: rpg400-l@xxxxxxxxxxxx
Subject: Re: Indicators


> I have mapped field names such as
> "Part#Invld" to *In23, "LengInvld" to
> *In24, etc., so that the corresponding
> indicator can be used to reverse
> imaging/cursor position screen fields on errors.

How about the DDS keyword DSPATR(&ATTRIB)?  It'll let you eliminate the
indicator for the reverse image anyway...  Here is a completely fabricated
example:

QDDSSRC DSPFATR
     A                                      CF03(03 'Exit')
     A*
     A          R DSPFR                     TEXT('Display file
examples')
     A                                      BLINK
     A                                      CSRLOC(ROW COL)
     A            ROW            3  0H      TEXT('CSRLOC row')
     A            COL            3  0H      TEXT('CSRLOC col')
     A*
     A                                  9  2'Some input'
     A                                      DSPATR(HI UL)
     A            FLDA          10   B 10  2TEXT('Generic
input/output')
     A                                      DSPATR(&FLDAATR)
     A            FLDB          20   B 11  2TEXT('Generic
input/output')
     A                                      DSPATR(&FLDBATR)
     A            FLDAATR        1   P
     A            FLDBATR        1   P

QRPGLESRC DSPFATR
     H debug option(*srcstmt: *nodebugio)
     H actgrp('QILE') dftactgrp(*no)
      * dbgview(*list)

      * Show use of program to system attribute field
      * and program described cursor positioning

     fdspfatr   cf   e             workstn
     f                                     infds(dspfDS)
     f                                     devid(pgmDev)

     d dspfDS          ds
     d  scrSize          *SIZE
     d  scrPos               370    371i 0
     d  wdwPos               382    383i 0

      * work variables
     d rowLimit        s             10i 0
     d colLimit        s             10i 0
     d atr             s                   like(fldaatr)

      * field attribute bit patterns
     d NO              s              1a   inz(x'00')
no attrs
     d RI              s              1a   inz(x'01')
reverse
     d HI              s              1a   inz(x'02')
highlight
     d UL              s              1a   inz(x'04')
underline
     d ND              s              1a   inz(x'07')
non display
     d BL              s              1a   inz(x'08')
blink
     d NP              s              1a   inz(x'20')
non protect
     d CS              s              1a   inz(x'30')
column sep
     d PR              s              1a   inz(x'80')
protect

     d setAtr          pr                  like(atr)
     d  inpFld                       50    const

     c                   dow       *in03 = *off
     c                   exfmt     dspfr
     c   03              leave
     c                   exsr      processDSPF
     c                   enddo

     c                   eval      *inLR = *On

      * ===========================================================
     c     processDSPF   begsr

      * Top field to specify the colour of the bottom field, vice versa
     c                   eval      FLDAATR = setAtr(FLDB)
     c                   eval      FLDBATR = setAtr(FLDA)
     c* Move cursor to other field
     c                   exsr      moveCursor
     c                   endsr

      * ===========================================================
     c     moveCursor    begsr

      * Determine the current cursor position
      *   if not a window, offset from screen position
      *   otherwise, offset from window position
     c                   if        wdwPos = 0
     c     scrPos        div       256           row
     c                   mvr                     col
     c                   else
     c     wdwPos        div       256           row
     c                   mvr                     col
     c                   endif

      * Now bump the cursor to the other input field
     c                   if        row = 10
     c                   eval      row = 11
     c                   else
     c                   eval      row = 10
     c                   endif
     c                   eval      col = 2

      * set up overflow limits: they differ depending on device size
      * must POST to get the display size
      *   note that the other fields in the infds are wiped
     c     pgmDev        post                    dspfDS
     c                   select

     c                   when      scrSize = (24 * 80)
24x80
     c                   eval      rowLimit = 24
     c                   eval      colLimit = 80

     c                   when      scrSize = (27 * 132)
27x132
     c                   eval      rowLimit = 27
     c                   eval      colLimit = 132

     c                   other
presume 24x80
     c                   eval      rowLimit = 24
     c                   eval      colLimit = 80

     c                   endsl

      *   handle column overflow
     c                   if        col > colLimit
     c                   eval      col = 2
     c                   eval      row = row + 1
     c                   endif
      *   handle row overflow
     c                   if        row > rowLimit
     c                   eval      row = 10
     c                   endif
     c                   endsr

      * ===========================================================
     p setAtr          b
     d setAtr          pi                  like(atr)
     d  inpFld                       50    const

     d atrWork         s                   like(atr)

      * reset all attributes
     c                   eval      atrWork = NP

     c                   select
     c                   when      inpFld = 'RI'
     c                   biton     RI            atrWork
     c                   when      inpFld = 'HI'
     c                   biton     HI            atrWork
     c                   when      inpFld = 'UL'
     c                   biton     UL            atrWork
     c                   when      inpFld = 'BL'
     c                   biton     BL            atrWork
     c                   when      inpFld = 'CS'
     c                   biton     CS            atrWork
     c                   endsl

     c                   return    atrWork

     p                 e



--
This is the RPG programming on the AS400 / iSeries (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.