| Tutorial - ACCEPT/DISPLAY |
This chapter contains examples and sample code to illustrate details given in earlier chapters. They should be read in conjunction with the earlier chapters, and not viewed as standalone code.
working-storage section.
01 a-screen-text.
03 cust-name-text pic x(14) value "Customer name".
03 filler pic x(20).
03 cust-number-text pic x(16) value "Customer amount".
01 a-screen-data redefines a-screen-text.
03 filler pic x(14).
03 customer-name pic x(20).
03 filler pic x(16).
03 customer-amount pic z9.9.
01 ws-customer-amount pic 99v9.
procedure division.
run-start.
move zero to customer-amount
display a-screen-text at line 12 column 1
accept a-screen-data at line 12 column 1
move customer-amount to ws-customer-amount
perform until ws-customer-amount not=zero
display "Customer amount must not be zero"
at line 25 column 1 with bell
display customer-amount at line 12 column 51
with reverse-video blink
accept a-screen-data at line 12 column 1
move customer-amount to ws-customer-amount
end-perform
stop run.
working-storage section.
01 a-field pic 9999.
procedure division.
run-start.
accept a-field
display "A-Field=" a-field
stop run.
call x"AF" using set-bit-pairs
parameter-block
where the parameters are defined as follows:
01 set-bit-pairs pic 9(2) comp-x value 1. 01 parameter-block. 03 bit-pair-setting pic 9(2) comp-x. 03 bit-map-section pic x value "2". 03 bit-pair-number pic 9(2) comp-x. 03 filler pic 9(2) comp-x value 1.
The values to be set for the fields bit-pair-setting and bit-pair-number vary according to the function you want to perform. The required values for these two parameters are given in the individual descriptions.
With all x"AF" calls, if an error occurs,set-bit-pairs is set to the value 255 on return from the call.
special-names crt status is key-status
Where key-status is a three-byte data item in the Working-Storage Section of your program with the following definition:
01 key-status. 03 key-type pic x. 03 key-code-1 pic 9(2) comp-x. 03 key-code-2 pic 9(2) comp-x.
Whenever an ACCEPT statement is executed, key-status is set to indicate how the ACCEPT was terminated. In general, the individual fields in key-status have the following uses:
| key-type | Indicates how the ACCEPT was terminated. The values returned are as
follows :
|
||||||||||||||||
| key-code-1 | Indicates the number of the key that terminated the ACCEPT operation. The exact meaning of this number depends on the value returned in key-type. | ||||||||||||||||
| key-code-2 | If key-type and key-code-1 are 0, key-code-2 contains the raw
keyboard code for the key that terminated the ACCEPT operation. Where a
sequence of keystrokes rather than a single key has been configured to
perform a single function, only the code for the first keystroke is
returned. If key-type is 4, key-code-2 contains the second byte of the character which caused the ACCEPT operation to terminate. Otherwise, the contents of key-code-2 are undefined. |
This example writes an 80-byte string of text and attributes to the screen. The text appears on the top line of the screen.
working-storage section.
01 screen-position.
03 screen-row pic 9(2) comp-x value 0.
03 screen-col pic 9(2) comp-x value 0.
01 string-length pic 9(4) comp-x value 80.
01 character-buffer pic x(80).
01 attribute-buffer pic x(80).
procedure division.
move all "x" to character-buffer
move all x"70" to attribute-buffer
call "CBL_WRITE_SCR_CHATTRS" using screen-position
character-buffer
attribute-buffer
string-length
Consider the following group item:
01 display-item. 03 display-item-1 pic x(20). 03 filler pic x(35). 03 display-item-2 pic 9(10). 03 filler pic x(105). 03 display-item-3 pic z(4)9.
If the following statement is executed:
display display-item at 0101 mode is block.
display-item is treated as if it is an elementary item defined as:
01 display-item pic x(175).
Consequently, the contents of the FILLER items are also displayed.
Click the button to start Net Express and load the demonstration project.
$set ans85
****************************************************************
* Copyright Micro Focus Limited 1994. All Rights Reserved. *
* This demonstration program is provided for use by users of *
* Micro Focus products and may be used, modified and *
* distributed as part of your application provided that you *
* properly acknowledge the copyright of Micro Focus in this *
* material. *
****************************************************************
****************************************************************
* *
* ADSAMP.CBL *
* *
* This program assumes that the default *
* configuration has been selected using Adiscf. *
****************************************************************
special-names.
cursor is cursor-position
crt status is key-status.
data division.
working-storage section.
**************************************************
* Parameters to be used for the x"AF" calls.
**************************************************
01 set-bit-pairs pic 9(2) comp-x value 1.
01 get-single-character pic 9(2) comp-x value 26.
01 enable-esc-and-f1.
03 filler pic 9(2) comp-x value 1.
03 filler pic x value "1".
03 filler pic 9(2) comp-x value 0.
03 filler pic 9(2) comp-x value 2.
01 disable-all-other-user-keys.
03 filler pic 9(2) comp-x value 0.
03 filler pic x value "1".
03 filler pic 9(2) comp-x value 2.
03 filler pic 9(2) comp-x value 126.
01 enable-slash-key.
03 filler pic 9(2) comp-x value 1.
03 filler pic x value "3".
03 filler pic x value "/".
03 filler pic 9(2) comp-x value 1.
**************************************************
* Status returned after termination of an ACCEPT.
**************************************************
01 key-status.
03 key-type pic x.
03 key-code-1 pic 9(2) comp-x.
03 key-code-1-x redefines key-code-1 pic x.
03 key-code-2 pic 9(2) comp-x.
**************************************************
* Cursor-Position is returned by ADIS containing
* the position of the cursor when the ACCEPT was
* terminated.
***************************************************
01 cursor-position.
03 cursor-row pic 99.
03 cursor-column pic 99.
**************************************************
* Work areas used by the program.
**************************************************
01 work-areas.
03 wa-name pic x(30).
03 wa-address-line-1 pic x(40).
03 wa-address-line-2 pic x(40).
03 wa-address-line-3 pic x(40).
03 wa-address-line-4 pic x(40).
03 wa-age pic 999 value 0.
01 exit-flag pic 9(2) comp-x value 0.
**************************************************
* Screen Section.
**************************************************
screen section.
01 main-screen.
03 blank screen.
03 line 2 column 27
value "Typical Data Entry Screen".
03 line 3 column 27
value "-------------------------".
03 line 5 column 1 value "name [".
03 pic x(30) using wa-name highlight prompt " ".
03 value "]".
03 line 7 column 1 value "address [".
03 pic x(40) using wa-address-line-1 highlight prompt " ".
03 value "]".
03 line 8 column 1 value " [".
03 pic x(40) using wa-address-line-2 highlight prompt " ".
03 value "]".
03 line 9 column 1 value " [".
03 pic x(40) using wa-address-line-3 highlight prompt " ".
03 value "]".
03 line 10 column 1 value " [".
03 pic x(40) using wa-address-line-4 highlight prompt " ".
03 value "]".
03 line 12 column 1 value "age [".
03 pic zz9 using wa-age highlight prompt " ".
03 value "]".
03 line 20 column 1 value
"---------------------------------------------------------
- "----------------------------------------".
03 line 21 column 1 value "f1" highlight.
03 value "=/help".
03 column 75 value "esc" highlight.
03 value "ape".
01 help-screen.
03 blank screen.
03 line 1 column 34 value "help screen".
03 line + 1 column 34 value "-----------".
03 line 4 value "escape" highlight.
03 value " leave this program.".
03 line 6 column 1 value "f1 or /h" highlight.
03 value " obtains this screen.".
03 line 8 column 1
value "use cursor keys to move around ".
03 value "the fields on the screen".
03 value "enter will".
03 line + 1 column 1 value "accept the data ".
03 value " present new blank form to fill in.".
03 line 24 column 25
value "press any key to continue ...".
**************************************************
* Procedure Division.
**************************************************
procedure division.
entry-point section.
* First we want to ensure that the keys are enabled as we want
* them. Enable the Escape and F1 keys.
call x"AF" using set-bit-pairs
enable-esc-and-f1
* disable every other user function key.
call x"AF" using set-bit-pairs
disable-all-other-user-keys
* set up "/" key to act as a function key and terminate
* the ACCEPT operation.
call x"AF" using set-bit-pairs
enable-slash-key
* Now ensure that the cursor position will be returned when an
* ACCEPT is terminated. Setting to row 1, column 1 will ensure
* that the cursor will be initially positioned at the start of
* the first field.
move 1 to cursor-row
move 1 to cursor-column
* Loop until the Escape key is pressed.
perform until exit-flag = 1
display main-screen
accept main-screen
evaluate key-type
when "0"
* The ACCEPT operation terminated normally; that is the Enter key
* was pressed. In this case, we simply blank out the work areas
* and restart in the first field.
initialize work-areas
move 1 to cursor-row
move 1 to cursor-column
when "1"
* A user function key has been pressed. This will either be
* Escape or F1 as all others have been disabled.
if key-code-1 = 0
* Escape has been pressed, so we wish to leave the program.
move 1 to exit-flag
else
* F1 has been pressed so display the help screen.
perform display-help-screen
end-if
when "3"
* A data key has terminated the ACCEPT operation. It must be "/"
* as no other keys have been enabled to do this. Now get the
* next character to see if "H" or "h" has been pressed.
call x"AF" using get-single-character
key-status
if key-type = "3" and
(key-code-1-x = "h" or
key-code-1-x = "H")
perform display-help-screen
end-if
end-evaluate
end-perform
stop run.
display-help-screen section.
* Display the help screen and then wait for a key to be pressed.
display help-screen
call x"AF" using get-single-character
key-status.
The following code changes the action of the Backspace key (key number 14) to simply move the cursor to the left (function 3), and changes the Tab key (key number 8) to perform theTab function (function 8):
* Change mapping of Backspace key
move 14 to adis-key-number
move 3 to adis-mapping-byte
call x"AF" using set-map-byte
adis-key-mapping
* Change mapping of the tab key
move 8 to adis-key-number
move 8 to adis-mapping-byte
call x"AF" using set-map-byte
adis-key-mapping
The following is an example of configuring the enhanced ACCEPT/DISPLAY syntax to terminate an ACCEPT operation.
accept data-item at 0101
if key-type="0"
if key-code-1=48
display "Terminated by return key"
else
display "Terminated by auto-skip last field"
end-if
end-if.
The following code sets up Tab and Backtab to act as function keys and the Ü and Þ keys to act as function keys if they cause the cursor to leave the field.
* Set up Tab (key 8) and Backtab (Key 9) to act as function keys
move 1 to adis-key-setting
move 8 to first-adis-key
move 2 to number-of-adis-keys
call x"AF" using set-bit-pairs
adis-key-control
* Set up cursor-left (key 3) and cursor-right (key 4) to act as
* function keys ONLY if they cause the cursor to leave the field.
move 3 to adis-key-setting
move 3 to first-adis-key
move 2 to number-of-adis-keys
call x"AF" using set-bit-pairs
adis-key-control
accept data-item at 0101
if key-type="2"
evaluate key-code-1
when 3
display "cursor-left caused the cursor to
- "leave the field"
when 4
display "cursor right caused the cursor to
- "leave the field"
when 8
display "the tab key was pressed"
when 9
display "the back tab key was pressed"
end-evaluate
end-if.
* Set up the characters "A" through "Z" to terminate the
* ACCEPT operation
move 1 to data-key-setting
move "A" to first-data-key
move 26 to number-of-data-keys
call x"AF" using set-bit-pairs
data-key-control
accept data-item at 0101
if key-type="3"
evaluate key-code-1
when 65
display "A pressed"
when 66
display "B pressed"
when 90
display "Z pressed"
end-evaluate
end-if.
The following code detects which function key is pressed, assuming that the only enabled function keys are Escape,F1 and F10:
accept data-item at 0101
if key-type="1"
evaluate key-code-1
when 0
display "escape was pressed"
when 1
display "F1 was pressed"
when 10
display "F10 was pressed"
end-evaluate
end-if.
The following is an example of how to write programs that make use of function keys. It assumes that Escape is available, but any other function key can be selected either by pressing the function key or by pressing a slash (/) followed by the first letter of the option.
$set ans85
**************************************************
* This program assumes that the default
* configuration has been selected using Adiscf.
***************************************************
special-names.
cursor is cursor-position
crt status is key-status.
data division.
working-storage section.
**************************************************
* Parameters to be used for the x"AF" calls.
**************************************************
01 set-bit-pairs pic 9(2) comp-x value 1.
01 get-single-character pic 9(2) comp-x value 26.
01 enable-esc-and-f1.
03 filler pic 9(2) comp-x value 1.
03 filler pic x value "1".
03 filler pic 9(2) comp-x value 0.
03 filler pic 9(2) comp-x value 2.
01 disable-all-other-user-keys.
03 filler pic 9(2) comp-x value 0.
03 filler pic x value "1".
03 filler pic 9(2) comp-x value 2.
03 filler pic 9(2) comp-x value 126.
01 enable-slash-key.
03 filler pic 9(2) comp-x value 1.
03 filler pic x value "3".
03 filler pic x value "/".
03 filler pic 9(2) comp-x value 1.
**************************************************
* Status returned after termination of an ACCEPT.
**************************************************
01 key-status.
03 key-type pic x.
03 key-code-1 pic 9(2) comp-x.
03 key-code-1-x redefines key-code-1 pic x.
03 key-code-2 pic 9(2) comp-x.
**************************************************
* Cursor-Position is returned by Adis containing
* the position of the cursor when the ACCEPT was
* terminated.
***************************************************
01 cursor-position.
03 cursor-row pic 99.
03 cursor-column pic 99.
**************************************************
* Work areas used by the program.
**************************************************
01 work-areas.
03 wa-name pic x(30).
03 wa-address-line-1 pic x(40).
03 wa-address-line-2 pic x(40).
03 wa-address-line-3 pic x(40).
03 wa-address-line-4 pic x(40).
03 wa-age pic 999 value 0.
01 exit-flag pic 9(2) comp-x value 0.
**************************************************
* Screen Section.
**************************************************
screen section.
01 main-screen.
03 blank screen.
03 line 2 column 27
value "Typical Data Entry Screen".
03 line 3 column 27
value "-------------------------".
03 line 5 column 1 value "name [".
03 pic x(30) using wa-name highlightprompt " ".
03 value "]".
03 line 7 column 1 value "address [".
03 pic x(40) using wa-address-line-1 highlight prompt " ".
03 value "]".
03 line 8 column 1 value " [".
03 pic x(40) using wa-address-line-2 highlight prompt " ".
03 value "]".
03 line 9 column 1 value " [".
03 pic x(40) using wa-address-line-3 highlight prompt " ".
03 value "]".
03 line 10 column 1 value " [".
03 pic x(40) using wa-address-line-4 highlight prompt " ".
03 value "]".
03 line 12 column 1 value "age [".
03 pic zz9 using wa-age highlight prompt " ".
03 value "]".
03 line 20 column 1 value
"------------------------------------
- "----------------------------------------".
03 line 21 column 1 value "f1" highlight.
03 value "=/help".
03 column 75 value "esc" highlight.
03 value "ape".
01 help-screen.
03 blank screen.
03 line 1 column 34 value "help screen".
03 line + 1 column 34 value "-----------".
03 line 4 value "escape" highlight.
03 value " leave this program.".
03 line 6 column 1 value "f1 or /h" highlight.
03 value " obtains this screen.".
03 line 8 column 1
value "use cursor keys to move around ".
03 value "the fields on the screen".
03 value "enter will".
03 line + 1 column 1 value "accept the data ".
03 value " present new blank form to fill in.".
03 line 24 column 25
value "press any key to continue ...".
**************************************************
* Procedure Division.
**************************************************
procedure division.
entry-point section.
* First we want to ensure that the keys are enabled as we want
* them. Enable the Escape and F1 keys.
call x"AF" using set-bit-pairs
enable-esc-and-f1
* disable every other user function key.
call x"AF" using set-bit-pairs
disable-all-other-user-keys
* set up "/" key to act as a function key and terminate
* the ACCEPT operation.
call x"AF" using set-bit-pairs
enable-slash-key
* Now ensure that the cursor position will be returned when an
* ACCEPT is terminated. Setting to row 1, column 1 will ensure
* that the cursor will be initially positioned at the start of
* the first field.
move 1 to cursor-row
move 1 to cursor-column
* Loop until the Escape key is pressed.
perform until exit-flag = 1
display main-screen
accept main-screen
evaluate key-type
when "0"
* The ACCEPT operation terminated normally; that is the Enter
key
* was pressed. In this case, we simply blank out the work areas
* and restart in the first field.
initialize work-areas
move 1 to cursor-row
move 1 to cursor-column
when "1"
* A user function key has been pressed. This will either be
* Escape or F1 as all others have been disabled.
if key-code-1 = 0
* Escape has been pressed, so we wish to leave the program.
move 1 to exit-flag
else
* F1 has been pressed so display the help screen.
perform display-help-screen
end-if
when "3"
* A data key has terminated the ACCEPT operation. It must be "/"
* as no other keys have been enabled to do this. Now get the
* next character to see if "H" or "h" has been pressed.
call x"AF" using get-single-character
key-status
if key-type = "3" and
(key-code-1-x = "h" or
key-code-1-x = "H")
perform display-help-screen
end-if
end-evaluate
end-perform
stop run.
display-help-screen section.
* Display the help screen and then wait for a key to be pressed.
display help-screen
call x"AF" using get-single-character
key-status.
Copyright © 2000 MERANT International Limited. All rights reserved.
This document and the proprietary marks and names
used herein are protected by international law.
| Tutorial - ACCEPT/DISPLAY |