romfast/foxbin2prg
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Changeset: 436 v1.19.33

Browse Source 
- Bug mnx: El menú no se genera bien cuando hay Bars del tipo #BAR y nombre vacío (Peter Hipp)
- Bug mnx: Si una opción tiene asociado un Procedure de 1 línea, no se mantiene como Procedure y se convierte a Command (Peter Hipp)
This commit is contained in:
fdbozzo
2014-08-29 13:11:53 +02:00
parent ab7d3fe2a8 d5c1a807b4
commit 7c5dbd20de
10 changed files with 146 additions and 102 deletions
Download Patch File Download Diff File Expand all files Collapse all files

0
TESTS/FoxPro9_Order_for_Control_Properties.xlsx → Documentacion/FoxPro9_Order_for_Control_Properties.xlsx
View File

BIN
Documentacion/Visual FoxPro 9 - MENUS - Combinaciones de ObjType y ObjCode.docx Normal file
View File

Binary file not shown.

BIN
Documentacion/Visual FoxPro 9 - MENUS - Combinaciones de ObjType y ObjCode.odt Normal file
View File

Binary file not shown.

BIN
Documentacion/Visual FoxPro 9 - MENUS - Combinaciones de ObjType y ObjCode.pdf Normal file
View File

Binary file not shown.

10
FoxBin2PRGVersionFile.txt
View File

@@ -2,8 +2,8 @@ Lparameters toUpdateInfo
Local lcNote
With toUpdateInfo
.VersionNumber = 'v1.19.32'
.VersionDate = Date(2014,08,26)
.VersionNumber = 'v1.19.33'
.VersionDate = Date(2014,08,29)
.SourceFileUrl = 'http://vfpxrepository.com/dl/thorupdate/Projects/FoxBin2Prg/FoxBin2Prg.Zip'
.Link = 'http://vfpx.codeplex.com/wikipage?title=FoxBin2PRG'
@@ -17,8 +17,12 @@ Demo video using FoxBin2Prg with PlasticSCM: http://youtu.be/sE4wQ50Itqg
Change History -------------------------------------------------------------
2014/08/29 v1.19.33
- Bug Fix mnx: Menu doesn't generate well when there is a Bar of #BAR type without a name (Peter Hipp)
- Bug Fix mnx: If a menu option have an associated Procedure with 1 line of code, the Procedure is converted to Command (Peter Hipp)
2014/08/26 v1.19.32
- If exists a property called "text" it is confused with a text/endtext structure (ph42)
- If exists a property called "text" it is confused with a text/endtext structure (Peter Hipp)
2014/08/22 v1.19.31
- Trash cleanup code on binary methods, normally added by tools like ReFox and others

BIN
foxbin2prg.exe
View File

Binary file not shown.

4
foxbin2prg.pj2
View File

@@ -23,10 +23,10 @@ _CompanyName = "Fernando D. Bozzo"
_FileDescription = "Conversor bidireccional de binarios FoxPro 9 (scx,vcx,pjx) a texto para sustituir al scctext :-)"
_LegalCopyright = "Creative Commons 4: Reconocimiento - CompartirIgual (by-sa): http://creativecommons.org/licenses/by/4.0/"
_LegalTrademark = "Creative Commons 4: Reconocimiento - CompartirIgual (by-sa): http://creativecommons.org/licenses/by/4.0/"
_ProductName = " FOXBIN2PRG v1.19.31"
_ProductName = "FOXBIN2PRG"
_MajorVer = "1"
_MinorVer = "19"
_Revision = "32"
_Revision = "33"
_LanguageID = "1034"
_AutoIncrement = "0"
*</DevInfo>

BIN
foxbin2prg.pjt
View File

Binary file not shown.

BIN
foxbin2prg.pjx
View File

Binary file not shown.

234
foxbin2prg.prg
View File

