Pantallas RMCobol

[ge5lo]

Hola busco pantallas que sean hechas en RMcobol 85 ya rescate un codigo fuente que realice hace algunos años pero no son pantallas que tengan color ni teclas de funcion para navegar :jefe: y me gustaría saber si en este compilador se podia usar mouse? no se si tambien se pueda usar en Unix como en DOS???

[JCantero]

Que version tiene el runtime ?

En windows, a partir de la versión 6.0 tiene soporte de ratón.

En Linux, no.

[ge5lo]

Que version tiene el runtime ?

En windows, a partir de la versión 6.0 tiene soporte de ratón.

En Linux, no.
el runtime es RMCOBOL 85 creo que es la 5xx
Hola JCantero Gracias por responder pero el codigo que tengo esta en DOS y lo rescate para que funcionara en DOSBox Solo que quiero mejorar las pantallas y no recuerdo para hacer las pantallas bonitas y con color

[Loffreda]

Hola busco pantallas que sean hechas en RMcobol 85 ya rescate un codigo fuente que realice hace algunos años pero no son pantallas que tengan color ni teclas de funcion para navegar :jefe: y me gustaría saber si en este compilador se podia usar mouse? no se si tambien se pueda usar en Unix como en DOS???


Use muchos años RM, tengo rutinas armadas, no creo que puedas usar MOUSE, en cuanto al color de las pantallas puedes darles tonos básicos

:hi:

[ge5lo]

Use muchos años RM, tengo rutinas armadas, no creo que puedas usar MOUSE, en cuanto al color de las pantallas puedes darles tonos básicos

:hi:

Si me puedes ayudar con esas rutinas te agradeceria... lo del Mouse no es importante si las pantallas tiene colores basico no importa

[JCantero]

Con la versión 5, no tienes soporte de ratón.

El color si lo puedes implementar.

Tienes que poner en el ACCEPT y DISPLAY la palabra CONTROL y los colores con. FCOLOR. Y BCOLOR

Ejemplo

Display ' Esto va en color ' líne 1 position 1 control 'fcolor=blue, bcolor=red'


---------- Post añadido el 2 de junio de 2022 a las 07:41 ----------

Si lo quieres automatizar puedes emplear una variable y la vas rellenando según las necesidades.



move 'fcolor=blue, bcolor=red' to color
*
*
*
Display ' Esto va en color ' líne 1 position 1 control color


---------- Post añadido el 2 de junio de 2022 a las 07:49 ----------

En versiones superiores se pueden indicar los colores con numeros, pero en la 5:


COLOR-NAME
BLACK
BLUE
GREEN
CYAN
RED
MAGENTA
BROWN
WHITE


Ademas puedes poner LOW y LIGHT para atenuar o resaltar el color.

[Kuk]

