manejable con el teclado o el mouse.
Opcionalmente:
(1) puede aumentarse el numero de lineas y el numero de columnas de la pantalla
(2) asignar un icono a la ventana windows
(3) cambiar el titulo de la ventana windows
Code: Select all
******************************************************************************************************
******************************************************************************************************
******************************************************************************************************
#include 'hmg.ch'
#include "common.ch"
#include "inkey.ch"
#include "hbextern.ch"
#include "Box.ch"
#include "barratitulo.prg"
******************************************************************************************************
PROCEDURE MAIN
SET MULTIPLE ON WARNING //*SET MULTIPLE OFF WARNING // que el user solo pueda abrir una soloa instancia de la aplicacion
SET Navigation Extended
REQUEST HB_GT_WIN_DEFAULT
hb_cdpSelect("EN")
SETMODE(25,90) //SETMODE(40,110)
SET EVENTMASK TO INKEY_ALL
PUBLIC IZQUIERDA:=CHR(19)
PUBLIC DERECHA :=CHR( 4)
PUBLIC ARRIBA :=CHR( 5)
PUBLIC ABAJO :=CHR(24)
PUBLIC SALIDA :=CHR(13)
PUBLIC ESCAPE :=CHR(27)
PUBLIC PGUP :=CHR(18)
PUBLIC PGDN :=CHR( 3)
PUBLIC HOME :=CHR( 1)
PUBLIC END_ :=CHR( 6)
PUBLIC DEL :=CHR( 7)
PUBLIC INS :=CHR(22)
PUBLIC OPCION:=1
PUBLIC U_OPCION:=1
arr_menu_horizontal:={} ; arr_pos_horizontal:={}
aadd( arr_menu_horizontal, [Empresas] ) ; aadd(arr_pos_horizontal,01)
aadd( arr_menu_horizontal, [Modulos] ) ; aadd(arr_pos_horizontal,20)
aadd( arr_menu_horizontal, [Registrar] ) ; aadd(arr_pos_horizontal,40)
aadd( arr_menu_horizontal, [Informes] ) ; aadd(arr_pos_horizontal,60)
aadd( arr_menu_horizontal, [Salir] ) ; aadd(arr_pos_horizontal,80)
arr_menu_empresas:={}
aadd( arr_menu_empresas, [Crear] ) //0101
aadd( arr_menu_empresas, [Modificar] ) //0102
aadd( arr_menu_empresas, [Eliminar] ) //0103
aadd( arr_menu_empresas, [Seleccionar] ) //0104
arr_menu_modulos:={}
aadd( arr_menu_modulos, [Contabilidad] ) //0201
aadd( arr_menu_modulos, [Tesoreria] ) //0202
aadd( arr_menu_modulos, [Facturacion] ) //0203
aadd( arr_menu_modulos, [Compras] ) //0204
arr_menu_registrar:={}
aadd( arr_menu_registrar, [Opcion 1] ) //0301
aadd( arr_menu_registrar, [Opcion 2] ) //0302
aadd( arr_menu_registrar, [Opcion 3] ) //0303
aadd( arr_menu_registrar, [Otras Opciones] ) //0304
arr_menu_informes:={}
aadd( arr_menu_informes, [Informe 1] ) //0401
aadd( arr_menu_informes, [Informe 2] ) //0402
aadd( arr_menu_informes, [Informe 3] ) //0403
aadd( arr_menu_informes, [Otros Informes] ) //0404
arr_menu_salir:={}
aadd( arr_menu_salir, [Salir] )
arr_arr_horizontal:={}
aadd( arr_arr_horizontal, [arr_menu_Empresas] )
aadd( arr_arr_horizontal, [arr_menu_Modulos] )
aadd( arr_arr_horizontal, [arr_menu_Registrar] )
aadd( arr_arr_horizontal, [arr_menu_Informes] )
aadd( arr_arr_horizontal, [arr_menu_Salir] )
SetConsoleTitle("EJEMPLO MENU EN MODO CONSOLE")
setblink(.f.)
setcolor("n+/w")
cls
setcolor("w+/b")
DO WHILE(.T.)
BEGIN SEQUENCE
KEYBOARD CHR(13)
MODULO:=MENUTOTAL()
*MSGDEBUG( MODULO )
MODULO:=&("{||"+MODULO+"()}")
EVAL(MODULO)
END
CLOSE DATABASE
ENDDO
RETURN
*******************************************************************************************************************************************
FUNCTION MENUTOTAL
LOCAL horizontal:=1
LOCAL vertical :=1
PRIVATE FILA_MENU:=1
@FILA_MENU,01 SAY SPACE(MAXCOL()+1)
DO WHILE (.T.)
MENUHORIZONTAL()
IF OPCION=0
LOOP
ENDIF
PERSIANA:=arr_arr_horizontal[opcion]
persiana:=&persiana
COLIZQ:=arr_pos_horizontal[opcion]
FONDO :=FILA_MENU+2+len(persiana)
COLDER:=0
FOR I:=1 TO LEN(PERSIANA)
IF LEN(PERSIANA[I])>COLDER
COLDER:=LEN(PERSIANA[I])
ENDIF
NEXT
COLDER:=COLIZQ+COLDER
SAVPANT:=SAVESCREEN(,,,)
@FILA_MENU+1,COLIZQ-1,FONDO,COLDER+1 BOX B_SINGLE_DOUBLE
SOMBRA(FILA_MENU+1,COLIZQ-2,FONDO,COLDER+1)
VERTICAL:=ACHOICE(FILA_MENU+2,COLIZQ,FONDO,COLDER,persiana,.t.,[MNUFUNC],1)
RESTSCREEN(,,,,SAVPANT)
U_OPCION:=OPCION
IF VERTICAL>0
EXIT
ENDIF
ENDDO
RETURN("P"+strzero(OPCION,2)+strzero(vertical,2))
*******************************************************************************************************************************************
PROCEDURE MENUHORIZONTAL
OPCION:=U_OPCION
SETCOLOR("W/B,N/GR*,,,N/W*")
@FILA_MENU,00 SAY SPACE(MAXCOL()+1)
FOR VA:=1 TO LEN(ARR_MENU_HORIZONTAL)
@FILA_MENU,arr_pos_horizontal[va] PROMPT ARR_MENU_HORIZONTAL[VA]
NEXT
MENU TO OPCION
RETURN
*******************************************************************************************************************************************
FUNCTION MNUFUNC
PARAMETER MODO,ELEMENTO,POSREL
PRIVATE DEV:=2
PRIVATE ATECLA:=CHR(LASTKEY())
IF LASTKEY()=1002
IF MROW()=FILA_MENU
keyboard ESCAPE
ENDIF
ENDIF
HELP_OPC:=ELEMENTO
DO CASE
CASE MODO=0
CASE MODO=1
KEYBOARD CT_PGDN
CASE MODO=2
KEYBOARD CT_PGUP
CASE MODO=4
ATECLA=CHR(INKEY(0))
IF ATECLA$IZQUIERDA+DERECHA+ESCAPE
IF ATECLA<>ESCAPE
KEYBOARD ATECLA+SALIDA
ELSE
KEYBOARD ESCAPE
ENDIF
DEV=0
ENDIF
CASE MODO=3
DO CASE
CASE MANEJAR(ATECLA)
DEV:=3
CASE ATECLA$IZQUIERDA+DERECHA
HELP_OPC=1
DEV:=0
KEYBOARD ATECLA+SALIDA
CASE ATECLA=ESCAPE
DEV:=0
KEYBOARD ESCAPE
CASE ATECLA=SALIDA
DEV:=1
ENDCASE
ENDCASE
RETURN(DEV)
*******************************************************************************************************************************************
FUNCTION MANEJAR(K)
K:=ASC(K)
RETURN(k>=32.AND.k<249.AND.k<>219.AND.CHR(k)<>";")
*******************************************************************************************************************************************
FUNCTION SOMBRA(_Li, _Ci, _Lf, _Cf)
Local Tela1, Tela2, Tela3, Tela4
Tela3 := savescreen(_Li + 1, _Cf + 1, _Lf + 1, _Cf + 2)
Tela4 := savescreen(_Lf + 1, _Ci + 2, _Lf + 1, _Cf + 2)
for Tela1:= 2 to len(Tela3) step 2
Tela2:= shadow(asc(substr(Tela3,Tela1,1)))
Tela3:= stuff(Tela3,Tela1,1,Tela2)
end
for Tela1:= 2 to len(Tela4) step 2
Tela2:= shadow(asc(substr(Tela4, Tela1,1)))
Tela4:= stuff(Tela4,Tela1,1,Tela2)
end
restscreen(_Li + 1, _Cf + 1, _Lf + 1, _Cf + 2, Tela3)
restscreen(_Lf + 1, _Ci + 2, _Lf + 1, _Cf + 2, Tela4)
return NIL
*******************************************************************************************************************************************
FUNCTION SHADOW(_Car)
Local Var1, Var2, Var3
Var1:= _Car % 16
Var2:= (_Car - Var1) / 16
Var3:= {0, 0, 8, 8, 0, 8, 0, 8, 0, 1, 2, 3, 4, 5, 6, 7}
Var1:= Var3[Var1 + 1]
Var2:= Var3[Var2 + 1]
return Chr(16 * Var2 + Var1)
************************************************************************************************************************
PROCEDURE P0101
MSGINFO(PROCNAME())
RETURN
PROCEDURE P0102
MSGINFO(PROCNAME())
RETURN
PROCEDURE P0103
MSGINFO(PROCNAME())
RETURN
PROCEDURE P0104
MSGINFO(PROCNAME())
RETURN
*******************************************************************************************************************************************
PROCEDURE P0201
LOCAL SAVPANT:=SAVESCREEN(,,,)
LOCAL ALTO:=4
LOCAL COLIZQ:=24
LOCAL FONDO:=18
LOCAL COLDER:=56
@ALTO,COLIZQ CLEAR TO FONDO,COLDER+1
@ALTO,COLIZQ,FONDO,COLDER+1 BOX B_DOUBLE_SINGLE
SOMBRA(ALTO,COLIZQ-2,FONDO,COLDER+1)
ALTO:=ALTO+8
COLIZQ:=COLIZQ+8
FONDO:=FONDO+2
COLDER:=COLDER+8
@ALTO,COLIZQ CLEAR TO FONDO,COLDER+1
@ALTO,COLIZQ,FONDO,COLDER+1 BOX B_SINGLE_DOUBLE
@FONDO+1,COLIZQ+5 SAY "ES UNA PRUEBA EN SOMBRA" COLOR "N+/W+"
SOMBRA(ALTO,COLIZQ-2,FONDO,COLDER+1)
DO WHILE (.T.)
INKEY(0)
IF LASTKEY()>1000
LOOP
ENDIF
EXIT
ENDDO
RESTSCREEN(,,,,SAVPANT)
RETURN
PROCEDURE P0202
MSGINFO(PROCNAME())
RETURN
PROCEDURE P0203
MSGINFO(PROCNAME())
RETURN
PROCEDURE P0204
MSGINFO(PROCNAME())
RETURN
*******************************************************************************************************************************************
PROCEDURE P0301
MSGINFO(PROCNAME())
RETURN
PROCEDURE P0302
MSGINFO(PROCNAME())
RETURN
PROCEDURE P0303
MSGINFO(PROCNAME())
RETURN
PROCEDURE P0304
MSGINFO(PROCNAME())
RETURN
*******************************************************************************************************************************************
PROCEDURE P0401
MSGINFO(PROCNAME())
RETURN
PROCEDURE P0402
MSGINFO(PROCNAME())
RETURN
PROCEDURE P0403
MSGINFO(PROCNAME())
RETURN
PROCEDURE P0404
MSGINFO(PROCNAME())
RETURN
*******************************************************************************************************************************************
PROCEDURE P0501
QUIT
RETURN
*******************************************************************************************************************************************
*******************************************************************************************************************************************