diff --git a/TESTS/FoxPro9_Order_for_Control_Properties.xlsx b/Documentacion/FoxPro9_Order_for_Control_Properties.xlsx similarity index 100% rename from TESTS/FoxPro9_Order_for_Control_Properties.xlsx rename to Documentacion/FoxPro9_Order_for_Control_Properties.xlsx diff --git a/Documentacion/Visual FoxPro 9 - MENUS - Combinaciones de ObjType y ObjCode.docx b/Documentacion/Visual FoxPro 9 - MENUS - Combinaciones de ObjType y ObjCode.docx new file mode 100644 index 0000000..6c7cd61 Binary files /dev/null and b/Documentacion/Visual FoxPro 9 - MENUS - Combinaciones de ObjType y ObjCode.docx differ diff --git a/Documentacion/Visual FoxPro 9 - MENUS - Combinaciones de ObjType y ObjCode.odt b/Documentacion/Visual FoxPro 9 - MENUS - Combinaciones de ObjType y ObjCode.odt new file mode 100644 index 0000000..f55243d Binary files /dev/null and b/Documentacion/Visual FoxPro 9 - MENUS - Combinaciones de ObjType y ObjCode.odt differ diff --git a/Documentacion/Visual FoxPro 9 - MENUS - Combinaciones de ObjType y ObjCode.pdf b/Documentacion/Visual FoxPro 9 - MENUS - Combinaciones de ObjType y ObjCode.pdf new file mode 100644 index 0000000..b0ab89c Binary files /dev/null and b/Documentacion/Visual FoxPro 9 - MENUS - Combinaciones de ObjType y ObjCode.pdf differ diff --git a/FoxBin2PRGVersionFile.txt b/FoxBin2PRGVersionFile.txt index 06b6ce1..a9ba00d 100644 --- a/FoxBin2PRGVersionFile.txt +++ b/FoxBin2PRGVersionFile.txt @@ -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 diff --git a/foxbin2prg.exe b/foxbin2prg.exe index a88bccc..35bc33d 100644 Binary files a/foxbin2prg.exe and b/foxbin2prg.exe differ diff --git a/foxbin2prg.pj2 b/foxbin2prg.pj2 index 8e3003a..de98b34 100644 --- a/foxbin2prg.pj2 +++ b/foxbin2prg.pj2 @@ -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" * diff --git a/foxbin2prg.pjt b/foxbin2prg.pjt index 3475a95..5084082 100644 Binary files a/foxbin2prg.pjt and b/foxbin2prg.pjt differ diff --git a/foxbin2prg.pjx b/foxbin2prg.pjx index 073eb96..3d33758 100644 Binary files a/foxbin2prg.pjx and b/foxbin2prg.pjx differ diff --git a/foxbin2prg.prg b/foxbin2prg.prg index b9da2e8..b5ab765 100644 --- a/foxbin2prg.prg +++ b/foxbin2prg.prg @@ -101,7 +101,9 @@ * 17/08/2014 FDBOZZO v1.19.31 Agregada versión del EXE cuando se genera LOG de depuració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ón * 20/08/2014 FDBOZZO v1.19.31 Mejora: Ajuste de capitalización de los archivos origen, así 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ú con una opción de tipo #Bar vacía, el menú se genera mal (Peter Hipp) +* 29/08/2014 FDBOZZO v1.19.33 Arreglo bug mnx v1.19.32: Si una opción tiene asociado un Procedure de 1 línea, no se mantiene como Procedure y se convierte a Command (Peter Hipp) * * *--------------------------------------------------------------------------------------------------- @@ -142,8 +144,10 @@ * 21/07/2014 Edyshor PROPUESTA DE MEJORA db2 v1.19.27: Sería ú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ó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ó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ú con una opción de tipo #Bar vacía, el menú se genera mal (solucionado en v1.19.33) +* 28/08/2014 Peter Hipp REPORTE BUG bug mnx v1.19.32: Si una opción tiene asociado un Procedure de 1 línea, no se mantiene como Procedure y se convierte a Command (solucionado en v1.19.33) * * *--------------------------------------------------------------------------------------------------- @@ -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á 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ó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ú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 = '\>DEFINE POPUP <> SHORTCUT RELATIVE ENDTEXT ENDIF - ELSE && ObjType = 1 ó 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 <>*---------------------------------- @@ -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, '<>', 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, '<>', 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í 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ónA_CS * ON BAR _3YM1DR90Z OF _MSYSMENU wait window "algo" * ON BAR _3YM1DR90Z OF _MSYSMENU DO Menu1_Opció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ó el siguiente DEFINE BAR/PAD, por lo que el analizado es de tipo #BAR vací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, '<>', 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 ó 1) + *-- Menu Bar or Popup (ObjType:2 [C_OBJTYPE_MENUTYPE_BARorPOPUP], ObjCode:0 ó 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 <>' 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 <>' ENDIF