Aqui está todo el codigo hasta donde lo llevo modificado:
#Include API_Menu.h
Private po_Menu, po_Toolbar
Local lh_Popup, lh_Popup2
Local ln_PopupIndex, ln_SubPopupIndex, ln_ItemPos
Local ll_Bold, ll_Italic, ll_Underline, lc_GraphDir
po_Menu = NewObject( 'PopupMenu', 'OwnerDrawn_Menu' )
If (VarType( po_Menu ) != 'O')
Return
endif
** Just in case somethings going wrong (for debugging purposes)
On key label ALT+F10 Do QuitProg
lc_GraphDir = '\consultas\Bitmaps\'
With po_Menu
.hWndParent = _VFP.hWnd
** Set menu properties
Store .F. to .lUseGradientPad, .lFullRectLine, .lThemed
.lUseGradient = .T.
.nHiliteStyle = ODHS_ALL
.SetRightColor( GetSysColor( COLOR_WINDOW ), .F. )
Dimension .aMenuPad[ 3, 2 ] &&El arreglo debe de ser de n filas y 2 columnas
.aMenuPad[ 1, 1 ] = 'Archivos'
.aMenuPad[ 1, 2 ] = '1' && Key is Alt+1
.aMenuPad[ 2, 1 ] = 'Consulta de Datos'
.aMenuPad[ 2, 2 ] = '2' && Key is Alt+2
.aMenuPad[ 3, 1 ] = 'Mantenimiento'
.aMenuPad[ 3, 2 ] = '3' && Key is Alt+3
.CreatePad()
** Popup Index = 1
.CreatePopupItem( 4 )
.aPopupItem[1] = 'Altas de Registro'
.aPopupItem[2] = 'Modificar Registro'
.aPopupItem[3] = ' '
.aPopupItem[4] = 'Eliminar Registro'
.aPopupBmp[1] = lc_GraphDir + 'OpenFold.BMP'
.aPopupBmp[2] = lc_GraphDir + 'ClsdFold.BMP'
.aPopupBmp[4] = lc_GraphDir + 'Waste.BMP'
ln_PopupIndex = 1
ln_ItemPos = 2
.CreatePopup( 1001, ln_PopupIndex )
** Popup Index = 2
.CreatePopupItem( 2 )
.aPopupItem[1] = 'Consultar Registro'
.aPopupItem[2] = 'Impresion'
.aPopupBmp[1] = lc_GraphDir + 'OpenFold.BMP'
.aPopupBmp[2] = lc_GraphDir + 'ClsdFold.BMP'
ll_Bold = .F.
ll_Italic = .F.
ll_Underline = .T.
.hFontCustom = .CreateCustomFont( ll_Bold, ll_Italic , ll_Underline )
lh_Popup = .CreatePopup( 2001, 2 )
** Popup Index = 3
.CreatePopupItem( 3 )
.aPopupItem[1] = 'Respaldar Información'
.aPopupItem[2] = ' '
.aPopupItem[3] = 'Restaurar Copia de Datos'
.aPopupBmp[1] = lc_GraphDir + 'OpenFold.BMP'
.aPopupBmp[3] = lc_GraphDir + 'ClsdFold.BMP'
ln_SubPopupIndex = 3
ln_ItemPos = 3 && Parent Popup item position to be modify
lh_Popup2 = .CreatePopup( 2201, ln_SubPopupIndex )
.SetSubPopup( lh_Popup, ln_ItemPos, ln_SubPopupIndex )
** Set Submenu to MainMenu
.SetSubmenu( 1, 1 )
.SetSubmenu( 2, 2 )
.SetSubmenu( 3, 3 )
.BindMessages()
Activate menu (.cMenuName) nowait
EndWith
po_Toolbar = NewObject( 'MyToolbar' )
po_Toolbar.Visible = .T.
Read events
po_Menu = Null
Release po_Menu
On key label ALT+F10
Release popup all
Clear class PopupMenu
Clear resources
Set SysMenu to default
Note;
Hasta aquí todo va bien...
******************************************
No es un error el que me marca solo no responde el encabezado, por ejemplo, si pulso en el primer encabezado algun subindice, digamos Altas, entro bien y me salgo del form, pero quiero pulsar el segundo encabezado y nada, no hace nada, como que se queda con algun valor que identifica solo el primer encabezado.
¡¡ Y no sé porqué presiento que ha de ser algo sencillo !!.........me frusto porque casi está terminado y el encabezado no responde....
*****************************************
&& El problema empieza aquí:
Procedure QuitProg
If (VarType( po_Toolbar ) == 'O')
po_Toolbar = Null
Release po_Toolbar
endif
Clear events
EndProc
Procedure OnSelection( tn_MenuPos, tn_ItemId )
Do case
Case (tn_MenuPos == 1)
FirstMenu( tn_MenuPos, tn_ItemId - 1000 )
ENDCASE
EndProc
Procedure FirstMenu( tn_MenuPos, tn_ItemPos )
With po_Menu
Do case
Case (tn_ItemPos = 1)
DO FORM altas.scx
Case (tn_ItemPos = 2)
DO FORM modificacion.scx
Case (tn_ItemPos = 3)
Case (tn_ItemPos = 4)
DO FORM eliminacion.scx
EndCase
EndWith
EndProc
*****************************
Procedure OnSelection( tn_MenuPos, tn_ItemId )
Do case
Case (tn_MenuPos == 2)
FirstMenu( tn_MenuPos, tn_ItemId - 2000 )
ENDCASE
EndProc
Procedure FirstMenu( tn_MenuPos, tn_ItemPos )
With po_Menu
Do case
Case (tn_ItemPos = 1)
DO FORM busquedas.scx
EndCase
EndWith
EndProc
*****************************FIN
Note;
Cabe mencionar Ernesto, que: el segundo encabezado solo copie el primero y le cambie en:
Case (tn_MenuPos == 2)
FirstMenu( tn_MenuPos, tn_ItemId - 2000 )
Espero me haya explicado...
Gracias►
Si deseas te paso el prg modificado y la clase para que lo pruebes tu mismo...
