Sigo sin encontrar el problema, les mando el codigo para que lo miren ....
Disculpen las molestias y muchas gracias ..
**** PROGRAMA DE INICIO ******
Set Sysmenu to
_Screen. Windowstate = 2
SET TALK OFF
SET STATUS BAR OFF
CLOSE ALL
CLEAR ALL
SET CLASSLIB TO misclas
oApp=CREATEOBJECT("entorno")
=Errores2()
WITH _Screen
.BackColor = RGB(255,255,255)
.Closable = .T. && Maximized
.MaxButton = .F. && Maximized
.WindowState = 2 && Maximized
.AddObject ( "Title1", "Title" )
.AddObject ( "Title2", "Title" )
.Title2.Top = .Title2.Top - 4
.Title2.Left = .Title2.Left - 4
.Title2.ForeColor = RGB ( 255, 0, 0 )
ENDWITH
Do menu.prg
Do Form form\formInicio
Do Form Form\formacceso
ON SHUTDOWN CLEAR EVENTS
READ EVENTS
ON SHUTDOWN
CLEAR WINDOW
CLEAR ALL
CLOSE ALL
DEFINE CLASS Title AS LABEL
FontName= [Times New Roman]
FontSize= 28
Visible = .T.
Width = 800
Height = 125
Top = _Screen.Height - 530
Left = 20
Alignment = 2
Caption = [Sistema de Personal Municipal]
ForeColor=RGB ( 192,192,192 )
BackStyle= 0 && Transparent
ENDDEFINE
********* PROGRAMA QUE GENERA EL MENU **************
LOCAL lcAlgunaImagen AS STRING
LOCAL loMenu AS OBJECT
lcAlgunaImagen = ADDBS(HOME()) + "graphics\bitmaps\assorted\happy.bmp"
IF !FILE(lcAlgunaImagen)
lcAlgunaImagen = ""
ENDIF
SET SYSMENU SAVE
SET SYSMENU TO
SET SAFETY ON
SELECT 0
CREATE TABLE MenuDinamico (CCLVUNICA c(6), IGRUPO i, CNOMBRE c(60), CCLVRELAC c(6), ;
CORDER c(6), LPOPUP L, CKEY c(10), CKEYTXT c(10), CCOMANDO c(100), CSKIP c(100), ;
CIMAGEN c(100), LACTIVO L, CNODO c(40))
loMenu = CREATEOBJECT("menudinamico_j","MenuDinamico")
loMenu.GenerarMenuSis()
loMenu = .NULL.
*-- Class: menudinamico_j
DEFINE CLASS menudinamico_j AS CUSTOM
ctabla = "MenuRapido" && dbf que contiene la definicion del menu
cmjeerror = ""
ccursor = ""
nerror = 0
lignorarerror = .F.
NAME = "menudinamico_j"
*-- Llamar para generar el menu de sistema
PROCEDURE generarmenusis
*- GenerarMenuSis
*- Generar el menu de sistema
LOCAL llDevolver AS Boolean
LOCAL lcPupup
THIS.nError = 0
THIS.cMjeerror = ""
IF USED(THIS.cCursor)
USE IN (THIS.cCursor)
ENDIF
*- los pads...
SELECT * FROM (THIS.cTabla) ;
WHERE IGRUPO = 0 AND LACTIVO AND !DELETED() ;
ORDER BY CORDER, CNOMBRE ;
INTO CURSOR (THIS.cCursor)
SELECT (THIS.cCursor)
THIS.lIgnorarerror = .T.
SCAN ALL
IF THIS.nError # 0
EXIT
ENDIF
*- menu sys
IF THIS.ValidarNodo(EVALUATE(THIS.cCursor + '.cNodo'))
THIS.CrearPopup(THIS.CrearPad(), 1)
SELECT (THIS.cCursor)
ENDIF
ENDSCAN
THIS.lIgnorarerror = .F.
USE IN (THIS.cCursor)
RETURN THIS.nError = 0
ENDPROC
PROCEDURE crearpad
*- generar un pad con el actual registro de this.cCursor
*- devuelve el nombre del popup relacionado con el pad creado.
LOCAL lcNombre, lcPrompt, lcKey, lcPopup
lcNombre = "_Pad" + ALLTRIM(EVALUATE(THIS.cCursor + ".CCLVRELAC"))
lcPrompt = ALLTRIM(EVALUATE(THIS.cCursor + ".CNOMBRE"))
lcKey = UPPER(ALLTRIM(EVALUATE(THIS.cCursor + ".CKEY")))
lcPopup = ALLTRIM(EVALUATE(THIS.cCursor + ".CCLVUNICA"))
IF EMPTY(lcKey)
DEFINE PAD (lcNombre) OF _MSYSMENU PROMPT (lcPrompt) COLOR SCHEME 3
ELSE
DEFINE PAD (lcNombre) OF _MSYSMENU PROMPT (lcPrompt) COLOR SCHEME 3 ;
KEY &lcKey, ""
ENDIF
DEFINE POPUP (lcPopup) MARGIN RELATIVE SHADOW COLOR SCHEME 4
ON PAD (lcNombre) OF _MSYSMENU ACTIVATE POPUP (lcPopup)
RETURN lcPopup
ENDPROC
PROCEDURE crearpopup
PARAMETERS tcClaveRelacion, tiNivel
LOCAL liSon, lix
LOCAL ARRAY aTmpArry(1,1)
SELECT cclvunica, lpopup, cNodo FROM (THIS.cTabla);
WHERE IGRUPO = tiNivel AND CCLVRELAC == tcClaveRelacion ;
AND LACTIVO AND NOT DELETED() ;
ORDER BY CORDER, CNOMBRE ;
INTO ARRAY aTmpArry
liSon = _TALLY
FOR lix = 1 TO liSon
IF THIS.nError # 0
EXIT
ENDIF
*- agregar el bar.
IF THIS.ValidarNodo(aTmpArry[lix,3])
THIS.CrearBardelPopup(aTmpArry[lix,1])
IF aTmpArry[lix,2] = .T. && popup
THIS.Crearpopup(aTmpArry[lix,1], tiNivel + 1)
ENDIF
ENDIF
NEXT
ENDPROC
PROCEDURE crearbardelpopup
*- CrearBardelPopup
*- Siempre se crea el bar, luego se analiza si tiene comando o popup
LPARAMETERS tcClaveUnica
SELECT (THIS.cTabla)
LOCATE FOR CCLVUNICA == tcClaveUnica AND !DELETED()
IF !FOUND()
THIS.cMjeerror = "Error del programa Nº 24544-100"
THIS.nError = IIF(THIS.nError = 0, -1, THIS.nError)
RETURN .F.
ENDIF
LOCAL lcNroBar, lcMacro1, lcMacro2, lcImagen
LOCAL lcNombrePopup, lcKey, lcTextoKey, lcSkip, lcNuevoPopup
lcNombrePopup = ALLTRIM(EVALUATE(THIS.cTabla + ".cclvrelac"))
IF EMPTY(lcNombrePopup) OR !POPUP(lcNombrePopup)
THIS.cMjeerror = "El popup " + lcNombrePopup + " no está definido."
THIS.nError = IIF(THIS.nError = 0, -1, THIS.nError)
RETURN .F.
ENDIF
lcNuevoPopup = tcClaveUnica
lcNroBar = TRANSFORM(Barcount(lcNombrePopup) + 1)
lcMacro1 = 'DEFINE BAR ' + lcNroBar + ' OF ' + lcNombrePopup + ;
' PROMPT "' + ALLTRIM(EVALUATE(THIS.cTabla + ".CNOMBRE")) + '" '
lcKey = ALLTRIM(EVALUATE(THIS.cTabla + ".CKEY"))
IF !EMPTY(lcKey)
lcTextoKey = ALLTRIM(EVALUATE(THIS.cTabla + ".CKEYTXT"))
IF EMPTY(lcTextoKey)
lcMacro1 = lcMacro1 + ' KEY ' + lcKey + ',"" '
ELSE
lcMacro1 = lcMacro1 + ' KEY ' + lcKey + ',"' + lcTextoKey + '" '
ENDIF
ENDIF
lcSkip = ALLTRIM(EVALUATE(THIS.cTabla + ".CSKIP"))
IF !EMPTY(lcSkip)
lcMacro1 = lcMacro1 + ' SKIP FOR ' + lcSkip
ENDIF
lcImagen = ALLTRIM(EVALUATE(THIS.cTabla + ".CIMAGEN"))
IF !EMPTY(lcImagen) AND FILE(lcImagen)
lcMacro1 = lcMacro1 + ' PICTURE "' + lcImagen + '" '
ENDIF
THIS.cMjeerror = "Creando bar: " + lcMacro1
&lcMacro1
*- Si es un popup crearlo, sino agregar commando
IF EVALUATE(THIS.cTabla + ".lPopup")
*- El nombre del nuevo popup sera su clave relacionada...
IF EMPTY(lcNuevoPopup)
RETURN .F.
ENDIF
DEFINE POPUP (lcNuevoPopup) MARGIN RELATIVE SHADOW COLOR SCHEME 4
lcMacro2 = 'ON BAR ' + lcNroBar + ' OF ' + lcNombrePopup + ;
' ACTIVATE POPUP ' + lcNuevoPopup + ' '
ELSE
*- crear comando si existe...
IF EMPTY(EVALUATE(THIS.cTabla + ".CCOMANDO"))
RETURN .F.
ENDIF
lcMacro2 = 'ON SELECTION BAR ' + lcNroBar + ' OF ' + lcNombrePopup + ;
' ' + ALLTRIM(EVALUATE(THIS.cTabla + ".CCOMANDO"))
ENDIF
THIS.cMjeerror = "Creando bar: " + lcMacro2
&lcMacro2
IF THIS.nError = 0
THIS.cMjeerror = ""
ENDIF
ENDPROC
PROCEDURE validarnodo
LPARAMETERS tcNododelaDbc
tcNododelaDbc = UPPER(ALLTRIM(tcNododelaDbc))
IF EMPTY(tcNododelaDbc)
*- si no está definido, habilitar...
RETURN .T.
ENDIF
LOCAL lcEsteNodo AS STRING
lcEsteNodo = UPPER(ALLTRIM(SYS(0)))
RETURN lcEsteNodo == tcNododelaDbc
ENDPROC
PROCEDURE INIT
LPARAMETERS tcTablaMenuRapido
THIS.cCursor = "_" + RIGHT(SYS(2015),3) + SUBSTR(SYS(2015),5)
DO WHILE USED(THIS.cCursor)
=INKEY(0.5,'h')
THIS.cCursor = "_" + RIGHT(SYS(2015),3) + SUBSTR(SYS(2015),5)
ENDDO
IF !EMPTY(tcTablaMenuRapido)
tcTablaMenuRapido = JUSTSTEM(tcTablaMenuRapido) + ".DBF"
THIS.cTabla = tcTablaMenuRapido
ENDIF
THIS.cTabla = JUSTSTEM(THIS.cTabla)
IF !USED(THIS.cTabla) AND FILE(THIS.cTabla + ".dbf")
USE (THIS.cTabla + ".dbf") SHARED AGAIN IN 0
ENDIF
IF !USED(THIS.cTabla)
THIS.cMjeerror = THIS.cTabla + " no está en uso."
MESSAGEBOX(THIS.cMjeerror,16,THIS.NAME)
RETURN .F.
ENDIF
RETURN .T.
ENDPROC
PROCEDURE ERROR
LPARAMETERS nError, cMethod, nLine
THIS.nError = nError
THIS.cMjeerror = THIS.cMjeerror + IIF(EMPTY(THIS.cMjeerror),"*- ", " *- " + MESSAGE())
IF !THIS.lIgnorarError
ERROR nError
ENDIF
IF _VFP.STARTMODE = 0
SET STEP ON
ENDIF
ENDPROC
ENDDEFINE
*- EndDefine: menudinamico_j
ACTIVATE MENU
