Menu tipo console manejable con teclado y/o mouse

HMG Samples and Enhancements

Moderator: Rathinagiri

Post Reply
ASESORMIX
Posts: 192
Joined: Thu Oct 25, 2012 8:08 pm
Location: Bqto, Venezuela

Menu tipo console manejable con teclado y/o mouse

Post by ASESORMIX »

Para quienes todavia usan Pantallas tipo console y necesitan un ejemplo sencillo de menu de opciones
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
*******************************************************************************************************************************************
*******************************************************************************************************************************************
Top
User avatar
danielmaximiliano
Posts: 2612
Joined: Fri Apr 09, 2010 4:53 pm
Location: Argentina
Contact:
Contact danielmaximiliano

Re: Menu tipo console manejable con teclado y/o mouse

Post by danielmaximiliano »

gracias por compartir
*´¨)
¸.·´¸.·*´¨) ¸.·*¨)
(¸.·´. (¸.·` *
.·`. Harbour/HMG : It's magic !
(¸.·``··*

Saludos / Regards
DaNiElMaXiMiLiAnO

Whatsapp. := +54901169026142
Telegram Name := DaNiElMaXiMiLiAnO
Top
User avatar
luisvasquezcl
Posts: 1258
Joined: Thu Jul 31, 2008 3:23 am
Location: Chile
Contact:
Contact luisvasquezcl

Re: Menu tipo console manejable con teclado y/o mouse

Post by luisvasquezcl »

Gracias por tu aporte.
Saludos
Top
Post Reply

Return to “HMG Samples”