@@ -101,7 +101,9 @@
* 17/08/2014 FDBOZZO v1.19.31 Agregada versi<73>n del EXE cuando se genera LOG de depuraci<63>n
* 20/08/2014 FDBOZZO v1.19.31 Mejora vcx/scx: Mejorado el reconocimiento de instrucciones #IF..#ENDIF cuando hay espacios entre # y el nombre de funci<63>n
* 20/08/2014 FDBOZZO v1.19.31 Mejora: Ajuste de capitalizaci<63>n de los archivos origen, as<61> ya no hay que hacerlo manualmente
* 25/08/2014 FDBOZZO v1.19.32 Arreglo bug vcx/vct v1.19.31: Una propiedad llamada "text" es confundida con la estructura text/endtext (ph42)
* 25/08/2014 FDBOZZO v1.19.32 Arreglo bug vcx/vct v1.19.31: Una propiedad llamada "text" es confundida con la estructura text/endtext (Peter Hipp)
* 27/08/2014 FDBOZZO v1.19.33 Arreglo bug mnx v1.19.32: Si se crea un men<65> con una opci<63>n de tipo #Bar vac<61>a, el men<65> se genera mal (Peter Hipp)
* 29/08/2014 FDBOZZO v1.19.33 Arreglo bug mnx v1.19.32: Si una opci<63>n tiene asociado un Procedure de 1 l<>nea, no se mantiene como Procedure y se convierte a Command (Peter Hipp)
* </HISTORIAL DE CAMBIOS Y NOTAS IMPORTANTES>
*
*---------------------------------------------------------------------------------------------------
@@ -142,8 +144,10 @@
* 21/07/2014 Edyshor PROPUESTA DE MEJORA db2 v1.19.27: Ser<65>a <20>til poder filtrar tablas y datos cuando se elige DBF_Conversion_Support:4 (Agregado en v1.19.28)
* 29/07/2014 M_N_M REPORTE BUG vcx/scx v1.19.28: Los campos de tabla con nombre "text" a veces provocan corrupci<63>n del binario generado (Arreglado en v1.19.29)
* 07/08/2014 Jim Nelson REPORTE BUG vcx/scx v1.19.29: Cuando la l<>nea anterior a un ENDTEXT termina en ";" o "," no se reconoce como ENDTEXT sino como continuaci<63>n (Arreglado en v1.19.30)
* 08/08/2014 Ryan Harris REPORTE BUG vcx/vct v1.19.29: En ciertos casos de herencia no se mantiene el orden alfabetico de algunos metodos (solucionado en v1.19.30)
* 25/08/2014 ph42 REPORTE BUG bug vcx/vct v1.19.31: Una propiedad llamada "text" es confundida con la estructura text/endtext (solucionado en v1.19.32)
* 08/08/2014 Ryan Harris REPORTE BUG vcx/scx v1.19.29: En ciertos casos de herencia no se mantiene el orden alfabetico de algunos metodos (solucionado en v1.19.30)
* 25/08/2014 Peter Hipp REPORTE BUG bug vcx/scx v1.19.31: Una propiedad llamada "text" es confundida con la estructura text/endtext (solucionado en v1.19.32)
* 27/08/2014 Peter Hipp REPORTE BUG bug mnx v1.19.32: Si se crea un men<65> con una opci<63>n de tipo #Bar vac<61>a, el men<65> se genera mal (solucionado en v1.19.33)
* 28/08/2014 Peter Hipp REPORTE BUG bug mnx v1.19.32: Si una opci<63>n tiene asociado un Procedure de 1 l<>nea, no se mantiene como Procedure y se convierte a Command (solucionado en v1.19.33)
* </TESTEO Y REPORTE DE BUGS (AGRADECIMIENTOS)>
*
*---------------------------------------------------------------------------------------------------
@@ -328,6 +332,28 @@ LPARAMETERS tc_InputFile, tcType, tcTextName, tlGenText, tcDontShowErrors, tcDeb
#DEFINE FILETYPE_TEXT "T" && Text (.TXT, .H., etc.)
#DEFINE FILETYPE_OTHER "x" && Other file types not enumerated above
*-- Menu OBJTYPE constants
#DEFINE C_OBJTYPE_MENUTYPE_DEFAULT 1
#DEFINE C_OBJTYPE_MENUTYPE_BARorPOPUP 2
#DEFINE C_OBJTYPE_MENUTYPE_OPTION 3
#DEFINE C_OBJTYPE_MENUTYPE_SHORTCUT 4
#DEFINE C_OBJTYPE_MENUTYPE_MENUBARONTOP 5
*-- Menu OBJCODE constants
#DEFINE C_OBJCODE_MENUBARPOPUP_MENUPAD 0
#DEFINE C_OBJCODE_MENUBARPOPUP_MENUBAR 1
#DEFINE C_OBJCODE_MENUDEFAULT_DEFAULT 22
#DEFINE C_OBJCODE_MENUOPTION_COMMAND 67
#DEFINE C_OBJCODE_MENUOPTION_SUBMENU 77
#DEFINE C_OBJCODE_MENUOPTION_BARNUM 78
#DEFINE C_OBJCODE_MENUOPTION_PROCEDURE 80
*-- Menu Location constants
#DEFINE C_MENULOCATION_REPLACE 0
#DEFINE C_MENULOCATION_APPEND 1
#DEFINE C_MENULOCATION_BEFORE 2
#DEFINE C_MENULOCATION_AFTER 3
*-- Server Object Instancing Property
#DEFINE SERVERINSTANCE_SINGLEUSE 1 && Single use server
#DEFINE SERVERINSTANCE_NOTCREATABLE 2 && Instances creatable only inside Visual FoxPro
@@ -17440,14 +17466,15 @@ DEFINE CLASS CL_MENU_COL_BASE AS CL_COL_BASE
llRetorno = .F.
EXIT
CASE loReg.ObjType = 3 AND toReg.ObjType = 3 OR loReg.ObjType = 2 AND toReg.ObjType = 2
CASE INLIST( loReg.ObjType, C_OBJTYPE_MENUTYPE_OPTION, C_OBJTYPE_MENUTYPE_BARorPOPUP ) ;
AND toReg.ObjType = loReg.ObjType
*-- Un objeto Option no puede anidar a otro Option,
*-- y un objeto Bar/Popup no puede anidar a otro Bar/Popup
SKIP -1
llRetorno = .F.
EXIT
CASE loReg.ObjType = 2 && Bar or Popup
CASE loReg.ObjType = C_OBJTYPE_MENUTYPE_BARorPOPUP && Bar or Popup
loBarPop = NULL
loBarPop = CREATEOBJECT('CL_MENU_BARPOP')
llHayDatos = loBarPop.get_DataFromTablabin( loReg, toCol_LastLevelName )
@@ -17455,18 +17482,18 @@ DEFINE CLASS CL_MENU_COL_BASE AS CL_COL_BASE
llRetorno = llHayDatos
.ADD( loBarPop )
loBarPop = NULL
IF NOT llHayDatos AND toReg.ObjType = 3
IF NOT llHayDatos AND toReg.ObjType = C_OBJTYPE_MENUTYPE_OPTION
EXIT
ENDIF
CASE loReg.ObjType = 3 && Option
CASE loReg.ObjType = C_OBJTYPE_MENUTYPE_OPTION && Option
loOption = NULL
loOption = CREATEOBJECT('CL_MENU_OPTION')
llHayDatos = loOption.get_DataFromTablabin( loReg, toCol_LastLevelName )
llRetorno = llHayDatos
.ADD( loOption )
loOption = NULL
IF NOT llHayDatos AND toReg.ObjType = 3
IF NOT llHayDatos AND toReg.ObjType = C_OBJTYPE_MENUTYPE_OPTION
EXIT
ENDIF
@@ -17486,7 +17513,7 @@ DEFINE CLASS CL_MENU_COL_BASE AS CL_COL_BASE
THROW
FINALLY
IF toReg.ObjType = 2
IF toReg.ObjType = C_OBJTYPE_MENUTYPE_BARorPOPUP
lnLastKey = toCol_LastLevelName.GETKEY(toReg.LevelName)
IF lnLastKey > 0
toCol_LastLevelName.REMOVE(lnLastKey)
@@ -17518,11 +17545,12 @@ DEFINE CLASS CL_MENU_COL_BASE AS CL_COL_BASE
* tcSourceCode (@? IN ) Si se indica, se buscar<61> el nombre de Procedure para obtener su c<>digo
* tnIndentation (v? IN ) En caso de devolver c<>digo, indica si se debe indentar o quitar indentaci<63>n
* tlAddProcEndproc (v? IN ) En caso de devolver c<>digo, indica si se debe encerrar con PROCEDURE/ENDPROC
* tlForceProcedure (v? IN ) Indica que se eval<61>e como Procedure, no como Command
*---------------------------------------------------------------------------------------------------
* DETALLE: Los menus guardan en los primeros registros los Comandos o Procedimientos en el campo PROCEDURE,
* y luego al generar el c<>digo lo muestran como Comando si es una sola l<>nea, y si no como Procedure.
*---------------------------------------------------------------------------------------------------
LPARAMETERS tcExpr, tcProcName, tcProcCode, tcSourceCode, tnIndentation, tlAddProcEndproc
LPARAMETERS tcExpr, tcProcName, tcProcCode, tcSourceCode, tnIndentation, tlAddProcEndproc, tlForceProcedure
LOCAL laProcLines(1), lnLine_Count, I
tcProcName = ''
@@ -17530,7 +17558,7 @@ DEFINE CLASS CL_MENU_COL_BASE AS CL_COL_BASE
tnIndentation = EVL(tnIndentation,0)
lnLine_Count = ALINES( laProcLines, tcExpr )
IF lnLine_Count > 1
IF lnLine_Count > 1 OR tlForceProcedure
*-- ES UN PROCEDIMIENTO
tcProcCode = tcExpr
@@ -17675,14 +17703,14 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
toConversor.c_MenuLocation = STREXTRACT( tcLine, C_MENULOCATION_I, C_MENULOCATION_F )
DO CASE
CASE toConversor.c_MenuLocation == 'REPLACE'
loReg.Location = 0
loReg.Location = C_MENULOCATION_REPLACE
CASE toConversor.c_MenuLocation == 'APPEND'
loReg.Location = 1
loReg.Location = C_MENULOCATION_APPEND
OTHERWISE
IF LEFT(toConversor.c_MenuLocation,7) == 'BEFORE'
loReg.Location = 2
loReg.Location = C_MENULOCATION_BEFORE
ELSE
loReg.Location = 3
loReg.Location = C_MENULOCATION_AFTER
ENDIF
loReg.NAME = GETWORDNUM(toConversor.c_MenuLocation,2)
ENDCASE
@@ -17882,12 +17910,12 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
CASE LEFT( tcLine, LEN(C_MENUCODE_I) ) == C_MENUCODE_I
CASE LEFT( tcLine, 12 ) == 'DEFINE MENU '
loReg.OBJCODE = 22
loReg.PROCTYPE = 1
loReg.MARK = CHR(4)
loReg.SETUPTYPE = 1
loReg.CLEANTYPE = 1
loReg.ITEMNUM = STR(0,3)
loReg.OBJCODE = C_OBJCODE_MENUDEFAULT_DEFAULT
loReg.ProcType = 1
loReg.Mark = CHR(4)
loReg.SetupType = 1
loReg.CleanType = 1
loReg.ItemNum = STR(0,3)
lcMenuType = ALLTRIM( GETWORDNUM( tcLine, 3 ) )
*loReg.ObjType = IIF( UPPER(lcMenuType) = '_MSYSMENU', 1, 5 )
@@ -17916,13 +17944,13 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
EXIT
CASE LEFT( tcLine, 13 ) == 'DEFINE POPUP '
loReg.OBJCODE = 22
loReg.PROCTYPE = 1
loReg.OBJCODE = C_OBJCODE_MENUDEFAULT_DEFAULT
loReg.ProcType = 1
loReg.MARK = CHR(4)
loReg.SETUPTYPE = 1
loReg.CLEANTYPE = 1
loReg.ITEMNUM = STR(0,3)
loReg.SCHEME = 0
loReg.SetupType = 1
loReg.CleanType = 1
loReg.ItemNum = STR(0,3)
loReg.Scheme = 0
lcExpr = ALLTRIM( STREXTRACT( C_FB2PRG_CODE, 'ON SELECTION POPUP ALL ', CR_LF ) )
.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1, .F. )
@@ -17947,15 +17975,16 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
loOption = NULL
loOption = CREATEOBJECT("CL_MENU_OPTION")
loOption.oReg = toConversor.emptyRecord()
WITH loOption.oReg
.ObjType = 3
.OBJCODE = 77
.ObjType = C_OBJTYPE_MENUTYPE_OPTION
.OBJCODE = C_OBJCODE_MENUOPTION_SUBMENU
.MARK = CHR(0)
.PROMPT = '\<Shortcut'
.LevelName = '_MSYSMENU'
loBarPop.ADD( loOption )
loBarPop.oReg.NUMITEMS = loBarPop.COUNT
.ITEMNUM = STR(loBarPop.COUNT,3)
.ItemNum = STR(loBarPop.COUNT,3)
.SCHEME = 0
loBarPop = NULL
ENDWITH
@@ -18072,13 +18101,13 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
lnNivel = 0
DO CASE
CASE loReg.Location = 0
CASE loReg.Location = C_MENULOCATION_REPLACE
lcLocation = 'REPLACE'
CASE loReg.Location = 1
CASE loReg.Location = C_MENULOCATION_APPEND
lcLocation = 'APPEND'
CASE loReg.Location = 2
CASE loReg.Location = C_MENULOCATION_BEFORE
lcLocation = 'BEFORE ' + loReg.NAME
CASE loReg.Location = 3
CASE loReg.Location = C_MENULOCATION_AFTER
lcLocation = 'AFTER ' + loReg.NAME
ENDCASE
@@ -18102,13 +18131,13 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
ENDTEXT
DO CASE
CASE loHeader.ObjType = 1 && Menu Bar (Sistema)
CASE loHeader.ObjType = C_OBJTYPE_MENUTYPE_DEFAULT && Menu Bar (Sistema)
lcText = lcText + CR_LF + 'DEFINE MENU ' + loBarPop.NAME + ' BAR'
CASE loHeader.ObjType = 5 && Menu Bar (On top)
CASE loHeader.ObjType = C_OBJTYPE_MENUTYPE_MENUBARONTOP && Menu Bar (On top)
lcText = lcText + CR_LF + 'DEFINE MENU ' + loBarPop.NAME + ' BAR'
CASE loHeader.ObjType = 4 && Shortcut
CASE loHeader.ObjType = C_OBJTYPE_MENUTYPE_SHORTCUT && Shortcut
lcText = lcText + CR_LF + 'DEFINE POPUP ' + .ITEM(1).ITEM(1).ITEM(1).oReg.NAME + ' SHORTCUT RELATIVE FROM MROW(),MCOL()'
ENDCASE
@@ -18124,8 +18153,8 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
loBarPop = .ITEM(1).oReg
DO CASE
CASE loHeader.ObjType = 1 OR loHeader.ObjType = 5
*-- Propecimiento principal de _MSYSMENU (ObjType:1, ObjCode:22)
CASE loHeader.ObjType = C_OBJTYPE_MENUTYPE_DEFAULT OR loHeader.ObjType = C_OBJTYPE_MENUTYPE_MENUBARONTOP
*-- Propecimiento principal de _MSYSMENU (ObjType:1, ObjCode:22) (C_OBJTYPE_MENUTYPE_DEFAULT, C_OBJCODE_MENUDEFAULT_DEFAULT)
IF NOT EMPTY(loHeader.PROCEDURE)
lcExpr = loHeader.PROCEDURE
.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, '', 1, .T. )
@@ -18142,7 +18171,7 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
ENDIF
ENDIF
CASE loHeader.ObjType = 4
CASE loHeader.ObjType = C_OBJTYPE_MENUTYPE_SHORTCUT
IF NOT EMPTY(loHeader.PROCEDURE)
lcExpr = loHeader.PROCEDURE
.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, '', 1, .T. )
@@ -18274,7 +18303,7 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
+ ', ObjCode=' + TRANSFORM(loReg.OBJCODE) ;
+ ', Name=' + TRANSFORM(loReg.NAME) ;
+ ', LevelName=' + TRANSFORM(loReg.LevelName) ;
+ ', ItemNum=' + TRANSFORM(loReg.ITEMNUM) ;
+ ', ItemNum=' + TRANSFORM(loReg.ItemNum) ;
+ ', Location=' + TRANSFORM(loReg.Location) ;
+ ', Prompt=' + TRANSFORM(loReg.PROMPT) ;
+ ', Message=' + TRANSFORM(loReg.MESSAGE) ;
@@ -18362,10 +18391,10 @@ DEFINE CLASS CL_MENU_BARPOP AS CL_MENU_COL_BASE
WITH THIS AS CL_MENU_BARPOP OF 'FOXBIN2PRG.PRG'
.oReg = toConversor.emptyRecord()
loReg = .oReg
loReg.ObjType = 2
loReg.PROCTYPE = 1
loReg.ObjType = C_OBJTYPE_MENUTYPE_BARorPOPUP
loReg.ProcType = 1
loReg.MARK = CHR(0)
loReg.ITEMNUM = STR(0,3)
loReg.ItemNum = STR(0,3)
llBloqueEncontrado = .T.
FOR I = I + 0 TO tnCodeLines
@@ -18386,28 +18415,28 @@ DEFINE CLASS CL_MENU_BARPOP AS CL_MENU_COL_BASE
EXIT
CASE LEFT( tcLine, 12 ) == 'DEFINE MENU '
loReg.OBJCODE = 1
loReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUBAR
loReg.NAME = STREXTRACT( tcLine, 'DEFINE MENU ', ' BAR' )
*loReg.NAME = '_MSYSMENU'
loReg.LevelName = loReg.NAME
loReg.SCHEME = IIF( loReg.OBJCODE = 1, 3, 4 )
loReg.SCHEME = IIF( loReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUBAR, 3, 4 )
lcExpr = STREXTRACT( C_FB2PRG_CODE, 'ON SELECTION POPUP ALL ', CR_LF )
.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1 )
loReg.PROCEDURE = EVL(lcProcCode, lcExpr)
CASE LEFT( tcLine, 13 ) == 'DEFINE POPUP '
IF .n_ParentCode = 22
loReg.OBJCODE = 1
IF .n_ParentCode = C_OBJCODE_MENUDEFAULT_DEFAULT
loReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUBAR
loReg.NAME = '_MSYSMENU'
loReg.LevelName = loReg.NAME
loReg.SCHEME = 3
IF .n_ParentType = 4
IF .n_ParentType = C_OBJTYPE_MENUTYPE_SHORTCUT
EXIT
ENDIF
ELSE
loReg.OBJCODE = 0
loReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUPAD
loReg.SCHEME = 4
loReg.NAME = ALLTRIM( GETWORDNUM( tcLine, 3 ) )
@@ -18436,9 +18465,9 @@ DEFINE CLASS CL_MENU_BARPOP AS CL_MENU_COL_BASE
ENDIF
.ADD( loOption )
loOption.oReg.ITEMNUM = STR(.COUNT,3)
loOption.oReg.ItemNum = STR(.COUNT,3)
loReg.NUMITEMS = .COUNT
loReg.SCHEME = IIF( loReg.OBJCODE = 1, 3, 4 )
loReg.SCHEME = IIF( loReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUBAR, 3, 4 )
loOption = NULL
OTHERWISE && Otro valor
@@ -18484,10 +18513,9 @@ DEFINE CLASS CL_MENU_BARPOP AS CL_MENU_COL_BASE
loReg = THIS.oReg
lcTab = REPLICATE(CHR(9),tnNivel)
*-- Menu Bar or Popup (ObjType:2, ObjCode:0 <20> 1)
IF loReg.OBJCODE = 0 && (Menu Pad)
IF toHeader.ObjType = 4
IF loReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUPAD && (Menu Pad)
IF toHeader.ObjType = C_OBJTYPE_MENUTYPE_SHORTCUT
*-- Shortcut
IF NOT PEMSTATUS(toHeader,'_MenuInicializado', 5) && Header
ADDPROPERTY(toHeader,'_MenuInicializado', .T.)
@@ -18497,7 +18525,7 @@ DEFINE CLASS CL_MENU_BARPOP AS CL_MENU_COL_BASE
<<lcTab>>DEFINE POPUP <<loReg.Name>> SHORTCUT RELATIVE
ENDTEXT
ENDIF
ELSE && ObjType = 1 <20> 5
ELSE && ObjType = C_OBJTYPE_MENUTYPE_DEFAULT o C_OBJTYPE_MENUTYPE_MENUBARONTOP
*-- Menu
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<lcTab>>*----------------------------------
@@ -18520,13 +18548,15 @@ DEFINE CLASS CL_MENU_BARPOP AS CL_MENU_COL_BASE
IF EMPTY(lcProcCode)
*-- Comando
lcText = lcText + lcTab + 'ON SELECTION POPUP ' + IIF( loReg.OBJCODE = 0, loReg.NAME, 'ALL' ) + ' ' + lcExpr + CR_LF
lcText = lcText + lcTab + 'ON SELECTION POPUP ' ;
+ IIF( loReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUPAD, loReg.NAME, 'ALL' ) + ' ' + lcExpr + CR_LF
ELSE
*-- Procedure
IF EMPTY(lcProcName)
lcProcName = CHRTRAN( ALLTRIM( IIF( loReg.OBJCODE = 0, loReg.NAME, 'ALL' ) ), ' ', '_' ) + '_FB2P'
lcProcName = CHRTRAN( ALLTRIM( IIF( loReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUPAD, loReg.NAME, 'ALL' ) ), ' ', '_' ) + '_FB2P'
ENDIF
lcText = lcText + lcTab + 'ON SELECTION POPUP ' + IIF( loReg.OBJCODE = 0, loReg.NAME, 'ALL' ) + ' DO ' + lcProcName + CR_LF
lcText = lcText + lcTab + 'ON SELECTION POPUP ' ;
+ IIF( loReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUPAD, loReg.NAME, 'ALL' ) + ' DO ' + lcProcName + CR_LF
tcEndProcedures = tcEndProcedures + STRTRAN( lcProcCode, '<<ProcName>>', lcProcName ) + CR_LF
ENDIF
@@ -18603,7 +18633,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
.oReg = toConversor.emptyRecord()
loReg = .oReg
loReg.MARK = CHR(0)
loReg.ITEMNUM = STR(0,3)
loReg.ItemNum = STR(0,3)
llBloqueEncontrado = .T.
@@ -18621,8 +18651,8 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
EXIT
CASE LEFT( tcLine, LEN(C_MENUCODE_I) ) == C_MENUCODE_I
loReg.ObjType = 2
loReg.OBJCODE = 1
loReg.ObjType = C_OBJTYPE_MENUTYPE_BARorPOPUP
loReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUBAR
CASE .analizarBloque_DefinePAD( @tcLine, @taCodeLines, @I, tnCodeLines, toConversor )
IF EMPTY(loReg.PROMPT)
@@ -18630,7 +18660,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
llBloqueEncontrado = .F.
EXIT
ENDIF
IF loReg.OBJCODE <> 77
IF loReg.OBJCODE <> C_OBJCODE_MENUOPTION_SUBMENU
EXIT
ENDIF
@@ -18640,7 +18670,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
llBloqueEncontrado = .F.
EXIT
ENDIF
IF loReg.OBJCODE <> 77
IF loReg.OBJCODE <> C_OBJCODE_MENUOPTION_SUBMENU
EXIT
ENDIF
@@ -18722,7 +18752,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
WITH THIS AS CL_MENU_OPTION OF 'FOXBIN2PRG.PRG'
loReg = .oReg
loReg.ObjType = 3
loReg.ObjType = C_OBJTYPE_MENUTYPE_OPTION
lcPadName = ALLTRIM( STREXTRACT( tcLine, 'PAD ' , ' OF' ) )
loReg.NAME = lcPadName
loReg.LevelName = ALLTRIM( STREXTRACT( tcLine, ' OF ', ' PROMPT ' ) )
@@ -18807,7 +18837,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
LOOP
CASE LEFT( tcLine, 7 ) == 'ON PAD '
loReg.OBJCODE = 77 && Submenu
loReg.OBJCODE = C_OBJCODE_MENUOPTION_SUBMENU && Submenu
I = I + 1
EXIT
@@ -18818,18 +18848,18 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
DO CASE
CASE EMPTY(lcProcCode)
loReg.OBJCODE = 67
loReg.COMMAND = lcExpr
loReg.OBJCODE = C_OBJCODE_MENUOPTION_COMMAND
loReg.Command = lcExpr
OTHERWISE
loReg.PROCEDURE = STRTRAN( lcProcCode, '<<ProcName>>', lcProcName )
IF EMPTY( loReg.PROCEDURE )
loReg.OBJCODE = 67
loReg.OBJCODE = C_OBJCODE_MENUOPTION_COMMAND
loReg.COMMAND = lcExpr
ELSE
loReg.OBJCODE = 80
loReg.PROCTYPE = 1
loReg.OBJCODE = C_OBJCODE_MENUOPTION_PROCEDURE
loReg.ProcType = 1
ENDIF
ENDCASE
@@ -18912,7 +18942,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
WITH THIS AS CL_MENU_OPTION OF 'FOXBIN2PRG.PRG'
loReg = .oReg
loReg.ObjType = 3
loReg.ObjType = C_OBJTYPE_MENUTYPE_OPTION
lcBarName = ALLTRIM( STREXTRACT( tcLine, 'BAR ' , ' OF' ) )
IF NOT ISDIGIT(lcBarName)
@@ -18987,7 +19017,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
IF LEFT(lcBarName,1) == '_'
*-- Es un BAR del Sistema, as<61> que no tiene ON BAR ni nada m<>s.
loReg.OBJCODE = 78 && Bar#
loReg.OBJCODE = C_OBJCODE_MENUOPTION_BARNUM && Bar#
I = I + 1
EXIT
ENDIF
@@ -18998,9 +19028,10 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
* ON BAR _3YM1DR90Z OF _MSYSMENU ACTIVATE POPUP Opci<63>nA_CS
* ON BAR _3YM1DR90Z OF _MSYSMENU wait window "algo"
* ON BAR _3YM1DR90Z OF _MSYSMENU DO Menu1_Opci<63>n_A_2_Sub_SNIPPET
* ON SELECTION BAR 1 OF Contracts DO BAR_1_OF_Contracts_FB2P
*--------------------------------
*-- ANALISIS DEL "ON BAR" u "ON SELECTION BAR"
*-- ANALISIS DEL "ON BAR" U "ON SELECTION BAR"
FOR I = I + 1 TO tnCodeLines
.set_Line( @tcLine, @taCodeLines, I )
@@ -19008,8 +19039,14 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
CASE EMPTY( tcLine )
LOOP
CASE INLIST( LEFT( tcLine, 11 ), 'DEFINE BAR ', 'DEFINE PAD ' )
*-- Se encontr<74> el siguiente DEFINE BAR/PAD, por lo que el analizado es de tipo #BAR vac<61>o
*-- y no tiene ON BAR ni nada m<>s.
loReg.OBJCODE = C_OBJCODE_MENUOPTION_BARNUM && Bar#
EXIT
CASE LEFT( tcLine, 7 ) == 'ON BAR '
loReg.OBJCODE = 77 && Submenu
loReg.OBJCODE = C_OBJCODE_MENUOPTION_SUBMENU && Submenu
I = I + 1
EXIT
@@ -19023,15 +19060,15 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
loReg.PROCEDURE = STRTRAN( lcProcCode, '<<ProcName>>', lcProcName )
IF EMPTY( loReg.PROCEDURE )
loReg.OBJCODE = 67
loReg.OBJCODE = C_OBJCODE_MENUOPTION_COMMAND
loReg.COMMAND = lcExpr
ELSE
loReg.OBJCODE = 80
loReg.PROCTYPE = 1
loReg.OBJCODE = C_OBJCODE_MENUOPTION_PROCEDURE
loReg.ProcType = 1
ENDIF
OTHERWISE
loReg.OBJCODE = 67 && Command
loReg.OBJCODE = C_OBJCODE_MENUOPTION_COMMAND && Command
loReg.COMMAND = lcExpr
ENDCASE
@@ -19089,15 +19126,16 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
lcTab = REPLICATE(CHR(9),tnNivel)
loBarPop = toParentReg
*-- Options (ObjType:3)
*-- Options (ObjType:3 = C_OBJTYPE_MENUTYPE_OPTION)
DO CASE
CASE toParentReg.ObjType = 2 AND toParentReg.OBJCODE = 0
CASE toParentReg.ObjType = C_OBJTYPE_MENUTYPE_BARorPOPUP AND toParentReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUPAD
*-- Define Bar
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<.get_DefineBarText(loReg, loBarPop, tnNivel, toHeader)>>
ENDTEXT
CASE toParentReg.ObjType = 2 AND toParentReg.OBJCODE = 1 AND (toHeader.ObjType = 1 OR toHeader.ObjType = 5)
CASE toParentReg.ObjType = C_OBJTYPE_MENUTYPE_BARorPOPUP AND toParentReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUBAR ;
AND (toHeader.ObjType = C_OBJTYPE_MENUTYPE_DEFAULT OR toHeader.ObjType = C_OBJTYPE_MENUTYPE_MENUBARONTOP)
*-- Define Pad
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<.get_DefinePadText(loReg, loBarPop, tnNivel, toHeader)>>
@@ -19105,10 +19143,10 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
ENDCASE
IF loReg.OBJCODE = 80 && Procedure de BAR o PAD
IF loReg.OBJCODE = C_OBJCODE_MENUOPTION_PROCEDURE && Procedure de BAR o PAD
*-- Reemplazo el nombre definitivo
lcExpr = loReg.PROCEDURE
.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, '', 1, .T. )
.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, '', 1, .T., .T. )
IF EMPTY(lcProcCode)
*-- Comando
@@ -19130,10 +19168,12 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
ENDIF
*-- Menu Bar or Popup (ObjType:2, ObjCode:0 <20> 1)
*-- Menu Bar or Popup (ObjType:2 [C_OBJTYPE_MENUTYPE_BARorPOPUP], ObjCode:0 <20> 1 [C_OBJCODE_MENUBARPOPUP_MENUPAD o C_OBJCODE_MENUBARPOPUP_MENUBAR])
IF .COUNT > 0
FOR EACH loBarPop IN THIS FOXOBJECT
IF toParentReg.ObjType = 2 AND toParentReg.OBJCODE = 1 AND toHeader.ObjType = 4
IF toParentReg.ObjType = C_OBJTYPE_MENUTYPE_BARorPOPUP ;
AND toParentReg.OBJCODE = C_OBJCODE_MENUBARPOPUP_MENUBAR ;
AND toHeader.ObjType = C_OBJTYPE_MENUTYPE_SHORTCUT
*-- Shortcut
lcText = lcText + loBarPop.toText(loReg, tnNivel + 0, @tcEndProcedures, toHeader)
ELSE
@@ -19181,7 +19221,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
*-- DEFINE BAR
*lcText = lcTab + '*----------------------------------' + CR_LF
lcText = lcText + lcTab + 'DEFINE BAR ' + ALLTRIM( EVL( toReg.NAME, toReg.ITEMNUM ) ) + ' OF ' + ALLTRIM(toReg.LevelName) ;
lcText = lcText + lcTab + 'DEFINE BAR ' + ALLTRIM( EVL( toReg.NAME, toReg.ItemNum ) ) + ' OF ' + ALLTRIM(toReg.LevelName) ;
+ ' PROMPT "' + toReg.PROMPT + '"'
IF NOT EMPTY(toReg.KEYNAME)
@@ -19209,22 +19249,22 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
ENDIF
*-- ON BAR
IF toReg.OBJCODE <> 78 && Bar#
IF toReg.OBJCODE <> C_OBJCODE_MENUOPTION_BARNUM && Bar#
lcText = lcText + CR_LF
IF toReg.OBJCODE = 77 && Submenu
IF toReg.OBJCODE = C_OBJCODE_MENUOPTION_SUBMENU && Submenu
loBarPop = THIS.ITEM(1).oReg
lcText = lcText + lcTab + 'ON BAR ' + ALLTRIM( EVL( toReg.NAME, toReg.ITEMNUM ) ) + ' OF ' + ALLTRIM(toReg.LevelName) ;
lcText = lcText + lcTab + 'ON BAR ' + ALLTRIM( EVL( toReg.NAME, toReg.ItemNum ) ) + ' OF ' + ALLTRIM(toReg.LevelName) ;
+ ' ACTIVATE POPUP ' + ALLTRIM(loBarPop.NAME)
ELSE
lcText = lcText + lcTab + 'ON SELECTION BAR ' + ALLTRIM( EVL( toReg.NAME, toReg.ITEMNUM ) ) + ' OF ' + ALLTRIM(toReg.LevelName)
lcText = lcText + lcTab + 'ON SELECTION BAR ' + ALLTRIM( EVL( toReg.NAME, toReg.ItemNum ) ) + ' OF ' + ALLTRIM(toReg.LevelName)
DO CASE
CASE toReg.OBJCODE = 67 && Command
CASE toReg.OBJCODE = C_OBJCODE_MENUOPTION_COMMAND && Command
IF NOT EMPTY(toReg.COMMAND)
lcText = lcText + ' ' + ALLTRIM(toReg.COMMAND)
ENDIF
CASE toReg.OBJCODE = 80 && Procedure
CASE toReg.OBJCODE = C_OBJCODE_MENUOPTION_PROCEDURE && Procedure
IF NOT EMPTY(toReg.PROCEDURE)
lcText = lcText + ' DO <<ProcName>>'
ENDIF
@@ -19309,10 +19349,10 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
lcText = lcText + CR_LF
*-- ON PAD
IF toReg.OBJCODE <> 78 && Bar#
IF toReg.OBJCODE <> C_OBJCODE_MENUOPTION_BARNUM && Bar#
lcText = lcText + CR_LF
IF toReg.OBJCODE = 77 && Submenu
IF toReg.OBJCODE = C_OBJCODE_MENUOPTION_SUBMENU && Submenu
loBarPop = THIS.ITEM(1).oReg
lcText = lcText + lcTab + 'ON PAD ' + ALLTRIM(toReg.NAME) + ' OF ' + ALLTRIM(toReg.LevelName) ;
+ ' ACTIVATE POPUP ' + ALLTRIM(loBarPop.NAME)
@@ -19320,11 +19360,11 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
lcText = lcText + lcTab + 'ON SELECTION PAD ' + ALLTRIM(toReg.NAME) + ' OF ' + ALLTRIM(toReg.LevelName)
DO CASE
CASE toReg.OBJCODE = 67 && Command
CASE toReg.OBJCODE = C_OBJCODE_MENUOPTION_COMMAND && Command
IF NOT EMPTY(toReg.COMMAND)
lcText = lcText + ' ' + ALLTRIM(toReg.COMMAND)
ENDIF
CASE toReg.OBJCODE = 80 && Procedure
CASE toReg.OBJCODE = C_OBJCODE_MENUOPTION_PROCEDURE && Procedure
IF NOT EMPTY(toReg.PROCEDURE)
lcText = lcText + ' DO <<ProcName>>'
ENDIF