dos_compilers/Microsoft Cobol v5/SAMPLES/SSCNTRL.CBL
2024-06-30 15:35:16 -07:00

59 lines
2.5 KiB
COBOL

$set ans85 noosvs mf
*****************************************************************
* *
* (C) Micro Focus Ltd. 1989 *
* *
* SSCNTRL.CBL *
* *
* Demonstration of the use of dynamic attributes in screen *
* section. This example shows how to use the CONTROL clause *
* in a screen section to indicate invalid fields after an *
* accept statement. Monochrome terminal users can also see *
* the use of attribute strings to set reverse video; color *
* terminal users can "uncomment" the line changing colors to *
* view the use of attribute strings to set colors. *
*****************************************************************
working-storage section.
01 field1 pic x(4) value spaces.
01 field2 pic x(4) value spaces.
01 field3 pic x(4) value spaces.
01 attr-string pic X(50).
78 ws-reverse-video value 'reverse-video'.
78 ws-highlight value 'highlight'.
78 ws-blink value 'blink'.
78 ws-red-on-white value 'foreground-color 4 background-color 7'.
screen section.
01 blank-screen blank screen.
01 screen-1.
05 line 3 col 15
value 'Fill the fields with data'.
05 line 6 col 20 value 'Field 1 : '.
05 pic xxxx using field1 auto-skip full required.
05 line 8 col 20 value 'Field 2 : '.
05 pic xxxx using field2
control attr-string auto-skip full required.
05 line 10 col 20 value 'Field 3 : '.
05 pic xxxx using field3 required.
01 error-screen.
05 line 24 col 10
value 'Field 2 must contain ''9999'' to terminate'.
procedure division.
display blank-screen
perform until field2 = '9999'
display screen-1
accept screen-1
if field2 not = '9999'
display error-screen
******* move ws-red-on-white to attr-string
move ws-reverse-video to attr-string
end-if
end-perform.
stop run.