59 lines
2.5 KiB
Plaintext
59 lines
2.5 KiB
Plaintext
|
$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.
|
||
|
|
|