|
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 mailing list archive is Copyright 1997-2025 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.
