Support COBUG |
|
 |
|
|
|
|
| |
|
COBOL Language [
return
] |
|
From |
Message |
nitkot
3/05/2006
21:46:38
|
 Subject: USING MOUSE IN MS-COBOL
Message:
I HAD BEEN DEVELOPING COMMERCIAL SOFTWARE APPLICATIONS ON PC, WINDOWS AND NOVELL BASED NETWORK ON MS-DOS SHELL. I AM USING MICROSOFT 4.5 VER OF COBOL DEVELOPED IN ALLIANCE WITH MICROFOCUS. I WANT TO KNOW HOW DO I USE MOUSE IN COBOL PROGRAMS WHICH WORKS ON DOS SHELL? CAN ANYBODY HELP ME? THANKS IN ADVANCE.
NITIN KOTHARI, MUMBAI, 9867696515
|
JWL
3/06/2006
00:19:48
| RE: USING MOUSE IN MS-COBOL
Message:
Hi NITIN
There are a few things that you need to include in the program to use a mouse.
SPECIAL-NAMES
Include various working storage areas. (Variables)
INITIALIZE the mouse.
Show mouse pointer.
SET the buttons to work as function keys.
Test for these keys in the program.
I will write a small program later today and post it to this forum as you will then get a better idea of what is required and hopefully understand the procedures.
Regards
James Lemmon
|
JWL
3/07/2006
03:04:05
| RE: USING MOUSE IN MS-COBOL
Message:
Hi Nitin,
Sorry that I did not get back to you yet. We unfortunately had power down for about 14 hours, so was unable to use my PC. Power is back on as you can see, so I will get that program written today.
Regards
James
|
JWL
3/07/2006
09:56:29
| RE: USING MOUSE IN MS-COBOL
Message:
Hi Nitin,
I have included various routines and screen messages into the program to give it more meaning.
The graphics characters (verticle and horizontal lines, corners and intersect lines are changed when I paste the program into this reply. See Ä,³, Ú, ¿, À, Ù. If you copy and paste the code into DOS edit, it should be OK.
Regards
James
000010 IDENTIFICATION DIVISION.
000020 PROGRAM-ID. MOUSEDEM.
000030 AUTHOR. J W LEMMON.
000040 DATE-WRITTEN. March 2006.
000050 ENVIRONMENT DIVISION.
000060 CONFIGURATION SECTION.
000070 SPECIAL-NAMES.
000080 CURSOR IS CSTART
000090 CONSOLE IS CRT
CRT STATUS IS KEY-STATUS.
000100 INPUT-OUTPUT SECTION.
000110 FILE-CONTROL.
000330 DATA DIVISION.
000340 FILE SECTION.
000560 WORKING-STORAGE SECTION.
000610 77 WS-S1 PIC 9(04) COMP-5.
000620 77 WS-S2 PIC 9(04) COMP-5.
000630 77 WS-S3 PIC 9(04) COMP-5.
000640 77 WS-S4 PIC 9(04) COMP-5.
77 WS-TEMP-LIN PIC 9(02) COMP-5.
77 WS-OPTION PIC X(01).
77 TODAY-DDMMYY PIC 9(08) COMP-5.
*
* T E R M I N A T O R K E Y S
*
78 NORM-TERM VALUE "0".
78 USER-FN-KEY VALUE "1".
78 ADIS-FN-KEY VALUE "2".
78 8BIT-DATA VALUE "3".
78 16BIT-DATA VALUE "4".
78 ERROR-TERM VALUE "9".
*
* A D I S F U N C T I O N K E Y S
*
78 ENTER-KEY VALUE 0.
78 CR-KEY VALUE 2.
78 LEFT-KEY VALUE 3.
78 RIGHT-KEY VALUE 4.
78 UP-KEY VALUE 5.
78 DOWN-KEY VALUE 6.
78 HOME-KEY VALUE 7.
78 TAB-KEY VALUE 8.
78 BACKTAB-KEY VALUE 9.
78 END-KEY VALUE 10.
78 BACK-SPACE VALUE 14.
78 DEL-KEY VALUE 17.
78 INS-KEY VALUE 23.
78 MOUSE-KEY VALUE 27.
*
* U S E R F U N C T I O N K E Y S
*
78 ESC-KEY VALUE 0.
78 F1-KEY VALUE 1.
78 F2-KEY VALUE 2.
78 F3-KEY VALUE 3.
78 F4-KEY VALUE 4.
78 F5-KEY VALUE 5.
78 F6-KEY VALUE 6.
78 F7-KEY VALUE 7.
78 F8-KEY VALUE 8.
78 F9-KEY VALUE 9.
78 F10-KEY VALUE 10.
78 SF1-KEY VALUE 11.
78 SF2-KEY VALUE 12.
78 SF3-KEY VALUE 13.
78 SF4-KEY VALUE 14.
78 SF5-KEY VALUE 15.
78 SF6-KEY VALUE 16.
78 SF7-KEY VALUE 17.
78 SF8-KEY VALUE 18.
78 SF9-KEY VALUE 19.
78 SF10-KEY VALUE 20.
78 CF1-KEY VALUE 21.
78 CF2-KEY VALUE 22.
78 CF3-KEY VALUE 23.
78 CF4-KEY VALUE 24.
78 CF5-KEY VALUE 25.
78 CF6-KEY VALUE 26.
78 CF7-KEY VALUE 27.
78 CF8-KEY VALUE 28.
78 CF9-KEY VALUE 29.
78 CF10-KEY VALUE 30.
78 AF1-KEY VALUE 31.
78 AF2-KEY VALUE 32.
78 AF3-KEY VALUE 33.
78 AF4-KEY VALUE 34.
78 AF5-KEY VALUE 35.
78 AF6-KEY VALUE 36.
78 AF7-KEY VALUE 37.
78 AF8-KEY VALUE 38.
78 AF9-KEY VALUE 39.
78 AF10-KEY VALUE 40.
78 ALT-1 VALUE 41.
78 ALT-2 VALUE 42.
78 ALT-3 VALUE 43.
78 ALT-4 VALUE 44.
78 ALT-5 VALUE 45.
78 ALT-6 VALUE 46.
78 ALT-7 VALUE 47.
78 ALT-8 VALUE 48.
78 ALT-9 VALUE 49.
78 ALT-0 VALUE 50.
78 ALT-HYPH VALUE 51.
78 ALT-EQUAL VALUE 52.
78 PAGE-UP VALUE 53.
78 PAGE-DOWN VALUE 54.
78 ALT-A VALUE 65.
78 ALT-B VALUE 66.
78 ALT-C VALUE 67.
78 ALT-D VALUE 68.
78 ALT-E VALUE 69.
78 ALT-F VALUE 70.
78 ALT-G VALUE 71.
78 ALT-H VALUE 72.
78 ALT-I VALUE 73.
78 ALT-J VALUE 74.
78 ALT-K VALUE 75.
78 ALT-L VALUE 76.
78 ALT-M VALUE 77.
78 ALT-N VALUE 78.
78 ALT-O VALUE 79.
78 ALT-P VALUE 80.
78 ALT-Q VALUE 81.
78 ALT-R VALUE 82.
78 ALT-S VALUE 83.
78 ALT-T VALUE 84.
78 ALT-U VALUE 85.
78 ALT-V VALUE 86.
78 ALT-W VALUE 87.
78 ALT-X VALUE 88.
78 ALT-Y VALUE 89.
78 ALT-Z VALUE 90.
78 F11-KEY VALUE 91.
78 F12-KEY VALUE 92.
78 SF11-KEY VALUE 93.
78 SF12-KEY VALUE 94.
78 CF11-KEY VALUE 95.
78 CF12-KEY VALUE 96.
78 AF11-KEY VALUE 97.
78 AF12-KEY VALUE 98.
001350 01 WS-CRT-LINES.
001380 03 WS-TOP-LNE2.
001390 05 WS-TCR PIC X(80) VALUE "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
- "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿".
001400 03 WS-TP-LINE2 REDEFINES WS-TOP-LNE2.
001410 05 FILLER PIC X(01).
001420 05 WS-TOP-COMP PIC X(40).
001430 05 FILLER PIC X(23).
05 WS-WRKHD PIC X(11).
001430 05 FILLER PIC X(01).
05 WS-WRKST PIC X(03).
001430 05 FILLER PIC X(01).
001460 03 WS-MID-LNE2.
05 FILLER PIC X(01) VALUE "³".
05 WS-BLNK78 PIC X(78) VALUE ALL "°".
05 FILLER PIC X(01) VALUE "³".
000010 01 WS-FILE-STATUS.
000020 03 WS-STATUS PIC X(02).
000030 88 RECORD-LOCKED VALUE "94" "9D".
000040 01 WS-RED-STAT REDEFINES WS-FILE-STATUS.
000050 03 WS-STAT1 PIC X(01).
000060 88 RUNTIME-ERROR VALUE "9".
03 WS-STAT1H REDEFINES WS-STAT1
PIC 9(02) COMP-X.
03 WS-STAT2 PIC X(01).
000070 03 WS-STAT2H REDEFINES WS-STAT2
PIC 9(02) COMP-X.
88 FLE-NOT-OPEN VALUE 2.
88 FLE-IN-ONLY VALUE 6.
88 DSK-SPACE VALUE 7.
88 FLE-OUT-ONLY VALUE 8.
88 FLE-IS-OPEN VALUE 12.
88 FLE-NOT-FOUND VALUE 13.
000080 88 FLE-LIMIT VALUE 14.
88 DSK-ERROR VALUE 24.
000090 88 IDX-CORRUPT VALUE 41 43.
000100 88 FLE-LOCKED VALUE 65.
000110 88 REC-LOCKED VALUE 68.
88 NET-ERROR VALUE 208.
88 COM-ERROR VALUE 209.
000120 88 TOO-MANY-LOCKS VALUE 213.
000130 01 WS-FILE-ERRORS.
000140 03 WS-ACTION PIC 9(01) VALUE ZERO.
000150 03 WS-F-ERROR PIC 9(02) COMP-5.
000160 03 WS-WAIT PIC S9(08) COMP-5.
000160 03 WS-COUNT PIC 9(02) COMP-5 VALUE 1.
000170 03 WS-LOCKED PIC 9(01) VALUE 0.
000940 03 WS-STIME PIC 9(08).
000940 03 WS-TIME PIC 9(08).
000180 03 WS-FILE.
05 WS-SHRT-FN PIC X(08).
05 FILLER PIC X(56).
03 WS-FILE-CHAR REDEFINES WS-FILE
PIC X(01) OCCURS 64.
000190 03 WS-KEY PIC Z(05)9 BLANK WHEN ZERO.
03 WS-ERR-MES.
05 FILLER PIC X(01).
05 WS-CONT.
000200 07 WS-STAT-MESSAGE
PIC X(23).
07 WS-KEYX.
09 FILLER PIC X(23) VALUE SPACES.
09 WS-ERREND
PIC X(01) VALUE SPACES.
03 WS-ERR-CHAR REDEFINES WS-ERR-MES
PIC X(01) OCCURS 48.
03 WS-ERR-STRING PIC X(32).
000930 01 WS-CONSOLE PIC 9(02) COMP-X.
01 WS-LENGTH PIC 9(08) COMP-5 VALUE 1.
01 STATUS-CODE PIC S9(04) COMP.
000210 01 WS1-CURSOR.
000220 03 CPOS PIC 9(04) VALUE ZERO.
000230 03 WS1-CURS REDEFINES CPOS.
000240 05 CLIN PIC 9(02).
000250 05 CCOL PIC 9(02).
01 SAVE-POS.
03 SAVE-LIN PIC 9(02) COMP-X VALUE ZERO.
03 SAVE-COL PIC 9(02) COMP-X VALUE ZERO.
000260 01 CSTART.
000270 03 COL-AND-LINE PIC 9(04).
01 CRT-LINE.
03 STORE-LIN PIC 9(02).
03 STORE-COL PIC 9(02).
01 CRT-DETAIL.
03 TOP-ROW PIC 9(02) COMP-X.
03 BOTTOM-ROW PIC 9(02) COMP-X.
03 STRING-LENGTH PIC 9(04) COMP-X.
03 SCREEN-POSITION.
05 SCREEN-LIN PIC 9(02) COMP-X.
05 SCREEN-COL PIC 9(02) COMP-X.
01 SCREEN-POS.
03 SLIN PIC 9(02).
03 SCOL PIC 9(02).
01 CUR-CONT.
03 CUR-ROW PIC X(01) COMP-X.
03 CUR-COL PIC X(01) COMP-X.
01 BLOCK-DETAIL.
03 ORIGINAL-VID.
05 ORIGINAL-CHAR PIC X(01) OCCURS 80.
03 REVERSE-VID.
05 REVERSE-CHAR PIC X(01) OCCURS 80.
01 SHADOW-DETAIL.
03 SHADE-ROW PIC 9(02) COMP-X.
03 SHADE-COL PIC 9(02) COMP-X.
03 SHADE-LINES PIC 9(02) COMP-X.
03 SHADE-WIDTH PIC 9(02) COMP-X.
03 SHADE-CHAR PIC X(01) VALUE X"08".
01 KEY-STATUS.
03 KEY-TYPE PIC X(01).
88 NORM-END VALUE "0".
88 USER-FUNC VALUE "1".
88 ADIS-FUNC VALUE "2".
88 DATA-8BIT VALUE "3".
88 DATA-16BIT VALUE "4".
03 KEY-CODE-1 PIC 9(02) COMP-X.
03 KEY-CODE-1X REDEFINES KEY-CODE-1
PIC X(01).
03 KEY-CODE-2 PIC 9(02) COMP-X.
*
* S C R E E N C O L O U R S
*
* 0 = BLACK
* 1 = BLUE
* 2 = GREEN
* 3 = CYAN
* 4 = RED
* 5 = MAGENTA
* 6 = BROWN / YELLOW
* 7 = WHITE
*
01 CRT-COLOURS.
03 WS-BGRND PIC 9(01) VALUE 1.
03 WS-FGRND PIC 9(01) VALUE 3.
03 WS-BGRND-1 PIC 9(01) VALUE 3.
03 WS-FGRND-1 PIC 9(01) VALUE 1.
03 WS-BGRND-2 PIC 9(01) VALUE 1.
03 WS-FGRND-2 PIC 9(01) VALUE 7.
03 WS-BGRND-3 PIC 9(01) VALUE 7.
03 WS-FGRND-3 PIC 9(01) VALUE 6.
03 WS-BGRND-4 PIC 9(01) VALUE 3.
03 WS-FGRND-4 PIC 9(01) VALUE 4.
03 WS-BGRND-5 PIC 9(01) VALUE 6.
03 WS-FGRND-5 PIC 9(01) VALUE 2.
03 WS-BGRND-6 PIC 9(01) VALUE 7.
03 WS-FGRND-6 PIC 9(01) VALUE 4.
03 WS-BGRND-7 PIC 9(01) VALUE 0.
03 WS-FGRND-7 PIC 9(01) VALUE 1.
03 WS-BGRND-8 PIC 9(01) VALUE 3.
03 WS-FGRND-8 PIC 9(01) VALUE 4.
03 WS-BGRND-9 PIC 9(01) VALUE 2.
03 WS-FGRND-9 PIC 9(01) VALUE 5.
03 WS-CCHNG PIC 9(01) VALUE 0.
03 WS-TEMPFG PIC 9(01) VALUE 0.
03 WS-TEMPBG PIC 9(01) VALUE 7.
01 X91-CALL.
03 X91-RES PIC 9(02) COMP-X.
*
* INTERPROGRAM - USING CALL X"91"
*
* 11 = SET COBOL PROGRAM SWITCHES
* 12 = READ COBOL PROGRAM SWITCHES
* 13 = SET RUN-TIME SWITCHES
* 14 = READ RUN-TIME SWITCHES
* 15 = CHECK IF A PROGRAM EXISTS
* 16 = GET NUMBER OF LINKAGE PARAMETERS
* 35 = CALL PROGRAM UNDER DOS ("4B" CALL)
* 46 = ENABLE INSERTION OF NULL CHARACTERS
* 47 = DISABLE INSERTION OF NULL CHARACTERS
* 48 = ENABLE TAB INSERTION
* 49 = DISABLE TAB INSERTION
*
03 X91-FUN PIC 9(02) COMP-X VALUE 47.
01 FILE-DETAILS.
03 FILE-SIZE PIC X(08) COMP-X.
03 FILE-DATE.
05 FILE-DAY PIC X(01) COMP-X.
05 FILE-MONTH PIC X(01) COMP-X.
05 FILE-YEAR PIC X(02) COMP-X.
03 FILE-TIME.
05 FILE-HOURS PIC X(01) COMP-X.
05 FILE-MINUTES PIC X(01) COMP-X.
05 FILE-SECONDS PIC X(01) COMP-X.
05 FILE-HUND-SECS PIC X(01) COMP-X.
000210 01 WS-MOUSE.
*
* MOUSE - USING CALL X"AF".
*
* 64 = ACTIVATE/TERMINATE MOUSE
* PARAM: 0 = Terminate, 1 = Activate.
* 66 = ENABLE/DISABLE MOUSE
* PARAM: 0 = Disable, 1 = Enable.
* 67 = GET MOUSE DETAILS.
* Returns X and Y positions
* Sets status.
*
000220 03 MOUSE-FUNC PIC 9(02) COMP-X.
000230 03 MOUSE-PARAM PIC 9(02) COMP-X.
000240 03 MOUSE-DETAILS.
000250 05 MOUSE-X PIC 9(04) COMP-X.
000250 05 MOUSE-Y PIC 9(04) COMP-X.
000250 05 MOUSE-STAT PIC 9(04) COMP-X.
03 MOUSE-ENTER PIC X(01).
01 WS-MOUSE2.
*
* MOUSE - USING CALL BY NAME
*
* The mouse status will be non zero if any call made to the
* mouse functions is unsuccessfull.
*
* CBL_INIT_MOUSE USING MOUSE-HANDLE MOUSE-BUTTONS
* RETURNING MOUSE-STATUS.
* The mouse must be initialized before any other mouse functions
* can be performed. The handle is returned in MOUSE-HANDLE while
* the number of buttons on the mouse is returned in MOUSE-BUTTONS.
*
* CBL_GET_MOUSE_MASK USING MOUSE-HANDLE EVENT-MASK
* RETURNING MOUSE-STATUS.
* This call gets the event mask -
* bit 1 to 3 = buttons 1 to 3
* bit 0 = mouse moved
*
* CBL_GET_MOUSE_POSITION USING MOUSE-HANDLE MOUSE-POS
* RETURNING MOUSE-STATUS.
* This call is used to get the row and column location of
* the mouse.
*
* CBL_GET_MOUSE_STATUS USING MOUSE-HANDLE MOUSE-EVENT
* RETURNING MOUSE-STATUS.
* This function is used to find out the number of events in the
* queue.
*
* CBL_HIDE_MOUSE USING MOUSE-HANDLE
* RETURNING MOUSE-STATUS.
* Makes the mouse pointer invisible.
*
* CBL_READ_MOUSE_EVENT USING MOUSE-HANDLE EVENT-DATA READ-TYPE
* RETURNING MOUSE-STATUS.
* Reads the mouse event queue and returns information about
* an event.
* READ-TYPE = 0. If no events, returns imediately with zero
* values.
* = 1. Return is delayed until an event has been
* queued.
*
* CBL_SET_MOUSE_MASK USING MOUSE-HANDLE EVENT-MASK
* RETURNING MOUSE-STATUS.
* Set the mouse event mask.
*
* CBL_SET_MOUSE_POSITION USING MOUSE-HANDLE MOUSE-POS
* RETURNING MOUSE-STATUS.
* Move mouse pointer to position specified.
*
* CBL_SHOW_MOUSE USING MOUSE-HANDLE MOUSE-POS
* RETURNING MOUSE-STATUS.
* Make the mouse pointer visible.
*
* CBL_TERM_MOUSE USING MOUSE-HANDLE
* RETURNING MOUSE-STATUS.
* Terminate mouse support.
*
* PC_GET_MOUSE_SHAPE USING MOUSE-HANDLE
* RESEVERD-ITEM
* MOUSE-PTR-SHAPE
* RETURNING MOUSE-STATUS.
* Get the shape of the mouse pointer. (bit map)
*
* PC_SET_MOUSE_HIDE_AREA USING MOUSE-HANDLE
* COLLISION-AREA
* RETURNING MOUSE-STATUS.
* Defines the area where the mouse is to be invisible.
*
* PC_SET_MOUSE_SHAPE USING MOUSE-HANDLE
* RESEVERD-ITEM
* MOUSE-PTR-SHAPE
* RETURNING MOUSE-STATUS.
* Set the shape of the mouse pointer.
*
03 MOUSE-HANDLE PIC X(04) COMP-X.
03 MOUSE-EVENT PIC X(02) COMP-X.
03 MOUSE-POS.
05 MOUSE-ROW PIC X(02) COMP-X.
05 MOUSE-COL PIC X(02) COMP-X.
03 MOUSE-BUTTONS PIC X(02) COMP-X.
03 MOUSE-STATUS PIC S9(04) COMP.
03 COLLISION-AREA.
05 TOP-LIN PIC X(02) COMP-X.
05 LEFT-COL PIC X(02) COMP-X.
05 BOTTOM-LIN PIC X(02) COMP-X.
05 RIGHT-COL PIC X(02) COMP-X.
03 MOUSE-PTR-SHAPE.
05 CHAR-AND-MASK PIC X(01) COMP-X.
05 ATTR-AND-MASK PIC X(01) COMP-X.
05 CHAR-XOR-MASK PIC X(01) COMP-X.
05 ATTR-XOR-MASK PIC X(01) COMP-X.
03 EVENT-DATA.
05 EVENT-TYPE PIC X(02) COMP-X.
05 EVENT-TIME PIC X(02) COMP-X.
05 EVENT-ROW PIC X(02) COMP-X.
05 EVENT-COL PIC X(02) COMP-X.
03 RESERVED-ITEM PIC X(10).
03 READ-TYPE PIC X(01) COMP-X.
03 MOUSE-ATTACHED PIC X(01) VALUE "N".
88 MOUSE VALUE "Y".
88 NO-MOUSE VALUE "N".
01 SCREEN-GRAPHICS.
*
* DECIMAL CODES USING THE ALTERNATE KEY AND NUMERIC KEY PAD
* ÉÍÍÍÍËÍÍÍÑÍÍÍÑÍÍÍÑÍÍÍÑÍÍÍÑÍÍÍÑÍÍÍÑÍÍÍÑÍÍÍÑÍÍÍ»
* ºPREFº 0 ³ 1 ³ 2 ³ 3 ³ 4 ³ 5 ³ 6 ³ 7 ³ 8 ³ 9 º
* ÌÍÍÍÍÎÍÍÍØÍÍÍØÍÍÍØÍÍÍØÍÍÍØÍÍÍØÍÍÍØÍÍÍØÍÍÍØÍÍ͹
* º 17 º ³ ³ ³ ³ ³ ³ ° ³ ± ³ ² ³ ³ º
* ÇÄÄÄÄ×ÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄĶ
* º 18 º ´ ³ µ ³ ¶ ³ · ³ ¸ ³ ¹ ³ º ³ » ³ ¼ ³ ½ º
* ÇÄÄÄÄ×ÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄĶ
* º 19 º ¾ ³ ¿ ³ À ³ Á ³ Â ³ Ã ³ Ä ³ Å ³ Æ ³ Ç º
* ÇÄÄÄÄ×ÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄĶ
* º 20 º È ³ É ³ Ê ³ Ë ³ Ì ³ Í ³ Î ³ Ï ³ Ð ³ Ñ º
* ÇÄÄÄÄ×ÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄÄÅÄÄĶ
* º 21 º Ò ³ Ó ³ Ô ³ Õ ³ Ö ³ × ³ Ø ³ Ù ³ Ú ³ Û º
* ÈÍÍÍÍÊÍÍÍÏÍÍÍÏÍÍÍÏÍÍÍÏÍÍÍÏÍÍÍÏÍÍÍÏÍÍÍÏÍÍÍÏÍÍͼ
000110 03 WS-G1 PIC X(01) VALUE "Í".
000120 03 WS-G2 PIC X(01) VALUE "Ñ".
000130 03 WS-G3 PIC X(01) VALUE "³".
000140 03 WS-G4 PIC X(01) VALUE "Ï".
000150 03 WS-G5 PIC X(01) VALUE "Ë".
000160 03 WS-G6 PIC X(01) VALUE "º".
000170 03 WS-G7 PIC X(01) VALUE "Ê".
000180 03 WS-G8 PIC X(01) VALUE "Ä".
000190 03 WS-G9 PIC X(01) VALUE "Ú".
000200 03 WS-G10 PIC X(01) VALUE "¿".
000210 03 WS-G11 PIC X(01) VALUE "À".
000220 03 WS-G12 PIC X(01) VALUE "Ù".
000230 03 WS-G13 PIC X(01) VALUE "µ".
000240 03 WS-G14 PIC X(01) VALUE "Æ".
000250 03 WS-G15 PIC X(01) VALUE "É".
000260 03 WS-G16 PIC X(01) VALUE "»".
000270 03 WS-G17 PIC X(01) VALUE "È".
000280 03 WS-G18 PIC X(01) VALUE "¼".
03 WS-G19 PIC X(01) VALUE "°".
03 WS-G20 PIC X(01) VALUE "±".
03 WS-G21 PIC X(01) VALUE "²".
03 WS-G22 PIC X(01) VALUE "Û".
03 WS-BACKGROUND PIC X(80) VALUE ALL "°".
01 BLOCK-DETAIL1.
03 ORIGINAL-VID1.
05 ORIGINAL-CHAR1 PIC X(01) OCCURS 80.
03 REVERSE-VID1.
05 REVERSE-CHAR1 PIC X(01) OCCURS 80.
01 SHADOW-DETAIL1.
03 SHAD1-ROW PIC 9(02) COMP-X.
03 SHAD1-COL PIC 9(02) COMP-X.
03 SHAD1-LINES PIC 9(02) COMP-X.
03 SHAD1-WIDTH PIC 9(02) COMP-X.
03 SHAD1-CHAR PIC X(01).
01 CRT-DETAIL1.
03 TOP-ROW1 PIC 9(02) COMP-X.
03 BOTTOM-ROW1 PIC 9(02) COMP-X.
03 STRING-LENGTH1 PIC 9(04) COMP-X.
03 SCREEN-POSITION1.
05 SCREEN-LIN1 PIC 9(02) COMP-X.
05 SCREEN-COL1 PIC 9(02) COMP-X.
01 BLOCK-DETAIL2.
03 ORIGINAL-VID2.
05 ORIGINAL-CHAR2 PIC X(01) OCCURS 80.
03 REVERSE-VID2.
05 REVERSE-CHAR2 PIC X(01) OCCURS 80.
01 SHADOW-DETAIL2.
03 SHAD2-ROW PIC 9(02) COMP-X.
03 SHAD2-COL PIC 9(02) COMP-X.
03 SHAD2-LINES PIC 9(02) COMP-X.
03 SHAD2-WIDTH PIC 9(02) COMP-X.
03 SHAD2-CHAR PIC X(01).
01 CRT-DETAIL2.
03 TOP-ROW2 PIC 9(02) COMP-X.
03 BOTTOM-ROW2 PIC 9(02) COMP-X.
03 STRING-LENGTH2 PIC 9(04) COMP-X.
03 SCREEN-POSITION2.
05 SCREEN-LIN2 PIC 9(02) COMP-X.
05 SCREEN-COL2 PIC 9(02) COMP-X.
01 SET-BIT-PAIRS PIC 9(02) COMP-X VALUE 1.
01 GET-SINGLE-CHAR PIC 9(02) COMP-X VALUE 26.
*
* ACTION : 1 = CONTROL USER FUNCTION KEYS
*
* SETTING 0 = DISABLE
* 1 = ENABLE
* NUMBER = NUMBER OF FIRST USER KEY
* KEYS = NUMBER OF CONSECUTIVE KEYS
*
* SETTING 1 = STANDARD USER FUNCTION KEY LIST
* 2 = COMPATIBILITY KEY LIST
* NUMBER = 87
* KEYS = 1
*
* 2 = CONTROL ADIS KEY MAPPINGS
*
* SETTING 0 = DISABLE KEYS
* 1 = ENABLE
* 2 = NORMAL ACTION
* 3 = NORMAL ACTION UNLESS CURSOR
* LEAVES CURRENT FIELD
* NUMBER = NUMBER OF FIRST ADIS KEY
* KEYS = NUMBER OF CONSECUTIVE KEYS
*
* SETTING 0 = PRE-DISPLAY FIXED-FORMAT
* NUMERIC/NUM EDITED
* 1 = NUMERIC AND FIXED-FORMAT
* NUM EDITED FIELDS PRE-DISPLAYED
* 2 = PRE-DISPLAY FIELD WHEN CURSOR
* MOVED TO IT
* 3 = ALL FIELDS IN ACCEPT ARE
* PRE-DISPLAYED.
* NUMBER = 76
* KEYS = 1
*
* SETTING 0 = INDICATOR DISPLAYED IF NECCESSARY
* 3 = INDICATOR IS NEVER DISPLAYED
* NUMBER = 56 INSERT/REPLACE IND
* = 57 END OF FIELD IND
* = 58 AUTOCLEAR IND
* KEYS = 1
*
* SETTING 0 = ERROR MESSAGES NEVER DISPLAYED
* BELL IS RUNG
* 1 = MESSAGES NEVER DISPLAYED
* BELL IS RUNG FOR INVALID NUMERIC
* 2 = MESSAGES DISPLAYED
* INVALID NUMERIC NOT REPORTED
* 3 = MESSAGES DISPLAYED
* BELL RUNG FOR INVALID NUMERIC
* NUMBER = 44
* KEYS = 1
*
01 USER-KEY-CONTROL.
03 USER-SETTING PIC 9(02) COMP-X.
03 USER-ACTION PIC X(01) VALUE "2".
03 USER-NUMBER PIC 9(02) COMP-X.
03 USER-KEYS PIC 9(02) COMP-X VALUE 1.
003170 01 W12-DATE.
003180 03 W12-TODAY PIC 9(08).
003190 03 W12-DATE-DMY REDEFINES W12-TODAY.
003200 05 W12-DAY PIC 9(02).
003210 05 W12-MONTH PIC 9(02).
05 W12-CENT PIC 9(02).
003220 05 W12-YEAR PIC 9(02).
001510 01 W20-DATE.
001520 03 W20-DAY PIC 9(02).
001530 03 W20-MONTH PIC 9(02).
03 W20-CENT PIC 9(02).
001540 03 W20-YEAR PIC 9(02).
001550 01 W20-DTE1 REDEFINES W20-DATE.
001560 03 W20-DTE PIC 9(08).
001550 01 W20-DTE2 REDEFINES W20-DATE.
03 W20-CC PIC 9(02).
001520 03 W20-YY PIC 9(02).
001530 03 W20-MM PIC 9(02).
001540 03 W20-DD PIC 9(02).
01 W20-LEAP REDEFINES W20-DATE.
03 FILLER PIC 9(04).
03 W20-CY PIC 9(04).
001570 01 W25-CALCS.
001580 03 W25-RESULT PIC 9(09)V99.
001590 03 W25-RESULT1 REDEFINES W25-RESULT.
001600 05 W25-DAYS PIC 9(03).
001610 05 W25-WHOLE PIC 9(06).
001620 05 W25-DECIMAL PIC 9(02).
03 W25-RESULT2 REDEFINES W25-RESULT.
05 FILLER PIC 9(02).
05 W25-KEY PIC 9(04).
05 W25-SUB PIC 9(01).
05 FILLER PIC 9(02).
001630 03 W25-PASS.
001640 05 W25-PASS1 PIC 9(03).
001650 05 W25-PASS2 PIC 9(03).
001660 03 W25-TIME PIC 9(08).
001670 03 W25-TRED REDEFINES W25-TIME.
001680 05 FILLER PIC 9(02).
001690 05 W25-FACT PIC 9(06).
05 W25-DATE REDEFINES W25-FACT.
07 W25-YY PIC 9(02).
07 W25-MM PIC 9(02).
07 W25-DD PIC 9(02).
03 W25-CUR-CC PIC 9(02) COMP-5.
03 W25-PRV-CC PIC 9(02) COMP-5.
03 W25-NXT-CC PIC 9(02) COMP-5.
001810 01 W40-BINARY.
001820 03 W40-BIN.
001830 05 W40-DEC PIC 9(02) COMP-X.
001840 03 W40-HEX REDEFINES W40-BIN.
001850 05 W40-CHAR PIC X(01).
03 W40-N1 PIC 9(02) COMP-X.
03 W40-N2 PIC 9(02) COMP-X.
03 W40-SWITCH PIC 9(02) COMP-X.
01 W41-SAVE.
03 W41-LENGTH PIC 9(04) COMP-X VALUE 2000.
03 W41-START PIC 9(04) COMP-X VALUE 1.
03 W41-BUFFER PIC 9(04) COMP-X VALUE 1.
01 W42-ATTRIB.
03 FILLER PIC X(2000).
01 W42-ATTRIB2.
03 W42-LINES OCCURS 25.
05 W42-BYTE OCCURS 80.
07 W42-CHAR PIC 9(02) COMP-X.
01 W42-ATTRIB3.
03 FILLER PIC X(2000).
01 W42-ATTRIB4.
03 W42-LINE OCCURS 25.
05 W42-BTE OCCURS 80.
07 W42-CHR PIC 9(02) COMP-X.
01 W43-SCREEN.
03 FILLER PIC X(2000).
004400 01 W43-SCREEN2.
03 FILLER PIC X(2000).
01 W43-SCREEN3.
03 FILLER PIC X(2000).
01 W44-FUNCTION PIC 9(02) COMP-X.
/
000750 SCREEN SECTION.
*
* **** THIS SCREEN - CLEARS THE DISPLAY AND SETS THE DEFAULT
* COLOUR TO 3 (LIGHT BLUE).
*
001950 01 CLR-SCREEN.
003170 03 BLANK SCREEN FOREGROUND-COLOR 3
BACKGROUND-COLOR 1.
03 CLR-L1-2.
003860 05 LINE 1 COLUMN 1 BACKGROUND-COLOR 0
PIC X(80) USING WS-TOP-LNE2.
05 LINE 1 COLUMN 47 BACKGROUND-COLOR 0
VALUE "´".
05 COLUMN 48 FOREGROUND-COLOR 6 HIGHLIGHT
BACKGROUND-COLOR 0
PIC Z9/99/9999 USING TODAY-DDMMYY.
05 COLUMN 58 BACKGROUND-COLOR 0
VALUE "Ã".
003870 05 LINE 2 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
05 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
003920 05 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
003930 03 LINE 3 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
003940 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
003950 03 LINE 4 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
003960 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
003970 03 LINE 5 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
003980 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
003990 03 LINE 6 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
004000 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
004010 03 LINE 7 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
004020 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
004030 03 LINE 8 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
004040 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
004050 03 LINE 9 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
004060 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
004070 03 LINE 10 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
004080 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
004090 03 LINE 11 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
004100 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
004110 03 LINE 12 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
004120 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
004130 03 LINE 13 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
004140 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
004150 03 LINE 14 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
004160 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
004170 03 LINE 15 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
004180 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
004190 03 LINE 16 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
004200 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
004210 03 LINE 17 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
004220 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
004230 03 LINE 18 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
004240 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
004250 03 LINE 19 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
004260 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
004270 03 LINE 20 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
004280 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
004290 03 LINE 21 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
004300 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
004310 03 LINE 22 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
004320 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
004330 03 LINE 23 COLUMN 1 BACKGROUND-COLOR 0
VALUE "³".
03 COLUMN 2 PIC X(78) FROM WS-BACKGROUND.
004340 03 COLUMN 80 BACKGROUND-COLOR 0
VALUE "³".
006550 03 LINE 24 COLUMN 1 BACKGROUND-COLOR 0
VALUE "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
- "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ".
03 CLEAR-L25.
05 LINE 25 BLANK LINE BACKGROUND-COLOR 3
FOREGROUND-COLOR 1.
01 MENU-INSTRUCT.
03 LINE 25 COLUMN 2 BACKGROUND-COLOR 3
FOREGROUND-COLOR 1
VALUE "Use ".
03 COLUMN 6 HIGHLIGHT
BACKGROUND-COLOR 3
FOREGROUND-COLOR 6
VALUE "".
03 COLUMN 7 BACKGROUND-COLOR 3
FOREGROUND-COLOR 1
VALUE " or ".
03 COLUMN 11 HIGHLIGHT
BACKGROUND-COLOR 3
FOREGROUND-COLOR 6
VALUE "".
03 COLUMN 12 BACKGROUND-COLOR 3
FOREGROUND-COLOR 1
VALUE " to point to an item, and ".
03 COLUMN 38 HIGHLIGHT
BACKGROUND-COLOR 3
FOREGROUND-COLOR 6
VALUE "<Enter>".
03 COLUMN 45 BACKGROUND-COLOR 3
FOREGROUND-COLOR 1
VALUE " to Select ".
03 COLUMN 56 HIGHLIGHT
BACKGROUND-COLOR 3
FOREGROUND-COLOR 6
VALUE "<Esc>".
03 COLUMN 61 BACKGROUND-COLOR 3
FOREGROUND-COLOR 1
VALUE " to Exit".
01 S01.
001450 03 LINE 2 COLUMN 30 BACKGROUND-COLOR 1
FOREGROUND-COLOR 7 HIGHLIGHT
001460 VALUE "MOUSE DEMONSTRATION MENU".
01 S02.
03 LINE 4 COLUMN 7 BACKGROUND-COLOR 2
FOREGROUND-COLOR 0
VALUE "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿".
03 LINE 5 COLUMN 7 BACKGROUND-COLOR 2
FOREGROUND-COLOR 0
VALUE "³ ".
03 COLUMN 10 BACKGROUND-COLOR 2
FOREGROUND-COLOR 7
HIGHLIGHT
VALUE "DEMO MOUSE MENU".
03 COLUMN 25 BACKGROUND-COLOR 2
FOREGROUND-COLOR 0
VALUE " ³".
03 LINE 6 COLUMN 7 BACKGROUND-COLOR 2
FOREGROUND-COLOR 0
VALUE "³ ".
03 COLUMN 9 BACKGROUND-COLOR 2
FOREGROUND-COLOR 7
HIGHLIGHT
VALUE "1".
03 COLUMN 10 BACKGROUND-COLOR 2
FOREGROUND-COLOR 0
VALUE " Option one ³".
001470 03 LINE 7 COLUMN 7 BACKGROUND-COLOR 2
FOREGROUND-COLOR 0
VALUE "³ ".
03 COLUMN 9 BACKGROUND-COLOR 2
FOREGROUND-COLOR 7
HIGHLIGHT
VALUE "2".
03 COLUMN 10 BACKGROUND-COLOR 2
FOREGROUND-COLOR 0
VALUE " Option two ³".
001470 03 LINE 8 COLUMN 7 BACKGROUND-COLOR 2
FOREGROUND-COLOR 0
VALUE "³ ".
03 COLUMN 9 BACKGROUND-COLOR 2
FOREGROUND-COLOR 7
HIGHLIGHT
VALUE "3".
03 COLUMN 10 BACKGROUND-COLOR 2
FOREGROUND-COLOR 0
VALUE " Option three ³".
001470 03 LINE 9 COLUMN 7 BACKGROUND-COLOR 2
FOREGROUND-COLOR 0
VALUE "³ ".
03 COLUMN 9 BACKGROUND-COLOR 2
FOREGROUND-COLOR 7
HIGHLIGHT
VALUE "4".
03 COLUMN 10 BACKGROUND-COLOR 2
FOREGROUND-COLOR 0
VALUE " Option four ³".
001570 03 LINE 10 COLUMN 7 BACKGROUND-COLOR 2
FOREGROUND-COLOR 0
VALUE "³ ".
03 COLUMN 9 BACKGROUND-COLOR 2
FOREGROUND-COLOR 7
HIGHLIGHT
VALUE "5".
03 COLUMN 10 BACKGROUND-COLOR 2
FOREGROUND-COLOR 0
VALUE " Option five ³".
001570 03 LINE 11 COLUMN 7 BACKGROUND-COLOR 2
FOREGROUND-COLOR 0
VALUE "³ ".
03 COLUMN 9 BACKGROUND-COLOR 2
FOREGROUND-COLOR 7
HIGHLIGHT
VALUE "0".
03 COLUMN 10 BACKGROUND-COLOR 2
FOREGROUND-COLOR 0
VALUE " Exit ³".
03 LINE 12 COLUMN 7 BACKGROUND-COLOR 2
FOREGROUND-COLOR 0
VALUE "ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ".
01 ERROR-LINE.
03 COLUMN 16 BACKGROUND-COLOR 4
FOREGROUND-COLOR 4 HIGHLIGHT
VALUE "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ".
03 COLUMN 65 BACKGROUND-COLOR 4 FOREGROUND-COLOR 0
VALUE "¿".
004880 03 LINE + 1 COLUMN 16 BACKGROUND-COLOR 4
FOREGROUND-COLOR 4 HIGHLIGHT
VALUE "³".
03 COLUMN 17 BACKGROUND-COLOR 4
FOREGROUND-COLOR 7 HIGHLIGHT
PIC X(48) FROM WS-ERR-MES.
03 COLUMN 65 BACKGROUND-COLOR 4 FOREGROUND-COLOR 0
VALUE "³".
03 LINE + 1 COLUMN 16 BACKGROUND-COLOR 4
FOREGROUND-COLOR 4 HIGHLIGHT
VALUE "À".
03 COLUMN 17 BACKGROUND-COLOR 4 FOREGROUND-COLOR 0
VALUE "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ".
01 OPT-LINE.
03 COLUMN 16 BACKGROUND-COLOR 3
FOREGROUND-COLOR 3 HIGHLIGHT
VALUE "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ".
03 COLUMN 65 BACKGROUND-COLOR 3 FOREGROUND-COLOR 0
VALUE "¿".
004880 03 LINE + 1 COLUMN 16 BACKGROUND-COLOR 3
FOREGROUND-COLOR 3 HIGHLIGHT
VALUE "³".
03 COLUMN 17 BACKGROUND-COLOR 3
FOREGROUND-COLOR 6 HIGHLIGHT
PIC X(48) FROM WS-ERR-MES.
03 COLUMN 65 BACKGROUND-COLOR 3 FOREGROUND-COLOR 0
VALUE "³".
03 LINE + 1 COLUMN 16 BACKGROUND-COLOR 3
FOREGROUND-COLOR 3 HIGHLIGHT
VALUE "À".
03 COLUMN 17 BACKGROUND-COLOR 3 FOREGROUND-COLOR 0
VALUE "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ".
01 S99.
03 COLUMN 24 BACKGROUND-COLOR 3
FOREGROUND-COLOR 3 HIGHLIGHT
VALUE "ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ".
03 COLUMN 55 BACKGROUND-COLOR 3 FOREGROUND-COLOR 0
VALUE "¿".
004880 03 LINE + 1 COLUMN 24 BACKGROUND-COLOR 3
FOREGROUND-COLOR 3 HIGHLIGHT
VALUE "³".
03 COLUMN 25 BACKGROUND-COLOR 3
FOREGROUND-COLOR 1
000830 VALUE "Correct ".
03 COLUMN 33 BACKGROUND-COLOR 3
FOREGROUND-COLOR 6 HIGHLIGHT
004890 VALUE "ENTER".
03 COLUMN 38 BACKGROUND-COLOR 3
FOREGROUND-COLOR 1
VALUE " - ".
03 COLUMN 41 BACKGROUND-COLOR 3
FOREGROUND-COLOR 6 HIGHLIGHT
VALUE "N".
03 COLUMN 42 BACKGROUND-COLOR 3
FOREGROUND-COLOR 1
VALUE " if incorrect".
03 COLUMN 55 BACKGROUND-COLOR 3 FOREGROUND-COLOR 0
VALUE "³".
03 LINE + 1 COLUMN 24 BACKGROUND-COLOR 3
FOREGROUND-COLOR 3 HIGHLIGHT
VALUE "À".
03 COLUMN 25 BACKGROUND-COLOR 3 FOREGROUND-COLOR 0
VALUE "ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ".
PROCEDURE DIVISION.
AA000 SECTION.
AA00.
PERFORM ZA000-INIT.
005370 DISPLAY CLR-SCREEN.
DISPLAY S01.
PERFORM BA000.
* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
* ³ D E - A C T I V A T E M O U S E ³
* ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
IF MOUSE-ATTACHED = "Y"
MOVE 66 TO MOUSE-FUNC
MOVE 0 TO MOUSE-PARAM
CALL X"AF" USING MOUSE-FUNC
MOUSE-PARAM.
013140 AA99.
013150 STOP RUN.
/ *************************************************************
* **** ROUTINES TO HANDLE VARIOUS FUNCTIONS FOR THE
* S C R E E N , K E Y B O A R D & M O U S E
* *************************************************************
* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
* ³ SAVE-SCREEN /-2/-3 and RESTORE-SCREEN /-2/-3 ³
* ÆÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͵
* ³ SCREEN-SHADOW ³
* ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
* ³ To routine is used to display a shadow down the right and ³
* ³ along the bottom of a pop-up box. The parameters that are ³
* ³ required: ³
* ³ SHADE-ROW - Top line of the box + 1. ³
* ³ SHADE-COL - Left line of box + 2. ³
* ³ SHADE-WIDTH - Width of the box - 2. ³
* ³ SHADE-LINES - Hight of box - 1. ³
* ÆÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͵
* ³ CHECK-CORRECT ³
* ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
* ³ This routine displays a pop-up window with the message ³
* ³ "Correct ENTER - N if incorrect" ³
* ³ ³
* ³ The response is returned in WS-OPTION (in upper case). ³
* ³ ³
* ³ To start with the pop-up window higher or lower than row ³
* ³ 13 (default); move another value to SLIN and PERFORM ³
* ³ CHECK-SETUP THRU CHECK-EXIT. ³
* ÆÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͵
* ³ ERROR-MESSAGE ³
* ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
* ³ To display an error message with " - Press ANY key" at ³
* ³ the end; use PERFORM ERROR-MESSAGE. ³
* ³ ³
* ³ To display just the error message; use PERFORM ³
* ³ ERROR-LENGTH THRU ERROR-EXIT. ³
* ³ ³
* ³ To display the error message higher or lower (default is ³
* ³ line 13) firstly use PERFORM ERROR-SETUP THRU ERROR-POS ³
* ³ or PERFORM ERROR-LENGTH THRU ERROR-POS. Move the line ³
* ³ number to be used to SLIN and then PERFORM ERROR-DISPLAY ³
* ³ THRU ERROR-EXIT. ³
* ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
CRT-KBD-MOUSE SECTION.
*
* **** S C R E E N A T T R I B U T E S
*
SAVE-ATTRIB.
CALL "CBL_READ_SCR_ATTRS" USING SAVE-POS
W42-ATTRIB
W41-LENGTH
RETURNING WS-STATUS.
SCREEN-ATTRIBUTES-4.
CALL "CBL_READ_SCR_ATTRS" USING SAVE-POS
W42-ATTRIB4
W41-LENGTH
RETURNING WS-STATUS.
RESTORE-ATTRIB.
MOVE 2000 TO W41-LENGTH.
CALL "CBL_WRITE_SCR_ATTRS" USING SAVE-POS
W42-ATTRIB4
W41-LENGTH
RETURNING WS-STATUS.
SCREEN-CONTENTS.
CALL "CBL_CLEAR_SCR" USING X"20" X"00"
RETURNING WS-STATUS.
SAVE-SCREEN.
CALL "CBL_READ_SCR_CHATTRS" USING SAVE-POS
W43-SCREEN
W42-ATTRIB
W41-LENGTH
RETURNING WS-STATUS.
SAVE-SCREEN-2.
CALL "CBL_READ_SCR_CHATTRS" USING SAVE-POS
W43-SCREEN2
W42-ATTRIB2
W41-LENGTH
RETURNING WS-STATUS.
SAVE-SCREEN-3.
CALL "CBL_READ_SCR_CHATTRS" USING SAVE-POS
W43-SCREEN3
W42-ATTRIB3
W41-LENGTH
RETURNING WS-STATUS.
RESTORE-SCREEN.
MOVE 2000 TO W41-LENGTH.
CALL "CBL_WRITE_SCR_CHATTRS" USING SAVE-POS
W43-SCREEN
W42-ATTRIB
W41-LENGTH
RETURNING WS-STATUS.
RESTORE-SCREEN-2.
MOVE 2000 TO W41-LENGTH.
CALL "CBL_WRITE_SCR_CHATTRS" USING SAVE-POS
W43-SCREEN2
W42-ATTRIB2
W41-LENGTH
RETURNING WS-STATUS.
RESTORE-SCREEN-3.
MOVE 2000 TO W41-LENGTH.
CALL "CBL_WRITE_SCR_CHATTRS" USING SAVE-POS
W43-SCREEN3
W42-ATTRIB3
W41-LENGTH
RETURNING WS-STATUS.
POSITION-MOUSE.
MOVE 67 TO MOUSE-FUNC.
CALL X"AF" USING MOUSE-FUNC MOUSE-DETAILS.
MOVE SCREEN-COL TO STORE-LIN
STORE-COL.
SUBTRACT 2 FROM STORE-LIN.
ADD STRING-LENGTH TO STORE-COL.
IF NOT (MOUSE-Y < TOP-ROW OR > BOTTOM-ROW)
IF NOT (MOUSE-X < STORE-LIN OR > STORE-COL)
IF MOUSE-Y = SCREEN-LIN
MOVE "Y" TO MOUSE-ENTER
ELSE
PERFORM CLEAR-BLOCK
MOVE MOUSE-Y
TO SCREEN-LIN
PERFORM SAVE-ATTR
PERFORM MARK-BLOCK.
MOVE-BLOCK-UP.
PERFORM CLEAR-BLOCK.
IF SCREEN-LIN > TOP-ROW
SUBTRACT 1 FROM SCREEN-LIN
ELSE
MOVE BOTTOM-ROW TO SCREEN-LIN.
PERFORM SAVE-ATTR.
PERFORM MARK-BLOCK.
MOVE-BLOCK-DOWN.
PERFORM CLEAR-BLOCK.
IF SCREEN-LIN < BOTTOM-ROW
ADD 1 TO SCREEN-LIN
ELSE
MOVE TOP-ROW TO SCREEN-LIN.
PERFORM SAVE-ATTR.
PERFORM MARK-BLOCK.
CLEAR-BLOCK.
CALL "CBL_WRITE_SCR_ATTRS" USING SCREEN-POSITION
ORIGINAL-VID
STRING-LENGTH.
MARK-BLOCK.
CALL "CBL_WRITE_SCR_ATTRS" USING SCREEN-POSITION
REVERSE-VID
STRING-LENGTH.
SAVE-ATTR.
CALL "CBL_READ_SCR_ATTRS" USING SCREEN-POSITION
ORIGINAL-VID
STRING-LENGTH.
PERFORM SET-UP-REVERSE-VID
VARYING WS-S1 FROM 1 BY 1
UNTIL WS-S1 > STRING-LENGTH.
SET-UP-REVERSE-VID.
MOVE ORIGINAL-CHAR (WS-S1)
TO W40-CHAR.
MOVE ZERO TO W40-N1 W40-N2.
IF W40-DEC > 127
SUBTRACT 128 FROM W40-DEC
ADD 8 TO W40-N2.
IF W40-DEC > 63
SUBTRACT 64 FROM W40-DEC
ADD 4 TO W40-N2.
IF W40-DEC > 31
SUBTRACT 32 FROM W40-DEC
ADD 2 TO W40-N2.
IF W40-DEC > 15
SUBTRACT 16 FROM W40-DEC
ADD 1 TO W40-N2.
IF W40-DEC > 7
SUBTRACT 8 FROM W40-DEC
ADD 128 TO W40-N1.
IF W40-DEC > 3
SUBTRACT 4 FROM W40-DEC
ADD 64 TO W40-N1.
IF W40-DEC > 1
SUBTRACT 2 FROM W40-DEC
ADD 32 TO W40-N1.
IF W40-DEC > 0
SUBTRACT 1 FROM W40-DEC
ADD 16 TO W40-N1.
ADD W40-N1 W40-N2 GIVING W40-DEC.
MOVE W40-CHAR TO REVERSE-CHAR (WS-S1).
SCREEN-SHADOW.
CALL "CBL_READ_SCR_ATTRS" USING SAVE-POS
W42-ATTRIB4
W41-LENGTH
RETURNING WS-STATUS.
ADD SHADE-COL SHADE-WIDTH
GIVING WS-S2.
ADD 1 WS-S2 GIVING WS-S3.
ADD SHADE-LINES SHADE-ROW
GIVING WS-S4.
PERFORM SET-UP-SHADOW-VERT
VARYING WS-S1 FROM SHADE-ROW BY 1
UNTIL WS-S1 = WS-S4.
PERFORM SET-UP-SHADOW-HOR
VARYING WS-S2 FROM SHADE-COL BY 1
UNTIL WS-S2 > WS-S3.
CALL "CBL_WRITE_SCR_ATTRS" USING SAVE-POS
W42-ATTRIB4
W41-LENGTH
RETURNING WS-STATUS.
SET-UP-SHADOW-VERT.
MOVE SHADE-CHAR TO W42-CHR (WS-S1, WS-S2)
W42-CHR (WS-S1, WS-S3).
SET-UP-SHADOW-HOR.
MOVE SHADE-CHAR TO W42-CHR (WS-S1, WS-S2).
MESSAGE-INST.
DISPLAY CLEAR-L25.
001020 DISPLAY "Use " AT 2524 WITH BACKGROUND-COLOR 3
FOREGROUND-COLOR 1
" " WITH FOREGROUND-COLOR 6 HIGHLIGHT
BACKGROUND-COLOR 3
001030 " to move the message window"
WITH BACKGROUND-COLOR 3
FOREGROUND-COLOR 1.
HIDE-THE-CURSOR.
MOVE 255 TO CUR-ROW CUR-COL.
CALL "CBL_SET_CSR_POS" USING CUR-CONT
RETURNING WS-STATUS.
DISPLAY-THE-CURSOR.
MOVE 25 TO CUR-ROW.
MOVE 01 TO CUR-COL.
CALL "CBL_SET_CSR_POS" USING CUR-CONT
RETURNING WS-STATUS.
CHECK-CORRECT SECTION.
CHECK-POS.
MOVE 13 TO SLIN.
CHECK-SETUP.
MOVE SPACE TO WS-OPTION.
MOVE 54 TO SCOL.
PERFORM SAVE-SCREEN.
CHECK-DISPLAY.
ADD 1 SLIN GIVING SHADE-ROW.
MOVE 26 TO SHADE-COL.
MOVE 30 TO SHADE-WIDTH.
MOVE 2 TO SHADE-LINES.
DISPLAY S99 AT LINE SLIN.
PERFORM SCREEN-SHADOW.
PERFORM MESSAGE-INST.
CHECK-REPLY.
ADD 1 TO SLIN.
PERFORM HIDE-THE-CURSOR.
CALL X"AF" USING GET-SINGLE-CHAR, KEY-STATUS.
IF ADIS-FUNC
EVALUATE KEY-CODE-1
WHEN UP-KEY
PERFORM RESTORE-SCREEN
IF SLIN > 3
SUBTRACT 2 FROM SLIN
ELSE
MOVE 2 TO SLIN
END-IF
GO TO CHECK-DISPLAY
WHEN DOWN-KEY
PERFORM RESTORE-SCREEN
IF SLIN > 21
MOVE 21 TO SLIN
END-IF
GO TO CHECK-DISPLAY
WHEN ENTER-KEY GO TO CHECK-UPPER
WHEN OTHER CALL X"E5"
END-EVALUATE
GO TO CHECK-REPLY
ELSE
IF DATA-8BIT
MOVE KEY-CODE-1X TO WS-OPTION.
CHECK-UPPER.
CALL "CBL_TOUPPER" USING WS-OPTION
BY VALUE WS-LENGTH
RETURNING WS-STATUS.
PERFORM DISPLAY-THE-CURSOR.
PERFORM RESTORE-SCREEN.
CHECK-EXIT.
EXIT.
* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
* ³ OPT-MESSAGE ³
* ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´
* ³ This routine is used to allow the OPERATOR to respond to ³
* ³ a request for an option, so that the correct action can ³
* ³ be performed by the program. The routine will display the ³
* ³ message in a pop-up window and allow the OPERATOR to ³
* ³ respond to the 'question'. ³
* ³ ³
* ³ The option request must be placed in WS-ERR-MES and may ³
* ³ not exceed 48 characters. The message will be centred in ³
* ³ the window. An example of a message request follows: ³
* ³ ³
* ³ MOVE "Print transactions (Y/N) [ ]" TO WS-ERR-MES. ³
* ³ PERFORM OPT-MESSAGE. ³
* ³ ³
* ³ This would be displayed as: ³
* ³ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ³
* ³ ³ Print transactions (Y/N) [ ] ³°° ³
* ³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ°° ³
* ³ °°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° ³
* ³ ³
* ³ The response is returned in WS-OPTION (in upper case). ³
* ³ ³
* ³ To display the request message higher or lower (default ³
* ³ is line 13) move the line number to be used to SLIN and ³
* ³ then PEFORM OPT-SETUP THRU OPT-EXIT. ³
* ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
OPT-MESSAGE SECTION.
OPT-CURSOR.
MOVE 13 TO SLIN.
OPT-SETUP.
MOVE 64 TO SCOL.
MOVE 48 TO WS-S1.
* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
* ³ Calculate the LENGTH of the MESSAGE ³
* ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
OPT-LOOP.
IF WS-ERR-CHAR (WS-S1) = SPACE
SUBTRACT 1 FROM WS-S1
GO TO OPT-LOOP.
SUBTRACT WS-S1 FROM 48
GIVING WS-COUNT.
IF WS-COUNT < 3
MOVE WS-S1 TO WS-COUNT
GO TO OPT-POS.
DIVIDE 2 INTO WS-COUNT.
SUBTRACT WS-COUNT FROM 48
GIVING WS-S2.
MOVE WS-S2 TO WS-COUNT.
* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
* ³ Center the message in the DISPLAY WINDOW ³
* ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
OPT-CENTRE.
MOVE WS-ERR-CHAR (WS-S1)
TO WS-ERR-CHAR (WS-S2).
MOVE SPACE TO WS-ERR-CHAR (WS-S1).
IF WS-S1 > 1
SUBTRACT 1 FROM WS-S1 WS-S2
GO TO OPT-CENTRE.
OPT-POS.
PERFORM SAVE-SCREEN.
OPT-DISPLAY.
ADD 1 SLIN GIVING SHADE-ROW.
MOVE 18 TO SHADE-COL.
MOVE 48 TO SHADE-WIDTH.
MOVE 2 TO SHADE-LINES.
DISPLAY OPT-LINE AT LINE SLIN.
PERFORM SCREEN-SHADOW.
PERFORM MESSAGE-INST.
OPT-REPLY.
ADD 1 TO SLIN.
IF WS-ERR-CHAR (WS-COUNT) = "]"
SUBTRACT 1 FROM WS-COUNT
ADD 16 WS-COUNT GIVING SCOL
DISPLAY WS-ERR-CHAR (WS-COUNT) AT SCREEN-POS
WITH FOREGROUND-COLOR 7 HIGHLIGHT
BACKGROUND-COLOR 5
ADD 1 TO WS-COUNT.
PERFORM HIDE-THE-CURSOR.
OPT-ACCEPT.
CALL X"AF" USING GET-SINGLE-CHAR, KEY-STATUS.
IF ADIS-FUNC
EVALUATE KEY-CODE-1
WHEN UP-KEY
PERFORM RESTORE-SCREEN
IF SLIN > 3
SUBTRACT 2 FROM SLIN
ELSE
MOVE 2 TO SLIN
END-IF
GO TO OPT-DISPLAY
WHEN DOWN-KEY
PERFORM RESTORE-SCREEN
IF SLIN > 21
MOVE 21 TO SLIN
END-IF
GO TO OPT-DISPLAY
WHEN ENTER-KEY GO TO OPT-END
WHEN OTHER CALL X"E5"
END-EVALUATE
GO TO OPT-REPLY
ELSE
IF DATA-8BIT
MOVE KEY-CODE-1X TO WS-OPTION.
CALL "CBL_TOUPPER" USING WS-OPTION
BY VALUE WS-LENGTH
RETURNING WS-STATUS.
OPT-END.
PERFORM DISPLAY-THE-CURSOR.
PERFORM RESTORE-SCREEN.
OPT-EXIT.
EXIT.
*
* **** T H I S R O U T I N E I S U S E D T O
* D I S P L A Y E R R O R M E S S A G E S
*
* ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ
* To display an error message with " - Press ANY key" at
* the end; use PERFORM ERROR-MESSAGE.
*
* To display just the error message; use PERFORM
* ERROR-LENGTH THRU ERROR-EXIT.
*
* To display the error message higher or lower (default is
* line 13) firstly use PERFORM ERROR-SETUP THRU ERROR-POS
* or PERFORM ERROR-LENGTH THRU ERROR-POS. Move the line
* number to be used to SLIN and then PERFORM ERROR-DISPLAY
* THRU ERROR-EXIT.
*
ERROR-MESSAGE SECTION.
ERROR-SETUP.
MOVE SPACES TO WS-ERR-MES.
STRING WS-ERR-STRING DELIMITED BY " "
" - Press ANY key" DELIMITED SIZE
INTO WS-ERR-MES.
ERROR-LENGTH.
MOVE SPACE TO WS-OPTION
MOVE 48 TO WS-S1.
* FIND THE LENGTH OF THE MESSAGE
ERROR-LOOP.
IF WS-ERR-CHAR (WS-S1) = SPACE
SUBTRACT 1 FROM WS-S1
GO TO ERROR-LOOP.
SUBTRACT WS-S1 FROM 48
GIVING WS-COUNT.
IF WS-COUNT < 3
GO TO ERROR-POS.
DIVIDE 2 INTO WS-COUNT.
SUBTRACT WS-COUNT FROM 48
GIVING WS-S2.
* CENTRE THE MESSAGE IN THE DISPLAY WINDOW
ERROR-CENTRE.
MOVE WS-ERR-CHAR (WS-S1)
TO WS-ERR-CHAR (WS-S2).
MOVE SPACE TO WS-ERR-CHAR (WS-S1).
IF WS-S1 > 1
SUBTRACT 1 FROM WS-S1 WS-S2
GO TO ERROR-CENTRE.
ERROR-POS.
MOVE 13 TO SLIN.
MOVE 64 TO SCOL.
PERFORM SAVE-SCREEN.
ERROR-DISPLAY.
ADD 1 SLIN GIVING SHADE-ROW.
MOVE 18 TO SHADE-COL.
MOVE 48 TO SHADE-WIDTH.
MOVE 2 TO SHADE-LINES.
DISPLAY ERROR-LINE AT LINE SLIN.
PERFORM SCREEN-SHADOW.
PERFORM MESSAGE-INST.
ERROR-REPLY.
ADD 1 TO SLIN.
PERFORM HIDE-THE-CURSOR.
CALL X"AF" USING GET-SINGLE-CHAR, KEY-STATUS.
IF ADIS-FUNC
EVALUATE KEY-CODE-1
WHEN UP-KEY
PERFORM RESTORE-SCREEN
IF SLIN > 3
SUBTRACT 2 FROM SLIN
ELSE
MOVE 2 TO SLIN
END-IF
GO TO ERROR-DISPLAY
WHEN DOWN-KEY
PERFORM RESTORE-SCREEN
IF SLIN > 21
MOVE 21 TO SLIN
END-IF
GO TO ERROR-DISPLAY
WHEN ENTER-KEY GO TO ERROR-END
WHEN OTHER CALL X"E5"
END-EVALUATE
GO TO ERROR-REPLY
ELSE
IF DATA-8BIT
MOVE KEY-CODE-1X TO WS-OPTION.
CALL "CBL_TOUPPER" USING WS-OPTION
BY VALUE WS-LENGTH
RETURNING WS-STATUS.
ERROR-END.
PERFORM DISPLAY-THE-CURSOR.
PERFORM RESTORE-SCREEN.
ERROR-EXIT.
EXIT.
*
* **** E R A S E S C R E E N F R O M S P E C I F I E D
* L O C A T I O N
*
000010 ERASE-SCREEN SECTION.
000030 ERASE-SCREEN-LOOP.
002130 DISPLAY "³" AT CPOS WITH BACKGROUND-COLOR 0
FOREGROUND-COLOR 3
WS-BLNK78 WITH FOREGROUND-COLOR 3
"³" WITH BACKGROUND-COLOR 0
FOREGROUND-COLOR 3.
000050 ADD 1 TO CLIN.
000070 ERASE-SCREEN-EXIT.
000080 EXIT.
BA000 SECTION.
BA00.
MOVE 5 TO SHADE-ROW.
MOVE 9 TO SHADE-COL.
MOVE 20 TO SHADE-WIDTH.
MOVE 8 TO SHADE-LINES.
DISPLAY S02.
DISPLAY MENU-INSTRUCT.
PERFORM SCREEN-SHADOW.
BA02.
MOVE 5 TO TOP-ROW.
MOVE 10 TO BOTTOM-ROW.
MOVE 4 TO SCREEN-LIN.
MOVE 9 TO SCREEN-COL.
MOVE 18 TO STRING-LENGTH.
PERFORM SAVE-ATTR.
BA05.
CALL X"AF" USING GET-SINGLE-CHAR, KEY-STATUS.
BA10.
IF ADIS-FUNC
EVALUATE KEY-CODE-1
WHEN UP-KEY PERFORM MOVE-BLOCK-UP
WHEN DOWN-KEY PERFORM MOVE-BLOCK-DOWN
WHEN MOUSE-KEY PERFORM POSITION-MOUSE
IF MOUSE-ENTER = "Y"
MOVE "N" TO MOUSE-ENTER
GO TO BA15
END-IF
IF MOUSE-Y = 24
IF MOUSE-X = 5
MOVE 5 TO KEY-CODE-1
GO TO BA10
ELSE
IF MOUSE-X = 10
MOVE 6 TO KEY-CODE-1
GO TO BA10
ELSE
IF MOUSE-X > 36 AND < 44
MOVE 0 TO KEY-CODE-1
GO TO BA10
ELSE
IF MOUSE-X > 54 AND < 60
MOVE 0 TO KEY-CODE-1
MOVE 1 TO KEY-TYPE
GO TO BA10
END-IF
END-IF
WHEN ENTER-KEY GO TO BA15
WHEN OTHER CALL X"E5"
END-EVALUATE
GO TO BA05
ELSE
IF USER-FUNC
EVALUATE KEY-CODE-1
WHEN ESC-KEY
MOVE "0" TO WS-OPTION
GO TO BA18
WHEN OTHER CALL X"E5"
END-EVALUATE
GO TO BA05
ELSE
IF DATA-8BIT
MOVE KEY-CODE-1X TO WS-OPTION
CALL "CBL_TOUPPER" USING WS-OPTION
BY VALUE WS-LENGTH
RETURNING WS-STATUS
IF (WS-OPTION < 0 OR > 5) AND
(WS-OPTION NOT = "S")
CALL X"E5"
GO TO BA05
END-IF
GO TO BA16
ELSE
CALL X"E5"
GO TO BA05.
BA15.
IF SCREEN-LIN < 5
CALL X"E5"
GO TO BA05
ELSE
IF SCREEN-LIN = 5
MOVE "1" TO WS-OPTION
ELSE
IF SCREEN-LIN = 6
MOVE "2" TO WS-OPTION
ELSE
IF SCREEN-LIN = 7
MOVE "3" TO WS-OPTION
ELSE
IF SCREEN-LIN = 8
MOVE "4" TO WS-OPTION
ELSE
IF SCREEN-LIN = 9
MOVE "5" TO WS-OPTION
ELSE
IF SCREEN-LIN = 10
MOVE "0" TO WS-OPTION.
GO TO BA18.
BA16.
PERFORM CLEAR-BLOCK.
IF WS-OPTION = "0" OR "S"
MOVE 10 TO SCREEN-LIN
ELSE
IF WS-OPTION = "1"
MOVE 5 TO SCREEN-LIN
ELSE
IF WS-OPTION = "2"
MOVE 6 TO SCREEN-LIN
ELSE
IF WS-OPTION = "3"
MOVE 7 TO SCREEN-LIN
ELSE
IF WS-OPTION = "4"
MOVE 8 TO SCREEN-LIN
ELSE
IF WS-OPTION = "5"
MOVE 9 TO SCREEN-LIN.
PERFORM SAVE-ATTR.
PERFORM MARK-BLOCK.
BA18.
IF WS-OPTION = "0"
GO TO BA999.
PERFORM SAVE-SCREEN.
MOVE BLOCK-DETAIL TO BLOCK-DETAIL1.
MOVE SHADOW-DETAIL TO SHADOW-DETAIL1.
MOVE CRT-DETAIL TO CRT-DETAIL1.
IF WS-OPTION = "1"
PERFORM CA000
ELSE
IF WS-OPTION = "2"
PERFORM DA000
ELSE
IF WS-OPTION = "3"
PERFORM EA000
ELSE
IF WS-OPTION = "4"
PERFORM FA000
ELSE
IF WS-OPTION = "5"
PERFORM GA000.
PERFORM RESTORE-SCREEN.
MOVE BLOCK-DETAIL1 TO BLOCK-DETAIL.
MOVE SHADOW-DETAIL1 TO SHADOW-DETAIL.
MOVE CRT-DETAIL1 TO CRT-DETAIL.
GO TO BA05.
BA999.
EXIT.
*
* **** O P T I O N O N E O N M E N U
* Demo of option message
*
CA000 SECTION 50.
CA00.
MOVE "Option 1 - Press C to continue [ ]"
TO WS-ERR-MES.
PERFORM OPT-MESSAGE.
023600 IF NOT (WS-OPTION = "C")
023610 GO TO CA00.
CA999.
EXIT.
*
* **** O P T I O N T W O O N M E N U
* Demo of error message (ERROR MESSAGE)
*
DA000 SECTION 50.
DA00.
MOVE "Option 2" TO WS-ERR-STRING.
003260 PERFORM ERROR-MESSAGE.
DA999.
EXIT.
*
* **** O P T I O N T H R E E O N M E N U
* Demo of error message (ERROR-LENGTH)
*
EA000 SECTION 50.
EA00.
MOVE "Option 3 (message only)"
TO WS-ERR-STRING.
003260 PERFORM ERROR-LENGTH THRU ERROR-EXIT.
EA999.
EXIT.
*
* **** O P T I O N F O U R O N M E N U
*
FA000 SECTION 50.
FA00.
MOVE "Option 4 - Press N for next [ ]"
TO WS-ERR-MES.
PERFORM OPT-MESSAGE.
023600 IF NOT (WS-OPTION = "N")
023610 GO TO FA00.
FA999.
EXIT.
*
* **** O P T I O N F I V E O N M E N U
*
GA000 SECTION 50.
GA00.
MOVE "Option 5 - Press R to return [ ]"
TO WS-ERR-MES.
PERFORM OPT-MESSAGE.
023600 IF NOT (WS-OPTION = "R")
023610 GO TO GA00.
GA999.
EXIT.
/
038140 ZA000-INIT SECTION 90.
038150 ZA000-OPEN.
038160 PERFORM ZA60.
MOVE W12-TODAY TO TODAY-DDMMYY.
* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
* ³ S e t u p t h e F U N C T I O N k e y s ³
* ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
MOVE 1 TO USER-ACTION
USER-SETTING.
* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
* ³ ESC, F1 to F10 keys ³
* ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
MOVE ZERO TO USER-NUMBER.
MOVE 11 TO USER-KEYS.
CALL X"AF" USING SET-BIT-PAIRS, USER-KEY-CONTROL.
* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
* ³ PAGE-UP and PAGE-DOWN keys ³
* ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
MOVE 53 TO USER-NUMBER.
MOVE 2 TO USER-KEYS.
CALL X"AF" USING SET-BIT-PAIRS, USER-KEY-CONTROL.
* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
* ³ A C T I V A T E M O U S E ³
* ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
MOVE 64 TO MOUSE-FUNC.
MOVE 1 TO MOUSE-PARAM.
CALL X"AF" USING MOUSE-FUNC
MOUSE-PARAM.
IF MOUSE-FUNC NOT = 255
MOVE "Y" TO MOUSE-ATTACHED
ELSE
GO TO ZA999.
* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
* ³ Set MOUSE key to act as FUNCTION key ³
* ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
MOVE 3 TO USER-ACTION.
MOVE 27 TO USER-NUMBER.
MOVE 2 TO USER-KEYS.
CALL X"AF" USING SET-BIT-PAIRS, USER-KEY-CONTROL.
039770 GO TO ZA999.
*
* **** S E T U P T H E S C R E E N G R A P H I C S
*
040090 ZA60.
* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
* ³ DATE RETURNS A SIX DIGIT RESULT AS YYMMDD. W25-FACT IS ³
* ³ DEFINED AS YYMMDD. THESE DETAILS ARE THEN MOVED TO ³
* ³ W12-TODAY (DDMMCCYY) AND THE CENTURY (20) IS INSERTED. ³
* ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
ACCEPT W25-FACT FROM DATE.
MOVE W25-YY TO W12-YEAR.
MOVE W25-MM TO W12-MONTH.
MOVE W25-DD TO W12-DAY.
* ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
* ³ T H I S I F S T A T E M E N T W A S U S E D T O ³
* ³ H A N D L E T H E M I L L E N I U M S W I T C H ³
* ³ O V E R. ³
* ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
* IF W25-YY < 50
* MOVE 20 TO W12-CENT
* ELSE
* MOVE 19 TO W12-CENT.
MOVE 20 TO W12-CENT.
040650 MOVE "This program demo's Mouse/Shadows etc"
TO WS-TOP-COMP.
040750 ZA999.
040760 EXIT.
|
| |
| P 1 Next Page >> | | | |
|
|
|
[ Go to Top of Page ]
|
|
|
|
Local COBOL User Groups |
Check out the list of local COBOL user groups from around the world and join a user group near you.
|
|
|
Call for User Group Leaders! |
Get Involved! We are looking for user group
leaders to help organize and coordinate a local COBOL user group.
|
|
|
Join COBUG! |
Become a part of the COBUG community today.
Join Now ...
|
|
|
COBOL Forums |
Try our forums for help!
Let the COBUG members help you.
Post your issues!
|
|
|
COBOL Job Resources |
Here are references to a wealth of
job resources, including job listing sites, resume preparation, and interview questions.
|
|
|
Job and Resume Matchmaker! |
Employers submit your COBOL job openings.
Job seekers submit your resumes.
|
|
|
