× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.



> 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




As an Amazon Associate we earn from qualifying purchases.

This thread ...

Follow-Ups:
Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.