Scribd
Upload
131 views

Menu Com Chain em Cobol

The document defines variables and constants used to track keyboard input and screen position for a COBOL program. It includes variables for keyboard codes, screen coordinates, and strings to display for different menu options. The program uses a loop to get keyboard input and perform actions like moving the cursor or calling other programs based on the key pressed and current screen position.

Uploaded by

Rogério Moraes de Aguiar
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
131 views

Menu Com Chain em Cobol

The document defines variables and constants used to track keyboard input and screen position for a COBOL program. It includes variables for keyboard codes, screen coordinates, and strings to display for different menu options. The program uses a loop to get keyboard input and perform actions like moving the cursor or calling other programs based on the key pressed and current screen position.

Uploaded by

Rogério Moraes de Aguiar
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 3

IDENTIFICATION DIVISION.

DATA DIVISION.
WORKING-STORAGE SECTION.
01 get-single-char pic 9(2) comp-x value 26.
01 key-status.
05 key-type pic x.
05 key-code-1 pic 9(2) comp-x.
05 key-code-2 pic 9(2) comp-x.

78 user-fn-key value "1".


78 adis-fn-key value "2".
78 f1-key value 1.
78 f2-key value 2.
78 f3-key value 3.
78 f4-key value 4.

78 carriage-return value 0.
78 ws-esquerda value 3.
78 ws-direita value 4.
78 up-arrow value 5.
78 down-arrow value 6.

01 wlncl-ant.
03 wlin-a pic 99.
03 wcol-a pic 99.

01 wlncl.
03 wlin pic 99.
03 wcol pic 99.

01 reverse-vid pic x(15) value all x"70".


01 black-and-white pic x(15) value all x"07".
01 screen-position.
05 screen-row pic 9(2) comp-x.
05 screen-col pic 9(2) comp-x.
01 string-length pic 9(4) comp-x value 15.

SCREEN SECTION.
COPY "C:\COBOL\CUSTOS\CNH900.SCR".
PROCEDURE DIVISION.
PF00.
DISPLAY spaces AT 0101
DISPLAY G-CNH900.
MOVE 18 TO WLIN
MOVE 19 TO WCOL.
PERFORM pf-esquerda THRU pf-exit.

which-key-loop.
call x"af" using get-single-char
key-status
evaluate key-type
when adis-fn-key
evaluate key-code-1
when ws-esquerda
when ws-direita PERFORM pf-direita THRU pf-exit
when up-arrow PERFORM pf-sobe THRU pf-exit
when down-arrow PERFORM pf-desce THRU pf-exit
when carriage-return PERFORM pf-efetiva THRU pf-exit
when other call x"e5"
end-evaluate
end-evaluate.

GO which-key-loop.

pf-sobe.
MOVE wlncl TO wlncl-ant
IF wlin < 13
THEN MOVE 18 TO wlin
ELSE SUBTRACT 1 FROM wlin.

GO pf-mostra.

pf-desce.
MOVE wlncl TO wlncl-ant
IF wlin > 17
THEN MOVE 12 TO wlin
ELSE ADD 1 TO wlin.

GO pf-mostra.

pf-direita.
MOVE wlncl TO wlncl-ant
IF wcol > 19
THEN MOVE 19 TO wcol
ELSE MOVE 53 TO wcol.

GO pf-mostra.

pf-esquerda.
MOVE wlncl TO wlncl-ant
IF wcol = 19
THEN MOVE 53 TO wcol
ELSE MOVE 19 TO wcol.

GO pf-mostra.

pf-mostra.
COMPUTE screen-row = (wlin - 1)
COMPUTE screen-col = wcol

DISPLAY " " AT wlncl

perform mark-block.

COMPUTE screen-row = (wlin-a - 1)


COMPUTE screen-col = wcol-a

perform clear-block

IF wlncl = "1219" DISPLAY "Digitar ordem coleta ..." AT 2203.


IF wlncl = "1319" DISPLAY "Montar controle ... " AT 2203.
IF wlncl = "1419" DISPLAY "Digitar conhecimento ..." AT 2203.
IF wlncl = "1519" DISPLAY "Montar manifesto ... " AT 2203.
IF wlncl = "1619" DISPLAY "conhecimento ... " AT 2203.
IF wlncl = "1719" DISPLAY "manifesto ... " AT 2203.
IF wlncl = "1819" DISPLAY "pre-conhecimento ... " AT 2203.
IF wlncl = "1253" DISPLAY "tabela precos ... " AT 2203.
IF wlncl = "1353" DISPLAY "cadastros ... " AT 2203.
IF wlncl = "1453" DISPLAY "Incoporar novos clientes" AT 2203.
IF wlncl = "1553" DISPLAY "manifestos ... " AT 2203.
IF wlncl = "1653" DISPLAY "impressora ... " AT 2203.
IF wlncl = "1753" DISPLAY "tela ... " AT 2203.
IF wlncl = "1853" DISPLAY "Finalizar programa ... " AT 2203.

GO pf-exit.

mark-block.
call "CBL_WRITE_SCR_ATTRS" using screen-position
reverse-vid
string-length.
clear-block.
call "CBL_WRITE_SCR_ATTRS" using screen-position
black-and-white
string-length.

pf-efetiva.
IF wlncl = "1219" CHAIN "C:\COBOL\CUSTOS\BIN\CNH001".

IF wlncl = "1319" CHAIN "C:\COBOL\CUSTOS\BIN\CNH002".

IF wlncl = "1419" CHAIN "C:\COBOL\CUSTOS\BIN\CNH013".

IF wlncl = "1519" CHAIN "C:\COBOL\CUSTOS\BIN\CNH014".

IF wlncl = "1619" CHAIN "C:\COBOL\CUSTOS\BIN\CNH017".


IF wlncl = "1719" DISPLAY "manifesto" AT 2001.
IF wlncl = "1819" CHAIN "C:\COBOL\CUSTOS\BIN\CNH025".

IF wlncl = "1253" CHAIN "C:\COBOL\CUSTOS\BIN\CNH901".

IF wlncl = "1353" CHAIN "C:\COBOL\CUSTOS\BIN\CNH902".


IF wlncl = "1453" CHAIN "C:\COBOL\CUSTOS\BIN\CNH023".
IF wlncl = "1553" DISPLAY "manifestos " AT 2001.
IF wlncl = "1653" DISPLAY "impressora " AT 2001.
IF wlncl = "1753" DISPLAY "tela " AT 2001.
IF wlncl = "1853" GO pf-fim.
GO pf-mostra.

pf-fim.
DISPLAY SPACES AT 0101
STOP RUN.

pf-exit.
EXIT.

You might also like