Paco_Diaz
9 de noviembre de 2022, 13:47
Buenas.
Después de haber dado la vara con colores, editores de pantalla y demás, he conseguido hacer una utilidad, que creo que es bastante interesante para cuando alguien quiera sacar un texto centrado en la fila 23 (o la que se quiera retocando el código) rodeado por un cuadro simple (o doble también retocando el código), y quiero compartirla.
La he realizado en rm/cobol-85, compilada y ejecutada en un sobremesa con windows xp en modo texto, pero supongo que se podrá adaptar a otros entornos.
He intentado documentarla con comentarios, explicando qué hace cada cosa en cada momento, incluyendo una ayuda visual en forma de regla en la fila 25 para comprobar que todo funciona correctamente, y que se puede desactivar.
Como ayuda alternativa, he creado un sistema de variables con combinaciones de colores, que, por sus nombres, ayudan a la hora de programar, y que se pueden usar en otros programas (las combinaciones me han hecho aprender bastante sobre qué colores se pueden usar, y cuales son las restricciones.
Es un subprograma que he llamado mensaje.cbl, y que para llamarla se hace desde cualquier punto de un programa se hace de la siguiente manera:
Se define una variable que se llama mensaje pic x(55)
Se le asigna como contenido el texto que queremos displayar en la fila 23 (procurar no escribir 2 espacios en blanco consecutivos, porque de lo contrario, no funcionará correctamente
Se le llama con CALL "MENSAJE" USING MENSAJE
Y voilá
Este es el código:
IDENTIFICATION DIVISION.
PROGRAM-ID. MENSAJE.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
******** Colores
****** Amarillo sobre Azul
01 COL-AMA-AZU.
02 pic x(40) value "FCOLOR=BROWN, BCOLOR=BLUE".
****** Amarillo sobre Gris
01 COL-AMA-BLA.
02 pic x(40) value "FCOLOR=BROWN, BCOLOR=WHITE".
****** Amarillo sobre Cyan
01 COL-AMA-CYA.
02 pic x(40) value "FCOLOR=BROWN, BCOLOR=CYAN".
****** Amarillo sobre Gris
01 COL-AMA-GRI.
02 pic x(40) value "FCOLOR=BROWN, BCOLOR=WHITE".
****** Amarillo sobre Magenta
01 COL-AMA-MAG.
02 pic x(40) value "FCOLOR=BROWN, BCOLOR=MAGENTA".
****** Amarillo sobre Negro
01 COL-AMA-NEG.
02 pic x(40) value "FCOLOR=BROWN, BCOLOR=BLACK LOW".
****** Amarillo sobre Rojo
01 COL-AMA-ROJ.
02 pic x(40) value "FCOLOR=BROWN, BCOLOR=RED".
****** Amarillo sobre Verde
01 COL-AMA-VER.
02 pic x(40) value "FCOLOR=BROWN, BCOLOR=GREEN".
****** Azul sobre Azul
01 COL-AZU-AZU.
02 pic x(40) value "FCOLOR=BLUE, BCOLOR=BLUE".
****** Azul sobre Blanco
01 COL-AZU-BLA.
02 pic x(40) value "FCOLOR=BLUE, BCOLOR=WHITE".
****** Azul sobre Magenta
01 COL-AZU-MAG.
02 pic x(40) value "FCOLOR=BLUE, BCOLOR=MAGENTA".
****** Azul sobre Negro
01 COL-AZU-NEG.
02 pic x(40) value "FCOLOR=BLUE, BCOLOR=BLACK".
****** Azul sobre Verde
01 COL-AZU-VER.
02 pic x(40) value "FCOLOR=BLUE, BCOLOR=GREEN".
****** Blanco sobre Azul
01 COL-BLA-AZU.
02 pic x(40) value "FCOLOR=WHITE, BCOLOR=BLUE".
****** Blanco sobre Gris
01 COL-BLA-GRI.
02 pic x(40) value "FCOLOR=WHITE, BCOLOR=WHITE".
****** Blanco sobre Cyan
01 COL-BLA-CYA.
02 pic x(40) value "FCOLOR=WHITE, BCOLOR=CYAN".
****** Blanco sobre Magenta
01 COL-BLA-MAG.
02 pic x(40) value "FCOLOR=WHITE, BCOLOR=MAGENTA".
****** Blanco sobre Negro
01 COL-BLA-NEG.
02 pic x(40) value "FCOLOR=WHITE, BCOLOR=BLACK LOW".
****** Blanco sobre Rojo
01 COL-BLA-ROJ.
02 pic x(40) value "FCOLOR=WHITE, BCOLOR=RED".
****** Blanco sobre Verde
01 COL-BLA-VER.
02 pic x(40) value "FCOLOR=WHITE, BCOLOR=GREEN".
****** Cyan sobre Blanco
01 COL-CYA-BLA.
02 pic x(40) value "FCOLOR=CYAN, BCOLOR=WHITE".
****** Cyan sobre Negro
01 COL-CYA-NEG.
02 pic x(40) value "FCOLOR=CYAN, BCOLOR=BLACK".
****** Cyan sobre Rojo
01 COL-CYA-ROJ.
02 pic x(40) value "FCOLOR=CYAN, BCOLOR=RED".
****** Cyan sobre Verde
01 COL-CYA-VER.
02 pic x(40) value "FCOLOR=CYAN, BCOLOR=GREEN".
****** Gris sobre Azul, AÂ¥ADIRLE AL FINAL DE CONTROL LOW
01 COL-GRI-AZU.
02 pic x(40) value "FCOLOR=WHITE, BCOLOR=BLUE".
****** Gris sobre Negro, AÂ¥ADIRLE AL FINAL DE CONTROL LOW
01 COL-GRI-NEG.
02 pic x(40) value "FCOLOR=WHITE, BCOLOR=BLACK".
****** Gris sobre Verde, AÂ¥ADIRLE AL FINAL DE CONTROL LOW
01 COL-GRI-VER.
02 pic x(40) value "FCOLOR=WHITE, BCOLOR=GREEN".
****** Magenta sobre Amarillo
01 COL-MAG-DOR.
02 pic x(40) value "FCOLOR=MAGENTA, BCOLOR=BROWN".
****** Magenta sobre Azul
01 COL-MAG-AZU.
02 pic x(40) value "FCOLOR=MAGENTA, BCOLOR=BLUE".
****** Magenta sobre Blanco
01 COL-MAG-BLA.
02 pic x(40) value "FCOLOR=MAGENTA, BCOLOR=WHITE".
****** Magenta sobre Negro
01 COL-MAG-NEG.
02 pic x(40) value "FCOLOR=MAGENTA, BCOLOR=BLACK".
****** Negro sobre Azul
01 COL-NEG-AZU.
02 pic x(40) value "FCOLOR=BLACK, BCOLOR=BLUE".
****** Negro sobre Blanco
01 COL-NEG-BLA.
02 pic x(40) value "FCOLOR=BLACK, BCOLOR=WHITE".
****** Negro sobre Cyan
01 COL-NEG-CYA.
02 pic x(40) value "FCOLOR=BLACK, BCOLOR=CYAN".
****** Negro sobre Rojo
01 COL-NEG-ROJ.
02 pic x(40) value "FCOLOR=BLACK, BCOLOR=RED".
****** Negro sobre Verde
01 COL-NEG-VER.
02 pic X(37) value "FCOLOR=BLACK, BCOLOR=GREEN".
****** Rojo sobre Azul
01 COL-ROJ-AZU.
02 pic x(40) value "FCOLOR=RED, BCOLOR=BLUE".
****** Rojo sobre Blanco
01 COL-ROJ-BLA.
02 pic x(40) value "FCOLOR=RED, BCOLOR=WHITE".
****** Rojo sobre Cyan
01 COL-ROJ-CYA.
02 pic x(40) value "FCOLOR=RED, BCOLOR=CYAN".
****** Rojo sobre Negro
01 COL-ROJ-NEG.
02 pic x(40) value "FCOLOR=RED, BCOLOR=BLACK".
****** Rojo sobre Rojo
01 COL-ROJ-ROJ.
02 pic x(40) value "FCOLOR=RED, BCOLOR=RED".
****** Verde sobre Azul
01 COL-VER-AZU.
02 pic x(40) value "FCOLOR=GREEN, BCOLOR=BLUE".
****** Verde sobre Cyan
01 COL-VER-CYA.
02 pic x(40) value "FCOLOR=GREEN, BCOLOR=CYAN".
****** Verde sobre Gris
01 COL-VER-GRI.
02 pic x(40) value "FCOLOR=GREEN, BCOLOR=WHITE".
****** Verde sobre Negro
01 COL-VER-NEG.
02 pic x(40) value "FCOLOR=GREEN, BCOLOR=BLACK".
****** Verde sobre Verde
01 COL-VER-VER.
02 pic x(40) value "FCOLOR=GREEN, BCOLOR=GREEN".
******** Bordes y Cuadros
01 LIN-HOR-DOB-78 PIC X(78) VALUE ALL "Ã".
01 BORDES-DOBLES.
02 ESQ-SUP-IZQ-DOB PIC X VALUE "É".
02 ESQ-SUP-DER-DOB PIC X VALUE "»".
02 ESQ-INF-IZQ-DOB PIC X VALUE "È".
02 ESQ-INF-DER-DOB PIC X VALUE "¼".
02 LIN-HOR-DOB PIC X VALUE "Ã".
02 LIN-VER-DOB PIC X VALUE "º".
01 BORDES-SIMPLES.
02 ESQ-SUP-IZQ-SIM PIC X VALUE "Ú".
02 ESQ-SUP-DER-SIM PIC X VALUE "¿".
02 ESQ-INF-IZQ-SIM PIC X VALUE "À".
02 ESQ-INF-DER-SIM PIC X VALUE "Ù".
02 LIN-HOR-SIM PIC X VALUE "Ä".
02 LIN-VER-SIM PIC X VALUE "³".
******** Variables Generales
01 COLUMNA-FILA-22 PIC 99 VALUE 0.
01 COLUMNA-FILA-23 PIC 99 VALUE 0.
01 INDICE-FILA-23 PIC 99 VALUE 0.
01 COL-ESQ-SUP-IZQ-FILA-22 PIC 99 VALUE 0.
01 COL-ESQ-SUP-DER-FILA-22 PIC 99 VALUE 0.
01 COL-ESQ-INF-IZQ-FILA-24 PIC 99 VALUE 0.
01 COL-ESQ-INF-DER-FILA-24 PIC 99 VALUE 0.
01 COL-ESQ-SUP-DER-FILA-22-1 PIC 99 VALUE 0.
01 SW PIC 9 VALUE 0.
01 TECLA PIC X.
****** Parte correspondiente al mensaje de la linea 23
****** Tabla para guardar las letras sueltas de la linea 22
01 TAB-LETRAS.
02 PIC X VALUE SPACE.
01 RTAB-LETRAS REDEFINES TAB-LETRAS.
02 LETRAS PIC X OCCURS 74 TIMES.
01 NUM-LETRAS PIC 99 VALUE 0.
01 INDICE-LETRAS PIC 99 VALUE 99.
01 REGLA PIC X(80) VALUE SPACES.
01 REGLA1 PIC X(20) VALUE "12345678901234567890".
01 REGLA2 PIC X(20) VALUE "12345678901234567890".
01 REGLA3 PIC X(20) VALUE "12345678901234567890".
01 REGLA4 PIC X(20) VALUE "12345678901234567890".
****** Tabla para guardar el texto de la linea 22
01 TAB-TEX.
02 PIC X(74).
01 RTAB-TEX REDEFINES TAB-TEX.
02 RTAB-TEXTO PIC X(74) OCCURS 1 TIMES.
LINKAGE SECTION.
01 MENSAJE PIC X(55).
PROCEDURE DIVISION USING MENSAJE.
INICIO.
****** Displayar una regla en la linea 25 de ayuda visual
STRING REGLA1 DELIMITED BY SIZE
REGLA2 DELIMITED BY SIZE
REGLA3 DELIMITED BY SIZE
REGLA4 DELIMITED BY SIZE
INTO REGLA.
DISPLAY REGLA
LINE 25 POSITION 1
CONTROL COL-BLA-AZU.
PERFORM INICIALIZACION.
PERFORM CUENTA-LETRAS.
PERFORM COGE-LETRAS.
PERFORM CALCULA-COORDENADAS.
PERFORM SACA-CUADRO.
****** ATENCION!!!
****** Con STOP RUN, el programa se puede usar por si solo
****** Si se va a llamar desde otro programa, debe terminar as¡.
EXIT PROGRAM.
INICIALIZACION.
************************************************** ****************
************************************************** ****************
************************************************** ****************
************************************************** ****************
************************************************** ****************
************************************************** ****************
************************************************** ****************
****** Muy importante poner el SW a 0, porque si n¢, no funcionar
****** la segunda vez que se ejecute el subprograma !!!!!!
MOVE 0 TO SW.
******* Poner la tabla en blanco
MOVE 1 TO INDICE-LETRAS
PERFORM 74 TIMES
MOVE SPACE TO LETRAS(INDICE-LETRAS)
ADD 1 TO INDICE-LETRAS
END-PERFORM.
******* Poner el contador de letras a 0
MOVE 0 TO NUM-LETRAS.
CUENTA-LETRAS.
****** Cuenta todos los caracteres de la variable MENSAJE que hay
****** antes de 2 espacios en blanco consecutivos
INSPECT MENSAJE TALLYING NUM-LETRAS FOR
CHARACTERS BEFORE INITIAL " ".
COGE-LETRAS.
******Extrae caracter a caracter del texto, y lo almacena en una
****** tabla que tiene 74 elementos
* UNSTRING RTAB-TEXTO(1)
UNSTRING MENSAJE
INTO LETRAS(1)
LETRAS(2)
LETRAS(3)
LETRAS(4)
LETRAS(5)
LETRAS(6)
LETRAS(7)
LETRAS(8)
LETRAS(9)
LETRAS(10)
LETRAS(11)
LETRAS(12)
LETRAS(13)
LETRAS(14)
LETRAS(15)
LETRAS(16)
LETRAS(17)
LETRAS(18)
LETRAS(19)
LETRAS(20)
LETRAS(21)
LETRAS(22)
LETRAS(23)
LETRAS(24)
LETRAS(25)
LETRAS(26)
LETRAS(27)
LETRAS(28)
LETRAS(29)
LETRAS(30)
LETRAS(31)
LETRAS(32)
LETRAS(33)
LETRAS(34)
LETRAS(35)
LETRAS(36)
LETRAS(37)
LETRAS(38)
LETRAS(39)
LETRAS(40)
LETRAS(41)
LETRAS(42)
LETRAS(43)
LETRAS(44)
LETRAS(45)
LETRAS(46)
LETRAS(47)
LETRAS(48)
LETRAS(49)
LETRAS(50)
LETRAS(51)
LETRAS(52)
LETRAS(53)
LETRAS(54)
LETRAS(55)
LETRAS(56)
LETRAS(57)
LETRAS(58)
LETRAS(59)
LETRAS(60)
LETRAS(61)
LETRAS(62)
LETRAS(63)
LETRAS(64)
LETRAS(65)
LETRAS(66)
LETRAS(67)
LETRAS(68)
LETRAS(69)
LETRAS(70)
LETRAS(71)
LETRAS(72)
LETRAS(73)
LETRAS(74).
CALCULA-COORDENADAS.
****** Calcula la columna para centrar el texto, ejp
****** si NUM-LETRAS = 50, entonces
****** COLUMNA-FILA-23 = (80 - 50) / 2, o sea, 15
COMPUTE COLUMNA-FILA-23 = (80 - NUM-LETRAS) / 2.
ADD 1 TO COLUMNA-FILA-23.
****** Calcula la columna para la esquina superior izquierda,
****** restando 1 espacio de separaci¢n
COMPUTE COL-ESQ-SUP-IZQ-FILA-22 = COLUMNA-FILA-23 - 1.
****** Calcula la columna para la esquina superior derecha que es
****** el numero de letras + 1
COMPUTE COL-ESQ-SUP-DER-FILA-22 = COL-ESQ-SUP-IZQ-FILA-22
+ NUM-LETRAS + 1.
****** Calcula la columna de la fila 23 donde va el texto
****** que es la columna de la fila 22 - 1
COMPUTE COLUMNA-FILA-22 = COLUMNA-FILA-23 - 1.
SACA-CUADRO.
****** Graficos linea 22.
****** Esquina superior izquierda simple linea 22 "Ú"
DISPLAY ESQ-SUP-IZQ-SIM
LINE 22 POSITION COLUMNA-FILA-22
CONTROL COL-BLA-ROJ.
****** Linea horizontal de la fila 22 "Ä"
COMPUTE
COL-ESQ-SUP-DER-FILA-22-1 = COL-ESQ-SUP-DER-FILA-22 - 1.
PERFORM CREA-FILA-22 VARYING INDICE-FILA-23 FROM
COLUMNA-FILA-23 BY 1 UNTIL INDICE-FILA-23 >
COL-ESQ-SUP-DER-FILA-22-1.
****** Esquina superior derecha del mensaje de la fila 22 "¿"
DISPLAY ESQ-SUP-DER-SIM
LINE 22 POSITION COL-ESQ-SUP-DER-FILA-22
CONTROL COL-BLA-ROJ.
****** Linea vertical a la izquierda del texto "³"
DISPLAY LIN-VER-SIM
LINE 23 POSITION COL-ESQ-SUP-IZQ-FILA-22
CONTROL COL-BLA-ROJ.
****** Linea vertical a la derecha del texto "³"
DISPLAY LIN-VER-SIM
LINE 23 POSITION COL-ESQ-SUP-DER-FILA-22
CONTROL COL-BLA-ROJ.
******Esquina inferior izquierda de la fila 24 "À"
DISPLAY ESQ-INF-IZQ-SIM
LINE 24 POSITION COL-ESQ-SUP-IZQ-FILA-22
CONTROL COL-BLA-ROJ.
******Linea horizontal de la fila 24 "Ä"
COMPUTE
COL-ESQ-SUP-DER-FILA-22-1 = COL-ESQ-SUP-DER-FILA-22 - 1.
PERFORM CREA-FILA-24 VARYING INDICE-FILA-23 FROM
COLUMNA-FILA-23 BY 1 UNTIL INDICE-FILA-23 >
COL-ESQ-SUP-DER-FILA-22-1.
******Esquina inferior derecha de la fila 24 "Ù"
DISPLAY ESQ-INF-DER-SIM
LINE 24 POSITION COL-ESQ-SUP-DER-FILA-22
CONTROL COL-BLA-ROJ.
****** Para que se vea el mensaje
ACCEPT TECLA
LINE 25 POSITION 80 NO BEEP.
******Linea horizontal simple superior "Ä"
CREA-FILA-22.
DISPLAY LIN-HOR-SIM
LINE 22 POSITION INDICE-FILA-23
CONTROL COL-BLA-ROJ.
******Linea horizontal simple inferior "Ä"
CREA-FILA-24.
DISPLAY LIN-HOR-SIM
LINE 24 POSITION INDICE-FILA-23
CONTROL COL-BLA-ROJ.
COMPUTE COLUMNA-FILA-22 = COLUMNA-FILA-23 - 1.
MOVE 0 TO INDICE-LETRAS.
IF SW = 0
PERFORM VARYING INDICE-LETRAS FROM 1 BY 1
UNTIL INDICE-LETRAS > NUM-LETRAS
DISPLAY LETRAS(INDICE-LETRAS)
LINE 23 POSITION COLUMNA-FILA-23
CONTROL COL-AMA-VER
ADD 1 TO COLUMNA-FILA-23
MOVE 1 TO SW
END-PERFORM.
Después de haber dado la vara con colores, editores de pantalla y demás, he conseguido hacer una utilidad, que creo que es bastante interesante para cuando alguien quiera sacar un texto centrado en la fila 23 (o la que se quiera retocando el código) rodeado por un cuadro simple (o doble también retocando el código), y quiero compartirla.
La he realizado en rm/cobol-85, compilada y ejecutada en un sobremesa con windows xp en modo texto, pero supongo que se podrá adaptar a otros entornos.
He intentado documentarla con comentarios, explicando qué hace cada cosa en cada momento, incluyendo una ayuda visual en forma de regla en la fila 25 para comprobar que todo funciona correctamente, y que se puede desactivar.
Como ayuda alternativa, he creado un sistema de variables con combinaciones de colores, que, por sus nombres, ayudan a la hora de programar, y que se pueden usar en otros programas (las combinaciones me han hecho aprender bastante sobre qué colores se pueden usar, y cuales son las restricciones.
Es un subprograma que he llamado mensaje.cbl, y que para llamarla se hace desde cualquier punto de un programa se hace de la siguiente manera:
Se define una variable que se llama mensaje pic x(55)
Se le asigna como contenido el texto que queremos displayar en la fila 23 (procurar no escribir 2 espacios en blanco consecutivos, porque de lo contrario, no funcionará correctamente
Se le llama con CALL "MENSAJE" USING MENSAJE
Y voilá
Este es el código:
IDENTIFICATION DIVISION.
PROGRAM-ID. MENSAJE.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
******** Colores
****** Amarillo sobre Azul
01 COL-AMA-AZU.
02 pic x(40) value "FCOLOR=BROWN, BCOLOR=BLUE".
****** Amarillo sobre Gris
01 COL-AMA-BLA.
02 pic x(40) value "FCOLOR=BROWN, BCOLOR=WHITE".
****** Amarillo sobre Cyan
01 COL-AMA-CYA.
02 pic x(40) value "FCOLOR=BROWN, BCOLOR=CYAN".
****** Amarillo sobre Gris
01 COL-AMA-GRI.
02 pic x(40) value "FCOLOR=BROWN, BCOLOR=WHITE".
****** Amarillo sobre Magenta
01 COL-AMA-MAG.
02 pic x(40) value "FCOLOR=BROWN, BCOLOR=MAGENTA".
****** Amarillo sobre Negro
01 COL-AMA-NEG.
02 pic x(40) value "FCOLOR=BROWN, BCOLOR=BLACK LOW".
****** Amarillo sobre Rojo
01 COL-AMA-ROJ.
02 pic x(40) value "FCOLOR=BROWN, BCOLOR=RED".
****** Amarillo sobre Verde
01 COL-AMA-VER.
02 pic x(40) value "FCOLOR=BROWN, BCOLOR=GREEN".
****** Azul sobre Azul
01 COL-AZU-AZU.
02 pic x(40) value "FCOLOR=BLUE, BCOLOR=BLUE".
****** Azul sobre Blanco
01 COL-AZU-BLA.
02 pic x(40) value "FCOLOR=BLUE, BCOLOR=WHITE".
****** Azul sobre Magenta
01 COL-AZU-MAG.
02 pic x(40) value "FCOLOR=BLUE, BCOLOR=MAGENTA".
****** Azul sobre Negro
01 COL-AZU-NEG.
02 pic x(40) value "FCOLOR=BLUE, BCOLOR=BLACK".
****** Azul sobre Verde
01 COL-AZU-VER.
02 pic x(40) value "FCOLOR=BLUE, BCOLOR=GREEN".
****** Blanco sobre Azul
01 COL-BLA-AZU.
02 pic x(40) value "FCOLOR=WHITE, BCOLOR=BLUE".
****** Blanco sobre Gris
01 COL-BLA-GRI.
02 pic x(40) value "FCOLOR=WHITE, BCOLOR=WHITE".
****** Blanco sobre Cyan
01 COL-BLA-CYA.
02 pic x(40) value "FCOLOR=WHITE, BCOLOR=CYAN".
****** Blanco sobre Magenta
01 COL-BLA-MAG.
02 pic x(40) value "FCOLOR=WHITE, BCOLOR=MAGENTA".
****** Blanco sobre Negro
01 COL-BLA-NEG.
02 pic x(40) value "FCOLOR=WHITE, BCOLOR=BLACK LOW".
****** Blanco sobre Rojo
01 COL-BLA-ROJ.
02 pic x(40) value "FCOLOR=WHITE, BCOLOR=RED".
****** Blanco sobre Verde
01 COL-BLA-VER.
02 pic x(40) value "FCOLOR=WHITE, BCOLOR=GREEN".
****** Cyan sobre Blanco
01 COL-CYA-BLA.
02 pic x(40) value "FCOLOR=CYAN, BCOLOR=WHITE".
****** Cyan sobre Negro
01 COL-CYA-NEG.
02 pic x(40) value "FCOLOR=CYAN, BCOLOR=BLACK".
****** Cyan sobre Rojo
01 COL-CYA-ROJ.
02 pic x(40) value "FCOLOR=CYAN, BCOLOR=RED".
****** Cyan sobre Verde
01 COL-CYA-VER.
02 pic x(40) value "FCOLOR=CYAN, BCOLOR=GREEN".
****** Gris sobre Azul, AÂ¥ADIRLE AL FINAL DE CONTROL LOW
01 COL-GRI-AZU.
02 pic x(40) value "FCOLOR=WHITE, BCOLOR=BLUE".
****** Gris sobre Negro, AÂ¥ADIRLE AL FINAL DE CONTROL LOW
01 COL-GRI-NEG.
02 pic x(40) value "FCOLOR=WHITE, BCOLOR=BLACK".
****** Gris sobre Verde, AÂ¥ADIRLE AL FINAL DE CONTROL LOW
01 COL-GRI-VER.
02 pic x(40) value "FCOLOR=WHITE, BCOLOR=GREEN".
****** Magenta sobre Amarillo
01 COL-MAG-DOR.
02 pic x(40) value "FCOLOR=MAGENTA, BCOLOR=BROWN".
****** Magenta sobre Azul
01 COL-MAG-AZU.
02 pic x(40) value "FCOLOR=MAGENTA, BCOLOR=BLUE".
****** Magenta sobre Blanco
01 COL-MAG-BLA.
02 pic x(40) value "FCOLOR=MAGENTA, BCOLOR=WHITE".
****** Magenta sobre Negro
01 COL-MAG-NEG.
02 pic x(40) value "FCOLOR=MAGENTA, BCOLOR=BLACK".
****** Negro sobre Azul
01 COL-NEG-AZU.
02 pic x(40) value "FCOLOR=BLACK, BCOLOR=BLUE".
****** Negro sobre Blanco
01 COL-NEG-BLA.
02 pic x(40) value "FCOLOR=BLACK, BCOLOR=WHITE".
****** Negro sobre Cyan
01 COL-NEG-CYA.
02 pic x(40) value "FCOLOR=BLACK, BCOLOR=CYAN".
****** Negro sobre Rojo
01 COL-NEG-ROJ.
02 pic x(40) value "FCOLOR=BLACK, BCOLOR=RED".
****** Negro sobre Verde
01 COL-NEG-VER.
02 pic X(37) value "FCOLOR=BLACK, BCOLOR=GREEN".
****** Rojo sobre Azul
01 COL-ROJ-AZU.
02 pic x(40) value "FCOLOR=RED, BCOLOR=BLUE".
****** Rojo sobre Blanco
01 COL-ROJ-BLA.
02 pic x(40) value "FCOLOR=RED, BCOLOR=WHITE".
****** Rojo sobre Cyan
01 COL-ROJ-CYA.
02 pic x(40) value "FCOLOR=RED, BCOLOR=CYAN".
****** Rojo sobre Negro
01 COL-ROJ-NEG.
02 pic x(40) value "FCOLOR=RED, BCOLOR=BLACK".
****** Rojo sobre Rojo
01 COL-ROJ-ROJ.
02 pic x(40) value "FCOLOR=RED, BCOLOR=RED".
****** Verde sobre Azul
01 COL-VER-AZU.
02 pic x(40) value "FCOLOR=GREEN, BCOLOR=BLUE".
****** Verde sobre Cyan
01 COL-VER-CYA.
02 pic x(40) value "FCOLOR=GREEN, BCOLOR=CYAN".
****** Verde sobre Gris
01 COL-VER-GRI.
02 pic x(40) value "FCOLOR=GREEN, BCOLOR=WHITE".
****** Verde sobre Negro
01 COL-VER-NEG.
02 pic x(40) value "FCOLOR=GREEN, BCOLOR=BLACK".
****** Verde sobre Verde
01 COL-VER-VER.
02 pic x(40) value "FCOLOR=GREEN, BCOLOR=GREEN".
******** Bordes y Cuadros
01 LIN-HOR-DOB-78 PIC X(78) VALUE ALL "Ã".
01 BORDES-DOBLES.
02 ESQ-SUP-IZQ-DOB PIC X VALUE "É".
02 ESQ-SUP-DER-DOB PIC X VALUE "»".
02 ESQ-INF-IZQ-DOB PIC X VALUE "È".
02 ESQ-INF-DER-DOB PIC X VALUE "¼".
02 LIN-HOR-DOB PIC X VALUE "Ã".
02 LIN-VER-DOB PIC X VALUE "º".
01 BORDES-SIMPLES.
02 ESQ-SUP-IZQ-SIM PIC X VALUE "Ú".
02 ESQ-SUP-DER-SIM PIC X VALUE "¿".
02 ESQ-INF-IZQ-SIM PIC X VALUE "À".
02 ESQ-INF-DER-SIM PIC X VALUE "Ù".
02 LIN-HOR-SIM PIC X VALUE "Ä".
02 LIN-VER-SIM PIC X VALUE "³".
******** Variables Generales
01 COLUMNA-FILA-22 PIC 99 VALUE 0.
01 COLUMNA-FILA-23 PIC 99 VALUE 0.
01 INDICE-FILA-23 PIC 99 VALUE 0.
01 COL-ESQ-SUP-IZQ-FILA-22 PIC 99 VALUE 0.
01 COL-ESQ-SUP-DER-FILA-22 PIC 99 VALUE 0.
01 COL-ESQ-INF-IZQ-FILA-24 PIC 99 VALUE 0.
01 COL-ESQ-INF-DER-FILA-24 PIC 99 VALUE 0.
01 COL-ESQ-SUP-DER-FILA-22-1 PIC 99 VALUE 0.
01 SW PIC 9 VALUE 0.
01 TECLA PIC X.
****** Parte correspondiente al mensaje de la linea 23
****** Tabla para guardar las letras sueltas de la linea 22
01 TAB-LETRAS.
02 PIC X VALUE SPACE.
01 RTAB-LETRAS REDEFINES TAB-LETRAS.
02 LETRAS PIC X OCCURS 74 TIMES.
01 NUM-LETRAS PIC 99 VALUE 0.
01 INDICE-LETRAS PIC 99 VALUE 99.
01 REGLA PIC X(80) VALUE SPACES.
01 REGLA1 PIC X(20) VALUE "12345678901234567890".
01 REGLA2 PIC X(20) VALUE "12345678901234567890".
01 REGLA3 PIC X(20) VALUE "12345678901234567890".
01 REGLA4 PIC X(20) VALUE "12345678901234567890".
****** Tabla para guardar el texto de la linea 22
01 TAB-TEX.
02 PIC X(74).
01 RTAB-TEX REDEFINES TAB-TEX.
02 RTAB-TEXTO PIC X(74) OCCURS 1 TIMES.
LINKAGE SECTION.
01 MENSAJE PIC X(55).
PROCEDURE DIVISION USING MENSAJE.
INICIO.
****** Displayar una regla en la linea 25 de ayuda visual
STRING REGLA1 DELIMITED BY SIZE
REGLA2 DELIMITED BY SIZE
REGLA3 DELIMITED BY SIZE
REGLA4 DELIMITED BY SIZE
INTO REGLA.
DISPLAY REGLA
LINE 25 POSITION 1
CONTROL COL-BLA-AZU.
PERFORM INICIALIZACION.
PERFORM CUENTA-LETRAS.
PERFORM COGE-LETRAS.
PERFORM CALCULA-COORDENADAS.
PERFORM SACA-CUADRO.
****** ATENCION!!!
****** Con STOP RUN, el programa se puede usar por si solo
****** Si se va a llamar desde otro programa, debe terminar as¡.
EXIT PROGRAM.
INICIALIZACION.
************************************************** ****************
************************************************** ****************
************************************************** ****************
************************************************** ****************
************************************************** ****************
************************************************** ****************
************************************************** ****************
****** Muy importante poner el SW a 0, porque si n¢, no funcionar
****** la segunda vez que se ejecute el subprograma !!!!!!
MOVE 0 TO SW.
******* Poner la tabla en blanco
MOVE 1 TO INDICE-LETRAS
PERFORM 74 TIMES
MOVE SPACE TO LETRAS(INDICE-LETRAS)
ADD 1 TO INDICE-LETRAS
END-PERFORM.
******* Poner el contador de letras a 0
MOVE 0 TO NUM-LETRAS.
CUENTA-LETRAS.
****** Cuenta todos los caracteres de la variable MENSAJE que hay
****** antes de 2 espacios en blanco consecutivos
INSPECT MENSAJE TALLYING NUM-LETRAS FOR
CHARACTERS BEFORE INITIAL " ".
COGE-LETRAS.
******Extrae caracter a caracter del texto, y lo almacena en una
****** tabla que tiene 74 elementos
* UNSTRING RTAB-TEXTO(1)
UNSTRING MENSAJE
INTO LETRAS(1)
LETRAS(2)
LETRAS(3)
LETRAS(4)
LETRAS(5)
LETRAS(6)
LETRAS(7)
LETRAS(8)
LETRAS(9)
LETRAS(10)
LETRAS(11)
LETRAS(12)
LETRAS(13)
LETRAS(14)
LETRAS(15)
LETRAS(16)
LETRAS(17)
LETRAS(18)
LETRAS(19)
LETRAS(20)
LETRAS(21)
LETRAS(22)
LETRAS(23)
LETRAS(24)
LETRAS(25)
LETRAS(26)
LETRAS(27)
LETRAS(28)
LETRAS(29)
LETRAS(30)
LETRAS(31)
LETRAS(32)
LETRAS(33)
LETRAS(34)
LETRAS(35)
LETRAS(36)
LETRAS(37)
LETRAS(38)
LETRAS(39)
LETRAS(40)
LETRAS(41)
LETRAS(42)
LETRAS(43)
LETRAS(44)
LETRAS(45)
LETRAS(46)
LETRAS(47)
LETRAS(48)
LETRAS(49)
LETRAS(50)
LETRAS(51)
LETRAS(52)
LETRAS(53)
LETRAS(54)
LETRAS(55)
LETRAS(56)
LETRAS(57)
LETRAS(58)
LETRAS(59)
LETRAS(60)
LETRAS(61)
LETRAS(62)
LETRAS(63)
LETRAS(64)
LETRAS(65)
LETRAS(66)
LETRAS(67)
LETRAS(68)
LETRAS(69)
LETRAS(70)
LETRAS(71)
LETRAS(72)
LETRAS(73)
LETRAS(74).
CALCULA-COORDENADAS.
****** Calcula la columna para centrar el texto, ejp
****** si NUM-LETRAS = 50, entonces
****** COLUMNA-FILA-23 = (80 - 50) / 2, o sea, 15
COMPUTE COLUMNA-FILA-23 = (80 - NUM-LETRAS) / 2.
ADD 1 TO COLUMNA-FILA-23.
****** Calcula la columna para la esquina superior izquierda,
****** restando 1 espacio de separaci¢n
COMPUTE COL-ESQ-SUP-IZQ-FILA-22 = COLUMNA-FILA-23 - 1.
****** Calcula la columna para la esquina superior derecha que es
****** el numero de letras + 1
COMPUTE COL-ESQ-SUP-DER-FILA-22 = COL-ESQ-SUP-IZQ-FILA-22
+ NUM-LETRAS + 1.
****** Calcula la columna de la fila 23 donde va el texto
****** que es la columna de la fila 22 - 1
COMPUTE COLUMNA-FILA-22 = COLUMNA-FILA-23 - 1.
SACA-CUADRO.
****** Graficos linea 22.
****** Esquina superior izquierda simple linea 22 "Ú"
DISPLAY ESQ-SUP-IZQ-SIM
LINE 22 POSITION COLUMNA-FILA-22
CONTROL COL-BLA-ROJ.
****** Linea horizontal de la fila 22 "Ä"
COMPUTE
COL-ESQ-SUP-DER-FILA-22-1 = COL-ESQ-SUP-DER-FILA-22 - 1.
PERFORM CREA-FILA-22 VARYING INDICE-FILA-23 FROM
COLUMNA-FILA-23 BY 1 UNTIL INDICE-FILA-23 >
COL-ESQ-SUP-DER-FILA-22-1.
****** Esquina superior derecha del mensaje de la fila 22 "¿"
DISPLAY ESQ-SUP-DER-SIM
LINE 22 POSITION COL-ESQ-SUP-DER-FILA-22
CONTROL COL-BLA-ROJ.
****** Linea vertical a la izquierda del texto "³"
DISPLAY LIN-VER-SIM
LINE 23 POSITION COL-ESQ-SUP-IZQ-FILA-22
CONTROL COL-BLA-ROJ.
****** Linea vertical a la derecha del texto "³"
DISPLAY LIN-VER-SIM
LINE 23 POSITION COL-ESQ-SUP-DER-FILA-22
CONTROL COL-BLA-ROJ.
******Esquina inferior izquierda de la fila 24 "À"
DISPLAY ESQ-INF-IZQ-SIM
LINE 24 POSITION COL-ESQ-SUP-IZQ-FILA-22
CONTROL COL-BLA-ROJ.
******Linea horizontal de la fila 24 "Ä"
COMPUTE
COL-ESQ-SUP-DER-FILA-22-1 = COL-ESQ-SUP-DER-FILA-22 - 1.
PERFORM CREA-FILA-24 VARYING INDICE-FILA-23 FROM
COLUMNA-FILA-23 BY 1 UNTIL INDICE-FILA-23 >
COL-ESQ-SUP-DER-FILA-22-1.
******Esquina inferior derecha de la fila 24 "Ù"
DISPLAY ESQ-INF-DER-SIM
LINE 24 POSITION COL-ESQ-SUP-DER-FILA-22
CONTROL COL-BLA-ROJ.
****** Para que se vea el mensaje
ACCEPT TECLA
LINE 25 POSITION 80 NO BEEP.
******Linea horizontal simple superior "Ä"
CREA-FILA-22.
DISPLAY LIN-HOR-SIM
LINE 22 POSITION INDICE-FILA-23
CONTROL COL-BLA-ROJ.
******Linea horizontal simple inferior "Ä"
CREA-FILA-24.
DISPLAY LIN-HOR-SIM
LINE 24 POSITION INDICE-FILA-23
CONTROL COL-BLA-ROJ.
COMPUTE COLUMNA-FILA-22 = COLUMNA-FILA-23 - 1.
MOVE 0 TO INDICE-LETRAS.
IF SW = 0
PERFORM VARYING INDICE-LETRAS FROM 1 BY 1
UNTIL INDICE-LETRAS > NUM-LETRAS
DISPLAY LETRAS(INDICE-LETRAS)
LINE 23 POSITION COLUMNA-FILA-23
CONTROL COL-AMA-VER
ADD 1 TO COLUMNA-FILA-23
MOVE 1 TO SW
END-PERFORM.