@ge5lo, no sé si te interesará, pero lo mismo quieres pasarte al mundo GUI: [Compilador] Fujitsu PowerCOBOL V3L10 para Windows 7 x86/x64 - COBOL Foro (https://www.cobolforo.es/showthread.php?t=157)

[ge5lo]

@ge5lo, no sé si te interesará, pero lo mismo quieres pasarte al mundo GUI: [Compilador] Fujitsu PowerCOBOL V3L10 para Windows 7 x86/x64 - COBOL Foro (https://www.cobolforo.es/showthread.php?t=157)

Gracias pero lo que busco es RMCobol 85, pantallas en Ascii

---------- Post añadido el 2 de junio de 2022 a las 16:31 ----------

Con la versión 5, no tienes soporte de ratón.

El color si lo puedes implementar.

Tienes que poner en el ACCEPT y DISPLAY la palabra CONTROL y los colores con. FCOLOR. Y BCOLOR

Ejemplo

Display ' Esto va en color ' líne 1 position 1 control 'fcolor=blue, bcolor=red'


---------- Post añadido el 2 de junio de 2022 a las 07:41 ----------

Si lo quieres automatizar puedes emplear una variable y la vas rellenando según las necesidades.



move 'fcolor=blue, bcolor=red' to color
*
*
*
Display ' Esto va en color ' líne 1 position 1 control color


---------- Post añadido el 2 de junio de 2022 a las 07:49 ----------

En versiones superiores se pueden indicar los colores con numeros, pero en la 5:


COLOR-NAME
BLACK
BLUE
GREEN
CYAN
RED
MAGENTA
BROWN
WHITE


Ademas puedes poner LOW y LIGHT para atenuar o resaltar el color.


HOLA CANTERO Encontre algo en esta pagina Cobol en español - MENU DE OPCIONES EN RMCOBOL-85 (http://www.escobol.com/modules.php?name=News&file=article&sid=86)

pero el manejo del cursor y las posiciones del menu estan estan cuadradas, busco algo simiar con recuadros con caracteres como estos "└" o "╚"
IDENTIFICATION DIVISION.
PROGRAM-ID. MENU.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 OPX PIC X.

01 WCB.
03 WINCAB PIC 999 BINARY VALUE 0.
03 WINLIN PIC 999 BINARY.
03 WINCOL PIC 999 BINARY.
03 WINLOC PIC X VALUE "S".
* (S-W)
03 WINBORST PIC X VALUE "Y".
* (Y-N)
03 WINBORTI PIC 9 VALUE 2.
03 WINBORCH PIC X.
03 WINLLE PIC X.
* (Y-N)
03 WINLLECH PIC X.
03 WINTITSI PIC X VALUE "T".
* (T-B)
03 WINTITPO PIC X VALUE "C".
* (C-L-R)
03 WINTITLO PIC 999 BINARY.
03 WINTIT PIC X(64).

* ----- * --- Colores.

01 C0.
02 pic X(37) value " HIGHNO REVERSE BLINK , FCOL".
02 pic X(30) value "OR = WHITE , BCOLOR = BLUE ".
01 C1.
02 pic X(37) value " HIGHNO REVERSE BLINK , FCOL".
02 pic X(30) value "OR = WHITE , BCOLOR = BLACK ".
01 C2.
02 pic X(37) value " HIGHNO REVERSE BLINK , FCOL".
02 pic X(30) value "OR = GREEN , BCOLOR = BLACK ".
01 C3.
02 pic X(37) value " HIGHNO REVERSE BLINK , FCOL".
02 pic X(30) value "OR = RED , BCOLOR = WHITE ".
01 C4.
02 pic X(37) value " HIGHNO REVERSE BLINK , FCOL".
02 pic X(30) value "OR = RED , BCOLOR = BLCK ".
01 C5.
02 pic X(37) value " HIGHNO REVERSE BLINK , FCOL".
02 pic X(30) value "OR = CYAN , BCOLOR = BLACK ".
01 C6.
02 pic X(37) value " HIGHNO REVERSE BLINK , FCOL".
02 pic X(30) value "OR = BROWN , BCOLOR = WHITE ".
01 C7.
02 pic X(37) value " HIGHNO REVERSE BLINK , FCOL".
02 pic X(30) value "OR = BLUE , BCOLOR = WHITE ".
01 C8.
02 pic X(37) value " HIGHNO REVERSE BLINK , FCOL".
02 pic X(30) value "OR = MAGENTA, BCOLOR = BLACK ".
01 C9.
02 pic X(37) value " HIGHNO REVERSE BLINK , FCOL".
02 pic X(30) value "OR = MAGENTA, BCOLOR = WHITE ".
01 CA.
02 pic X(37) value " HIGHNO REVERSE BLINK , FCOL".
02 pic X(30) value "OR = BROWN , BCOLOR = BLACK ".
01 CB.
02 pic X(37) value " HIGHNO REVERSE BLINK , FCOL".
02 pic X(30) value "OR = BROWN , BCOLOR = WHITE ".
01 CC.
02 pic X(37) value " HIGHNO REVERSE BLINK , FCOL".
02 pic X(30) value "OR = BLACK , BCOLOR = WHITE ".
01 CJ.
02 pic X(37) value " HIGHNO REVERSE BLINK , FCOL".
02 pic X(31) value "OR = CYAN , BCOLOR = BLACK LOW ".

01 VENTANAS.
02 WIN PIC X(80) OCCURS 10 TIMES.

01 LI PIC 9(2).
01 LI2 PIC 9(2).
01 LIX PIC 9(2).
01 OP PIC X.
01 ESCA PIC 9(2).
01 QW PIC 9(1).

01 TABLA-OPCIONES.
02 PIC X(45) VALUE " Programa de Contabilidad ".
02 PIC X(45) VALUE " Programa de Facturacion ".
02 PIC X(45) VALUE " Copias de Seguridad ".
02 PIC X(45) VALUE " Surpervision de la Red Local ".
02 PIC X(45) VALUE " Utilidades del Sistema ".
02 PIC X(45) VALUE " Salir del Menu ".
01 RTABLA REDEFINES TABLA-OPCIONES.
02 ELEMEN PIC X(45) OCCURS 6 TIMES.

01 TABLA-OPCIONES2.
02 PIC X(45) VALUE " Hacer Copias de Seguridad ".
02 PIC X(45) VALUE " Restaurar Copias de Seguridad ".
02 PIC X(45) VALUE " Preferencias ".
02 PIC X(45) VALUE " Volver al Menu Principal ".
01 RTABLA2 REDEFINES TABLA-OPCIONES2.
02 ELEMEN2 PIC X(45) OCCURS 4 TIMES.

PROCEDURE DIVISION.
INICIO.
DISPLAY SPACES ERASE CONTROL C1 LOW.
DISPLAY SPACES SIZE 80 LINE 1 POSITION 1 CONTROL C0
DISPLAY " Menu Principal de Opciones ³ "
LINE 1 POSITION 1 CONTROL C0
DISPLAY "Versi¢n 1.00/2.003" LINE 1 POSITION 00 CONTROL C0
DISPLAY SPACES SIZE 80 LINE 2 POSITION 1 CONTROL C5 LOW.
INI2.
MOVE 6 TO WINLIN
MOVE 45 TO WINCOL
MOVE " Opciones " TO WINTIT MOVE 10 TO WINTITLO
MOVE 3 TO WINBORTI
MOVE WCB TO WIN(1)
DISPLAY WIN(1) LINE 8 POSITION 19 LOW CONTROL "WINDOW-CREATE"
MOVE 1 TO LI.
UNO.
DISPLAY ELEMEN (LI) LINE LI POSITION 1 control c1 LOW.
ADD 1 TO LI IF LI > 6 NEXT SENTENCE ELSE GO UNO.
DOS.
IF LI = 6 MOVE 1 TO LI.
DISPLAY ELEMEN (LI) LINE LI POSITION 1 CONTROL C9 reverse.
TRES.
ACCEPT OP LINE LI POSITION 45 OFF NO BEEP
ON EXCEPTION ESCA MOVE 1 TO QW.
DISPLAY ELEMEN (LI) LINE LI POSITION 1 control c1 low.
IF ESCA = 27
DISPLAY WIN(1) CONTROL "WINDOW-REMOVE"
DISPLAY SPACES ERASE CONTROL C1
STOP RUN.
IF ESCA = 52 SUBTRACT 1 FROM LI GO DOS.
IF ESCA = 53 ADD 1 TO LI GO DOS.
IF ESCA = 13 NEXT SENTENCE ELSE GO TRES.
CUATRO.
IF LI = 1
CALL "GCM.COB" CANCEL "GCM.COB"
MOVE 0 TO QW
GO UNO
END-IF.
IF LI = 2
CALL "CGA.COB" CANCEL "CGA.COB"
MOVE 0 TO QW
GO UNO
END-IF.
IF LI = 3
PERFORM INI22 THRU CUATRO2
MOVE 0 TO QW
GO UNO
END-IF.
IF LI = 4
CALL "MEN-SRED.COB" CANCEL "MEN-SRED.COB"
MOVE 0 TO QW
GO UNO
END-IF.
IF LI = 5
CALL "MEN-UTIL.COB" CANCEL "MEN-UTIL.COB"
MOVE 0 TO QW
GO UNO
END-IF.
IF LI = 6
MOVE 0 TO QW
DISPLAY WIN(1) CONTROL "WINDOW-REMOVE"
DISPLAY SPACES ERASE CONTROL C1
STOP RUN
END-IF.

INI22.
DISPLAY SPACES SIZE 1 LINE 2 POSITION 44 CONTROL C5 LOW
MOVE 4 TO WINLIN
MOVE 45 TO WINCOL
MOVE " Copias de Seguridad " TO WINTIT MOVE 21 TO WINTITLO
MOVE 3 TO WINBORTI
MOVE WCB TO WIN(2)
DISPLAY WIN(2) LINE 12 POSITION 25 LOW
CONTROL "WINDOW-CREATE"
MOVE 1 TO LI2.
UNO2.
DISPLAY ELEMEN2 (LI2) LINE LI2 POSITION 1 control c1 LOW
ADD 1 TO LI2 IF LI2 > 4 NEXT SENTENCE ELSE GO UNO2.
DOS2.
IF LI2 = 4 MOVE 1 TO LI2.
DISPLAY ELEMEN2 (LI2) LINE LI2 POSITION 1
CONTROL C9 reverse.
TRES2.
ACCEPT OP LINE LI2 POSITION 45 OFF NO BEEP
ON EXCEPTION ESCA MOVE 1 TO QW.
DISPLAY ELEMEN2 (LI2) LINE LI2 POSITION 1 control c1 low.
IF ESCA = 27
DISPLAY WIN(2) CONTROL "WINDOW-REMOVE"
go ini2.
IF ESCA = 52 SUBTRACT 1 FROM LI2 GO DOS2.
IF ESCA = 53 ADD 1 TO LI2 GO DOS2.
IF ESCA = 13 NEXT SENTENCE ELSE GO TRES2.
CUATRO2.
IF LI2 = 1
MOVE 0 TO QW
GO UNO2
END-IF.
IF LI2 = 2
MOVE 0 TO QW
GO UNO2
END-IF.
IF LI2 = 3
MOVE 0 TO QW
GO UNO2
END-IF.
IF LI2 = 4
MOVE 0 TO QW
DISPLAY WIN(2) CONTROL "WINDOW-REMOVE"
GO INI2
END-IF.


pe

[JCantero]

Para versiones superiores a 6.xx está implementado. Pero para la 5.xx no. Hay que hacerlo manualmente.

Para esa versión (5.xx), yo utilizaba un editor de pantallas. Que se puede hacer hasta en cobol.

El editor, basicamente, editaba la pantalla 80x25 ( 2000 caracteres, con cualquier caracter ASCII) y con posibilidad de dar color a cada caracter de la pantalla, eso es un fichero de 4000 caracteres.

Despues en los programas, una rutina (volcado) que sacaba esa pantalla.

[ge5lo]

Para versiones superiores a 6.xx está implementado. Pero para la 5.xx no. Hay que hacerlo manualmente.

Para esa versión (5.xx), yo utilizaba un editor de pantallas. Que se puede hacer hasta en cobol.

El editor, basicamente, editaba la pantalla 80x25 ( 2000 caracteres, con cualquier caracter ASCII) y con posibilidad de dar color a cada caracter de la pantalla, eso es un fichero de 4000 caracteres.

Despues en los programas, una rutina (volcado) que sacaba esa pantalla.

Hola y tienes algo de codigo de ejemplo para hacerlo manualmente???

[JCantero]

Si, por supuesto. Ahi va el "volcado de pantallas".

Para mayor comprensión, este volcado, identifica el sistema operativo (o interfaz) donde se ejecuta, MS-DOS, Windows, linux (unix, xenix, unisys)

La pantalla tiene un identificador de 7 caracteres y 2000 pares de color, caracter.


IDENTIFICATION DIVISION.
PROGRAM-ID. volcado1.
* (volcado1 con colores)
* (por JCCC)
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. RMCOBOL-85.
OBJECT-COMPUTER. RMCOBOL-85.
SPECIAL-NAMES.
DECIMAL-POINT IS COMMA.
*
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*
SELECT RGREGIS
ASSIGN TO RANDOM, NOMBRE-REGIS
ORGANIZATION IS sequential
ACCESS MODE IS sequential
file status is fs-regis.


*
DATA DIVISION.
FILE SECTION.
*

FD RGREGIS.
01 REG-REGISTRO.
02 lineaXXX pic x(5000).
02 REG-LINEAXX REDEFINES LINEAXXX.
04 FILLER PIC X(7).
04 REG-PAN OCCURS 2000 TIMES.
06 LINEA-ATRIBUTO PIC X.
06 LINEA-COLOR PIC X.
04 FILLER PIC X.

WORKING-STORAGE SECTION.
*
01 NOMBRE-REGIS PIC X(80) VALUE all " ".
01 fs-regis pic xx.
88 esta-regis value '00' '02'.
88 n-esta-regis value '23'.
88 fin-regis value '46' '10'.
88 bloqueado-regis value '99'.
88 f-bloqueado-regis value '38' '93'.
88 f-noexiste-regis value '35'.

01 fs-regisx pic xx.

01 i pic 99.
01 j pic s99.
01 k pic 99.
01 LINEA-P PIC X(2000).
01 LINEA-A REDEFINES LINEA-P.
02 linea-aa pic x OCCURS 2000 TIMES.
01 INDICE PIC 9999.
01 linea pic 99.
01 columna pic 99.
01 color1 pic x(37) value "fcolor= WHITE, bcolor=BLue".
01 moneda-presupuesto pic x.
88 presupuesto-euros value 'e' 'E'.
88 presupuesto-ptas value ' ' 'P' 'p'.
copy 'sicolor.cpy'.
copy 'sieuro.cpy'.
copy 'siplannu.cpy'.
copy 'sivarwin.cpy'.
01 ejercicio-presupuesto pic 9999 value 0.
01 HIGH-GRAPHICS pic x(80).
linkage section.
01 registro-lk.
02 fichero-lk.
03 fic-lk PIC X(1) OCCURS 80 times.

------*

[JCantero]

sigue.....



PROCEDURE DIVISION using registro-lk.
------*
DECLARATIVES.
IO-ERROR SECTION.
USE AFTER STANDARD ERROR PROCEDURE ON
RGREGIS.
END DECLARATIVES.
MAIN SECTION.

INICIO.
A0.
initialize nombre-regis
set presupuesto-ptas to true
perform varying i from 1 by 1 until i > 80
or fic-lk(i) = ' '
move fic-lk(i) to nombre-regis(i:1)
end-perform
perform abrir-pantalla.
d accept nombre-regis update line 1 end-accept
PERFORM VARYING INDICE FROM 1 BY 1 UNTIL INDICE = 2001

if es-unix then
inspect linea-atributo(indice) converting
'*‚¡¢£¤¥§¦‡€' to 'áéíóúñѺªçÇ'
end-if

MOVE LINEA-ATRIBUTO(INDICE) TO LINEA-Aa(INDICE)
END-PERFORM
if RM-VersionNumber = ' '
display linea-P line 1 position 1 LOW
CONTROL sicolor
end-if
PERFORM VARYING LINEA FROM 1 BY 1 UNTIL LINEA = 25
PERFORM VARYING COLUMNA FROM 1 BY 1 UNTIL COLUMNA = 81
COMPUTE INDICE = (LINEA - 1) * 80 + COLUMNA
IF LINEA-ATRIBUTO(INDICE) < '³' or > 'Ú'
or RM-VersionNumber = ' '
* or es-unix
EVALUATE LINEA-COLOR(INDICE)
WHEN ''
if RM-VersionNumber not = ' '
DISPLAY LINEA-ATRIBUTO(INDICE) low
LINE LINEA POSITION COLUMNA
CONTROL sicolor
end-if
WHEN ''
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL sicolor
WHEN 'p'
DISPLAY LINEA-ATRIBUTO(INDICE) LOW
LINE LINEA POSITION COLUMNA
CONTROL sicolor reverse
* CONTROL 'FCOLOR=BLACK, BCOLOR=WHITE'
WHEN ''
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL 'FCOLOR=GREY, BCOLOR=WHITE'
WHEN '?'
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL 'FCOLOR=WHITE, BCOLOR=CYAN'
WHEN 'O'
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL 'FCOLOR=WHITE, BCOLOR=RED'
WHEN '0'
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA LOW
CONTROL 'FCOLOR=BLACK, BCOLOR=CYAN'
WHEN 'K'
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL 'FCOLOR=CYAN, BCOLOR=RED'
WHEN ';'
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA REVERSE
CONTROL 'FCOLOR=CYAN, BCOLOR=CYAN'
WHEN ''
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL 'FCOLOR=CYAN, BCOLOR=BLACK'
WHEN OTHER
DISPLAY LINEA-ATRIBUTO(INDICE) low
LINE LINEA POSITION COLUMNA
CONTROL sicolor
* CONTINUE
* DISPLAY LINEA-ATRIBUTO(INDICE)
* LINE LINEA POSITION COLUMNA LOW
END-EVALUATE
ELSE
move ' ' to high-graphics
string sicolor 'high GRAPHICS' delimited by size into
HIGH-GRAPHICS
EVALUATE LINEA-ATRIBUTO(INDICE)
WHEN '³'
MOVE 'x' TO LINEA-ATRIBUTO(INDICE)
WHEN '´'
MOVE 'u' TO LINEA-ATRIBUTO(INDICE)
WHEN 'µ'
MOVE 'u' TO LINEA-ATRIBUTO(INDICE)
WHEN '¶'
MOVE 'u' TO LINEA-ATRIBUTO(INDICE)
WHEN '·'
MOVE 'k' TO LINEA-ATRIBUTO(INDICE)
WHEN '¸'
MOVE 'k' TO LINEA-ATRIBUTO(INDICE)
WHEN '¹'
MOVE 'U' TO LINEA-ATRIBUTO(INDICE)
WHEN 'º'
MOVE 'X' TO LINEA-ATRIBUTO(INDICE)
WHEN '»'
MOVE 'K' TO LINEA-ATRIBUTO(INDICE)
WHEN '¼'
MOVE 'J' TO LINEA-ATRIBUTO(INDICE)
WHEN '½'
MOVE 'j' TO LINEA-ATRIBUTO(INDICE)
WHEN '¾'
MOVE 'j' TO LINEA-ATRIBUTO(INDICE)
WHEN '¿'
MOVE 'k' TO LINEA-ATRIBUTO(INDICE)
WHEN 'À'
MOVE 'm' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Á'
MOVE 'v' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Â'
MOVE 'w' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ã'
MOVE 't' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ä'
MOVE 'q' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Å'
MOVE 'n' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Æ'
MOVE 't' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ç'
MOVE 't' TO LINEA-ATRIBUTO(INDICE)
WHEN 'È'
MOVE 'M' TO LINEA-ATRIBUTO(INDICE)
WHEN 'É'
MOVE 'L' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ê'
MOVE 'V' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ë'
MOVE 'W' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ì'
MOVE 'T' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Í'
MOVE 'Q' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Î'
MOVE 'N' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ï'
MOVE 'v' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ð'
MOVE 'v' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ñ'
MOVE 'w' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ò'
MOVE 'w' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ó'
MOVE 'm' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ô'
MOVE 'm' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Õ'
MOVE 'l' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ö'
MOVE 'l' TO LINEA-ATRIBUTO(INDICE)
WHEN '×'
MOVE 'n' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ø'
MOVE 'n' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ù'
MOVE 'j' TO LINEA-ATRIBUTO(INDICE)
WHEN 'Ú'
MOVE 'l' TO LINEA-ATRIBUTO(INDICE)
WHEN OTHER
MOVE ' ' TO LINEA-ATRIBUTO(INDICE)
* CONTINUE
END-EVALUATE
EVALUATE LINEA-COLOR(INDICE)
WHEN ''
* if linea = 2 and columna = 2
* accept high-graphics line 1 position 1 update
* end-if
DISPLAY LINEA-ATRIBUTO(INDICE) LOW
LINE LINEA POSITION COLUMNA
* CONTROL HIGH-GRAPHICS
CONTROL 'BCOLOR=BLUE , FCOLOR=WHITE HIGH GRAPHICS'

WHEN ''
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL HIGH-GRAPHICS
WHEN 'p'
DISPLAY LINEA-ATRIBUTO(INDICE) LOW
LINE LINEA POSITION COLUMNA
CONTROL HIGH-GRAPHICS reverse
* CONTROL 'FCOLOR=BLACK, BCOLOR=WHITE'
WHEN ''
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL
'BCOLOR=WHITE , FCOLOR=HIGH-INTENSITY WHITE HIGH GRAPHICS'
* CONTROL 'FCOLOR=GREY, BCOLOR=WHITE HIGH GRAPHICS'
WHEN '?'
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL 'FCOLOR=WHITE, BCOLOR=CYAN HIGH GRAPHICS'
WHEN 'O'
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL 'FCOLOR=WHITE, BCOLOR=RED HIGH GRAPHICS'
WHEN '0'
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA LOW
CONTROL 'FCOLOR=BLACK, BCOLOR=CYAN HIGH GRAPHICS'
WHEN 'K'
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL 'FCOLOR=CYAN, BCOLOR=RED HIGH GRAPHICS'
WHEN ';'
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA REVERSE
CONTROL 'FCOLOR=CYAN, BCOLOR=CYAN HIGH GRAPHICS'
WHEN ''
DISPLAY LINEA-ATRIBUTO(INDICE)
LINE LINEA POSITION COLUMNA
CONTROL 'FCOLOR=CYAN, BCOLOR=BLACK HIGH GRAPHICS'
WHEN OTHER
DISPLAY LINEA-ATRIBUTO(INDICE) LOW
LINE LINEA POSITION COLUMNA
* CONTROL HIGH-GRAPHICS
CONTROL 'BCOLOR=BLUE , FCOLOR=WHITE'
* DISPLAY LINEA-ATRIBUTO(INDICE)
* LINE LINEA POSITION COLUMNA LOW
END-EVALUATE
END-IF
END-PERFORM
END-PERFORM
initialize indice
inspect nombre-regis tallying indice for all '.cr6' '.cp6'
initialize i
inspect nombre-regis tallying indice for all '.cr5' '.cp5'
if indice = 0 and i = 0 then
if mun00-corr-ex > 50 then
move 1900 to ejercicio-presupuesto
else
move 2000 to ejercicio-presupuesto
end-if
add mun00-corr-ex to ejercicio-presupuesto
initialize linea-p
string 'Presupuesto ' delimited by size
ejercicio-presupuesto delimited by size
' Entidad ' delimited by size
mun00-cif-ex delimited by ' '
' ' delimited by size
mun00-nombre-ex delimited by size
into linea-p
move 0 to indice j k
perform varying i from 80 by -1 until i = 0 or i = indice
if linea-p(i:1) not = ' ' and indice = 0 then
compute indice = ( 80 - i ) / 2
compute indice = 80 - indice
compute k = indice + 2
end-if
if indice not = 0 then
move linea-p(i:1) to linea-p(indice:1)
if linea-p(indice:1) not = ' '
compute j = indice - 2
end-if
move ' ' to linea-p(i:1)
subtract 1 from indice
end-if
end-perform
display linea-p(1:80) line 25 position 1 erase eol
CONTROL sicolor low
*************
move ' ' to high-graphics
if RM-VersionNumber not = ' '
string sicolor 'high GRAPHICS' delimited by size into
HIGH-GRAPHICS
MOVE 'qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq '
TO LINEA-p
else
MOVE 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ '
TO LINEA-p
end-if
if k <= 80 then
DISPLAY LINEA-p(1 : 80 - k + 1) LOW
LINE 25 POSITION k
CONTROL 'BCOLOR=BLUE , FCOLOR=WHITE HIGH GRAPHICS'
end-if
if j >= 1 then
DISPLAY LINEA-p(1 : j) LOW
LINE 25 POSITION 1
CONTROL 'BCOLOR=BLUE , FCOLOR=WHITE HIGH GRAPHICS'
end-if
*************
else
DISPLAY ' ' low
LINE 25 POSITION 1 erase eol
CONTROL sicolor
end-if.
goback.

abrir-pantalla.
open input rgregis.
d accept nombre-regis update line 1 position 1
if f-noexiste-regis and not presupuesto-euros then
perform varying i from 1 by 1 until nombre-regis(i:1) = ' '
continue
end-perform
perform varying columna from i by -1
until nombre-regis(columna:1) = '\' or = '/'
continue
end-perform
move nombre-regis(columna + 1:) to nombre-regis(1:)
set presupuesto-euros to true
go abrir-pantalla
end-if
read rgregis.
close rgregis.
if si-presupuesto-nuevo then
inspect nombre-regis replacing all '.cr' by '.cp'
open input rgregis
if esta-regis
read rgregis end-read
end-if
close rgregis
end-if.

[Paco_Diaz]

Buenas.

g5lo, yo para hacer lo que estas buscando, uso el programa FSDPC, que te permite crear pantallas con codigos ascii.

Tambien hay que tener el programa TRADUCE que traduce las pantallas creadas a otros formatos, pero ese te serviria mucho.

Estoy buscando otro programa para generar que se llama GASS, pero no lo encuentro aun, si alguien lo tuviese, le agradecería que lo pusiera.

Un saludo. Paco.

[Gusaiello]

@ge5lo, Esto lo hice hace mucho tiempo t corría con RM/85.
No se si servirá.

Es un menú de opciones para un pequeño programita de un bar.