Cobol en español
  Página de Inicio Recomiéndala Contáctame Usuarios en Linea
15
     Crea Una cuenta  
Video 1
Video 2
Video 3

Si te ha servido la web
o te han gustado los videos, colabora haciendo click en el botón.

MANUALES
TEMATICOS
BASES DE DATOS
COBOL / WINDOWS
COBOL / UNIX
HISTORIA /DOCS
 
BUSCADOR
PROGRAMANDO-Dos
TRUCOS
AÑO 2.000
TEORIA POWCOB-3
PROG. POWCOB-3
TEORIA POWCOB-5
PROG. POWCOB-5
OCX-ESCOBOL
RUTINAS/MANUALES
OCX / JUEGOS
HERRAMIENTAS
COMPILADORES
ENCUESTAS
ENLACES
FOROS
TOP 10

CHAT   Usuarios: 0
Noticias
Opciones :    [ Versión Imprimible  |  Enviar a un Amigo ]

MENU DE OPCIONES EN RMCOBOL-85
Enviado el Viernes, 29 julio a las 09:20:28 amrobles
Trucosjuliovc escribió "Hola a todos, revisando mi baúl de los recuerdos encontré un pequeño código fuente como hacer un menú de opciones con ventanas virtuales en rmcobol-85 incluido ya con algunas opciones y más completo aprovechando el truco de menú de opciones que se encuentra en esta web, es muy fácil de entender, solo tenéis que estar atento que es lo que hace el código fuente, espero que aprovechéis para aprender ya que se explica claramente como utilizar las ventanas virtuales y los colores de rmcobol en este truco desarrollado y probado que funciona para rmcobol-85.

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 Facturaci¢n ".
02 PIC X(45) VALUE " Copias de Seguridad ".
02 PIC X(45) VALUE " Surpervisi¢n 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 COL 1 CONTROL C0
DISPLAY " Menu Principal de Opciones ³ "
LINE 1 COL 1 CONTROL C0
DISPLAY "Versi¢n 1.00/2.003 ³ " LINE 1 COL 00 CONTROL C0
DISPLAY SPACES SIZE 80 LINE 2 COL 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 COL 19 LOW CONTROL "WINDOW-CREATE"
MOVE 1 TO LI.
UNO.
DISPLAY ELEMEN (LI) LINE LI COL 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 COL 1 CONTROL C9 reverse.
TRES.
ACCEPT OP LINE LI COL 45 OFF NO BEEP
ON EXCEPTION ESCA MOVE 1 TO QW.
DISPLAY ELEMEN (LI) LINE LI COL 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 COL 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 COL 25 LOW CONTROL "WINDOW-CREATE"
MOVE 1 TO LI2.
UNO2.
DISPLAY ELEMEN2 (LI2) LINE LI2 COL 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 COL 1 CONTROL C9 reverse.
TRES2.
ACCEPT OP LINE LI2 COL 45 OFF NO BEEP
ON EXCEPTION ESCA MOVE 1 TO QW.
DISPLAY ELEMEN2 (LI2) LINE LI2 COL 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.

"

:: Votos del Artículo

Puntuación Media: 3.95   votos: 64

Por favor tómate un segundo y vota por este artículo:

MaloRegularBuenoMuy BuenoExcelente



 ACTUALIDAD
 COBOL
 POWER COBOL
 TRUCOS/ARTICULOS

 HISTORICO
¿Sobre que Base de datos trabajáis en COBOL?

Ficheros indexados
SQL Server
Oracle
MySQL
PostgreSQL
Firebird
DB2
Otra (Comentar)

   

[Resultados]

votos: 1156
Comentarios: 104


Sitio desarrollado con PHP-Nuke. Todos los Derechos Reservados.
PHP-Nuke es un Software Libre realizado con licencia GNU/GPL.
Página creada en Junio de 1.998, con el proposito de difundir el lenguaje Cobol en nuestra lengua.
Andres Montes [98/11]