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

Changeset: 129 - Agregado Unit Testing de menús

Browse Source 
- Arreglo de las incidencias reportadas del menu (MNX-MN2)
- Agregados 2 scripts VBS para conversión Batch
- Agregada propiedad _screen.ExitCode consultable para saber el estado de finalización para llamadas en modo objeto
This commit is contained in:
fernando
2014-01-03 16:57:39 +01:00
parent db6e93bf24 347d0b3811
commit a54f6eeff1
17 changed files with 489 additions and 139 deletions
Download Patch File Download Diff File Expand all files Collapse all files

128
Convert_VFP9_BIN_2_PRG.vbs Normal file
View File

@@ -0,0 +1,128 @@
'---------------------------------------------------------------------------------------------------
' Convert_VFP9_BIN_2_PRG.vbs - 03/01/2014 - Fernando D. Bozzo (fdbozzo@gmail.com)
'---------------------------------------------------------------------------------------------------
' ENGLISH:
' USE: Copy this file in the same directory of FoxBin2prg and create a shortcut
' on user's "SendTo" folder
'
' ESPA<50>OL:
' USO: Copie este archivo en el mismo directorio que FoxBin2prg y cree un acceso directo
' en la carpeta "SendTo" del usuario
'---------------------------------------------------------------------------------------------------
Const ForReading = 1
Dim WSHShell, FileSystemObject
Dim oVFP9, nExitCode, cEXETool, cCMD, nDebug, cConvertType, aExtensions(8), foxbin2prg_cfg
Dim i, x, str_cfg, aConf
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set FileSystemObject = WScript.CreateObject("Scripting.FileSystemObject")
Set oVFP9 = CreateObject("VisualFoxPro.Application.9")
cConvertType = "BIN2PRG"
foxbin2prg_cfg = Replace(WScript.ScriptFullName, WScript.ScriptName, "foxbin2prg.cfg")
nExitCode = 0
'---------------------------------------------------------------------------------------------------
nDebug = 1 '0=OFF, 1=Create FoxBin2prg LOG, 2=Only show calls, 3=Only show calls of the LOG call
'---------------------------------------------------------------------------------------------------
If cConvertType = "BIN2PRG" Then
aExtensions(1) = "PJX"
aExtensions(2) = "VCX"
aExtensions(3) = "SCX"
aExtensions(4) = "FRX"
aExtensions(5) = "LBX"
aExtensions(6) = "DBF"
aExtensions(7) = "DBC"
aExtensions(8) = "MNX"
Else
'-- Extensiones TXT por defecto
aExtensions(1) = "PJ2"
aExtensions(2) = "VC2"
aExtensions(3) = "SC2"
aExtensions(4) = "FR2"
aExtensions(5) = "LB2"
aExtensions(6) = "DB2"
aExtensions(7) = "DC2"
aExtensions(8) = "MN2"
If FileSystemObject.FileExists( foxbin2prg_cfg ) Then
'-- Existe el archivo de configuraci<63>n foxbin2prg.cgf
Set objTextFile = FileSystemObject.OpenTextFile( foxbin2prg_cfg, ForReading )
Do Until objTextFile.AtEndOfStream
strNextLine = objTextFile.Readline
arrFb2p_CFG = Split(strNextLine , ",")
For i = 0 to Ubound(arrFb2p_CFG)
If Left( arrFb2p_CFG(i), 10 ) = "extension:" Then
'Wscript.Echo "CFG line: " & arrFb2p_CFG(i)
aConf = Split( arrFb2p_CFG(i), ":" ) 'Obtengo la separaci<63>n de "extensi<73>n:" y "ext:equiv"
str_cfg = UCase( Trim( aConf(1) ) )
aConf = Split( str_cfg, "=" ) 'Obtengo la separaci<63>n de extensi<73>n y equivalencia (vc2=vca)
'Wscript.Echo "[" & aConf(0) & "] [" & aConf(1) & "]"
For x = 1 TO 8
If aExtensions(x) = aConf(0) Then
aExtensions(x) = UCase( aConf(1) )
Exit For
End If
Next
Else
'Wscript.Echo "Saltear: " & arrFb2p_CFG(i)
End If
Next
Loop
End If
End if
If WScript.Arguments.Count = 0 Then
nExitCode = 1
MsgBox "Sin parametros"
Else
cEXETool = Replace(WScript.ScriptFullName, WScript.ScriptName, "foxbin2prg.exe")
For i = 0 To WScript.Arguments.Count-1
scanDirs( WScript.Arguments(i) )
Next
End If
WScript.Quit(nExitCode)
Private Sub scanDirs( tcArgument )
Dim omFolder, oFolder
If FileSystemObject.FolderExists( tcArgument ) Then
'-- Es un directorio
'WScript.Echo "Argument: " & "[" & tcArgument & "]"
Set omFolder = FileSystemObject.GetFolder( tcArgument )
'WScript.Echo "Dir: " & "[" & omFolder.Path & "]"
For Each oFile IN omFolder.Files
'WScript.Echo "File: " & "[" & oFile.Path & "]"
evaluateFile( oFile.Path )
Next
For Each oFolder IN omFolder.SubFolders
'WScript.Echo "SubDir: " & "[" & oFolder.Name & "] [" & oFolder.Path & "]"
scanDirs( oFolder.Path )
Next
Else
'-- Es un archivo
evaluateFile( tcArgument )
End If
End Sub
Private Sub evaluateFile( tcFile )
For x = 1 TO 8
If aExtensions(x) = UCase( FileSystemObject.GetExtensionName( tcFile ) ) Then
If nDebug = 1 OR nDebug = 3 Then
cCMD = "DO " & chr(34) & cEXETool & chr(34) & " WITH '" & tcFile & "','0','0','0','0','1'"
Else
cCMD = "DO " & chr(34) & cEXETool & chr(34) & " WITH " & chr(34) & tcFile & chr(34)
End If
If nDebug = 2 Or nDebug = 3 Then
MsgBox cCMD, 0, "PARAMETROS ENVIADOS"
Else 'nDebug = 0 Or nDebug = 2
oVFP9.DoCmd( cCMD )
nExitCode = oVFP9.Eval("_SCREEN.ExitCode")
End If
Exit For
End If
Next
End Sub

128
Convert_VFP9_PRG_2_BIN.vbs Normal file
View File

@@ -0,0 +1,128 @@
'---------------------------------------------------------------------------------------------------
' Convert_VFP9_PRG_2_BIN.vbs - 03/01/2014 - Fernando D. Bozzo (fdbozzo@gmail.com)
'---------------------------------------------------------------------------------------------------
' ENGLISH:
' USE: Copy this file in the same directory of FoxBin2prg and create a shortcut
' on user's "SendTo" folder
'
' ESPA<50>OL:
' USO: Copie este archivo en el mismo directorio que FoxBin2prg y cree un acceso directo
' en la carpeta "SendTo" del usuario
'---------------------------------------------------------------------------------------------------
Const ForReading = 1
Dim WSHShell, FileSystemObject
Dim oVFP9, nExitCode, cEXETool, cCMD, nDebug, cConvertType, aExtensions(8), foxbin2prg_cfg
Dim i, x, str_cfg, aConf
Set WSHShell = WScript.CreateObject("WScript.Shell")
Set FileSystemObject = WScript.CreateObject("Scripting.FileSystemObject")
Set oVFP9 = CreateObject("VisualFoxPro.Application.9")
cConvertType = "PRG2BIN"
foxbin2prg_cfg = Replace(WScript.ScriptFullName, WScript.ScriptName, "foxbin2prg.cfg")
nExitCode = 0
'---------------------------------------------------------------------------------------------------
nDebug = 1 '0=OFF, 1=Create FoxBin2prg LOG, 2=Only show calls, 3=Only show calls of the LOG call
'---------------------------------------------------------------------------------------------------
If cConvertType = "BIN2PRG" Then
aExtensions(1) = "PJX"
aExtensions(2) = "VCX"
aExtensions(3) = "SCX"
aExtensions(4) = "FRX"
aExtensions(5) = "LBX"
aExtensions(6) = "DBF"
aExtensions(7) = "DBC"
aExtensions(8) = "MNX"
Else
'-- Extensiones TXT por defecto
aExtensions(1) = "PJ2"
aExtensions(2) = "VC2"
aExtensions(3) = "SC2"
aExtensions(4) = "FR2"
aExtensions(5) = "LB2"
aExtensions(6) = "DB2"
aExtensions(7) = "DC2"
aExtensions(8) = "MN2"
If FileSystemObject.FileExists( foxbin2prg_cfg ) Then
'-- Existe el archivo de configuraci<63>n foxbin2prg.cgf
Set objTextFile = FileSystemObject.OpenTextFile( foxbin2prg_cfg, ForReading )
Do Until objTextFile.AtEndOfStream
strNextLine = objTextFile.Readline
arrFb2p_CFG = Split(strNextLine , ",")
For i = 0 to Ubound(arrFb2p_CFG)
If Left( arrFb2p_CFG(i), 10 ) = "extension:" Then
'Wscript.Echo "CFG line: " & arrFb2p_CFG(i)
aConf = Split( arrFb2p_CFG(i), ":" ) 'Obtengo la separaci<63>n de "extensi<73>n:" y "ext:equiv"
str_cfg = UCase( Trim( aConf(1) ) )
aConf = Split( str_cfg, "=" ) 'Obtengo la separaci<63>n de extensi<73>n y equivalencia (vc2=vca)
'Wscript.Echo "[" & aConf(0) & "] [" & aConf(1) & "]"
For x = 1 TO 8
If aExtensions(x) = aConf(0) Then
aExtensions(x) = UCase( aConf(1) )
Exit For
End If
Next
Else
'Wscript.Echo "Saltear: " & arrFb2p_CFG(i)
End If
Next
Loop
End If
End if
If WScript.Arguments.Count = 0 Then
nExitCode = 1
MsgBox "Sin parametros"
Else
cEXETool = Replace(WScript.ScriptFullName, WScript.ScriptName, "foxbin2prg.exe")
For i = 0 To WScript.Arguments.Count-1
scanDirs( WScript.Arguments(i) )
Next
End If
WScript.Quit(nExitCode)
Private Sub scanDirs( tcArgument )
Dim omFolder, oFolder
If FileSystemObject.FolderExists( tcArgument ) Then
'-- Es un directorio
'WScript.Echo "Argument: " & "[" & tcArgument & "]"
Set omFolder = FileSystemObject.GetFolder( tcArgument )
'WScript.Echo "Dir: " & "[" & omFolder.Path & "]"
For Each oFile IN omFolder.Files
'WScript.Echo "File: " & "[" & oFile.Path & "]"
evaluateFile( oFile.Path )
Next
For Each oFolder IN omFolder.SubFolders
'WScript.Echo "SubDir: " & "[" & oFolder.Name & "] [" & oFolder.Path & "]"
scanDirs( oFolder.Path )
Next
Else
'-- Es un archivo
evaluateFile( tcArgument )
End If
End Sub
Private Sub evaluateFile( tcFile )
For x = 1 TO 8
If aExtensions(x) = UCase( FileSystemObject.GetExtensionName( tcFile ) ) Then
If nDebug = 1 OR nDebug = 3 Then
cCMD = "DO " & chr(34) & cEXETool & chr(34) & " WITH '" & tcFile & "','0','0','0','0','1'"
Else
cCMD = "DO " & chr(34) & cEXETool & chr(34) & " WITH " & chr(34) & tcFile & chr(34)
End If
If nDebug = 2 Or nDebug = 3 Then
MsgBox cCMD, 0, "PARAMETROS ENVIADOS"
Else 'nDebug = 0 Or nDebug = 2
oVFP9.DoCmd( cCMD )
nExitCode = oVFP9.Eval("_SCREEN.ExitCode")
End If
Exit For
End If
Next
End Sub

10
README.txt
View File

@@ -1,4 +1,4 @@
21/12/2013 FOXBIN2PRG VER.1.15 FOR VISUAL FOXPRO 9 BINARIES Fernando D. Bozzo (fdbozzo@gmail.com)
02/01/2014 FOXBIN2PRG VER.1.17 FOR VISUAL FOXPRO 9 BINARIES Fernando D. Bozzo (fdbozzo@gmail.com)
ESPAÑOL --------------------------------------------------------------------------------------------
@@ -16,8 +16,8 @@ Ventajas:
- Los métodos y propiedades de la versión TEXTO se ordenan alfabéticamente para facilitar su comparación
- Tiene compatibilidad con SCCTEXT a nivel de parámetros para usarlo como sustituto en SourceSafe
Actualmente soporta las conversiones de archivos PJX,SCX,VCX,FRX,LBX,DBC y DBF para los que genera las
versiones TEXTO con extensión PJ2,SC2,VC2,FR2,LB2,DC2 y DB2, que pueden reconfigurarse para compatibilizar
Actualmente soporta las conversiones de archivos PJX,SCX,VCX,FRX,LBX,DBC,DBF y MNX para los que genera las
versiones TEXTO con extensión PJ2,SC2,VC2,FR2,LB2,DC2,DB2 y MN2, que pueden reconfigurarse para compatibilizar
con SourceSafe.
Estructura del archivo de configuración FOXBIN2PRG.CFG
@@ -60,8 +60,8 @@ Advantages:
- Methods and properties of TEXT version are alphabetically sorted for easy comparison
- It has compatibility with SCCTEXT at parameter level so can be used as sustitute with SourceSafe
Actually supports conversions between PJX,SCX,VCX,FRX,LBX,DBC and DBF files, for which it generates
TEXT versions with extension PJ2,SC2,VC2,FR2,LB2,DC2 and DB2 that can be reconfigured to compatibilize
Actually supports conversions between PJX,SCX,VCX,FRX,LBX,DBC,DBF and MNX files, for which it generates
TEXT versions with extension PJ2,SC2,VC2,FR2,LB2,DC2,DB2 and MN2 that can be reconfigured to compatibilize
with SourceSafe.
Structure of configuration file FOXBIN2PRG.CFG

BIN
TESTS/DATOS_READONLY/menu1.MNT Normal file
View File

Binary file not shown.

BIN
TESTS/DATOS_READONLY/menu1.mnx Normal file
View File

Binary file not shown.

BIN
TESTS/DATOS_READONLY/menu2.mnt Normal file
View File

Binary file not shown.

BIN
TESTS/DATOS_READONLY/menu2.mnx Normal file
View File

Binary file not shown.

BIN
TESTS/DATOS_READONLY/menu3.mnt Normal file
View File

Binary file not shown.

BIN
TESTS/DATOS_READONLY/menu3.mnx Normal file
View File

Binary file not shown.

BIN
TESTS/DATOS_READONLY/menu_shortcut.MNT Normal file
View File

Binary file not shown.

BIN
TESTS/DATOS_READONLY/menu_shortcut.mnx Normal file
View File

Binary file not shown.

BIN
TESTS/DATOS_READONLY/menu_shortcut2.MNT Normal file
View File

Binary file not shown.

BIN
TESTS/DATOS_READONLY/menu_shortcut2.mnx Normal file
View File

Binary file not shown.

8
foxbin2prg.pj2
View File

@@ -2,7 +2,7 @@
* (ES) AUTOGENERADO - <20><>ATENCI<43>N!! - <20><>NO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!!
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
*--------------------------------------------------------------------------------------------------------------------------------------------------------
*< FOXBIN2PRG: Version="1.16" SourceFile="C:\DESA\foxbin2prg\foxbin2prg.pjx" Generated="2014/01/02 02:21:13" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
*< FOXBIN2PRG: Version="1.17" SourceFile="C:\DESA\foxbin2prg\foxbin2prg.pjx" Generated="2014/01/03 16:29:53" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
*
LPARAMETERS tcDir
@@ -25,8 +25,8 @@ _LegalCopyright = "Open Source - LICENCIA Creative Commons: Reconocimiento - Co
_LegalTrademark = "Open Source"
_ProductName = " FOXBIN2PRG"
_MajorVer = "1"
_MinorVer = "16"
_Revision = " 144"
_MinorVer = "17"
_Revision = " 152"
_LanguageID = "1034"
_AutoIncrement = "1"
*</DevInfo>
@@ -51,7 +51,7 @@ loProject = _VFP.Projects('foxbin2prg.pjx')
WITH loProject.FILES
.ADD('config\config.fpw') && *< FileMetadata: Type="T" Cpid="1252" Timestamp="1132857145" ID="1131721714" ObjRev="0" />
.ADD('foxbin2prg.prg') && *< FileMetadata: Type="P" Cpid="1252" Timestamp="1143083468" ID="1130644423" ObjRev="544" />
.ADD('foxbin2prg.prg') && *< FileMetadata: Type="P" Cpid="1252" Timestamp="1143178164" ID="1130644423" ObjRev="544" />
*</BuildProj>
.ITEM('__newproject.f2b').Remove()

BIN
foxbin2prg.pjt
View File

Binary file not shown.

BIN
foxbin2prg.pjx
View File

Binary file not shown.

354
foxbin2prg.prg
View File

@@ -54,6 +54,7 @@
* 15/12/2013 FDBOZZO v1.14 Arreglo de bug AutoCenter y registro COMMENT en regeneraci<63>n de forms
* 08/12/2013 FDBOZZO v1.15 Agregado soporte preliminar de conversi<73>n de tablas, <20>ndices y bases de datos (DBF,CDX,DBC)
* 18/12/2013 FDBOZZO v1.16 Agregado soporte para men<65>s (MNX)
* 03/01/2013 FDBOZZO v1.17 Agregado Unit Testing de men<65>s y arreglo de las incidencias del menu
* </HISTORIAL DE CAMBIOS Y NOTAS IMPORTANTES>
*
*---------------------------------------------------------------------------------------------------
@@ -67,7 +68,8 @@
* 07/12/2013 Edgar Kummers REPORTE BUG: Cuando se parsea una clase con un _memberdata largo, se parsea mal y se corrompe el valor (arreglado en v.1.11)
* 08/12/2013 Fidel Charny REPORTE BUG: Cuando se convierten algunos reportes da "Error 1924, TOREG is not an object" (arreglado en v.1.13)
* 14/12/2013 Arturo Ramos REPORTE BUG: La regeneraci<63>n de los forms (SCX) no respeta la propiedad AutoCenter, estando pero no funcionando. (arreglado en v.1.14)
* 14/12/2013 Fidel Charny REPORRE BUG: La regeneraci<63>n de los forms (SCX) no regenera el <20>ltimo registro COMMENT (arreglado en v.1.14)
* 14/12/2013 Fidel Charny REPORTE BUG: La regeneraci<63>n de los forms (SCX) no regenera el <20>ltimo registro COMMENT (arreglado en v.1.14)
* 01/01/2014 Fidel Charny REPORTE BUG v1.16: El men<65> no siempre respeta la posici<63>n original LOCATION y a veces se genera mal el MNX (se arregla en v1.17)
* </TESTEO Y REPORTE DE BUGS (AGRADECIMIENTOS)>
*
*---------------------------------------------------------------------------------------------------
@@ -202,6 +204,8 @@ LPARAMETERS tc_InputFile, tcType_na, tcTextName_na, tlGenText_na, tcDontShowErro
#DEFINE C_MENUCODE_F '*</MenuCode>'
#DEFINE C_MENUTYPE_I '*<MenuType>'
#DEFINE C_MENUTYPE_F '</MenuType>'
#DEFINE C_MENULOCATION_I '*<MenuLocation>'
#DEFINE C_MENULOCATION_F '</MenuLocation>'
*--
#DEFINE C_TAB CHR(9)
#DEFINE C_CR CHR(13)
@@ -284,6 +288,7 @@ goCnv = CREATEOBJECT("c_foxbin2prg")
lnResp = goCnv.ejecutar( tc_InputFile, tcType_na, tcTextName_na, tlGenText_na, tcDontShowErrors, tcDebug ;
, '', NULL, NULL, .F., tcOriginalFileName )
ADDPROPERTY(_SCREEN, 'ExitCode', lnResp)
IF _VFP.STARTMODE <= 1
RETURN lnResp
ENDIF
@@ -307,6 +312,7 @@ DEFINE CLASS c_foxbin2prg AS CUSTOM
+ [<memberdata name="c_curdir" display="c_CurDir"/>] ;
+ [<memberdata name="c_foxbin2prg_fullpath" display="c_Foxbin2prg_FullPath"/>] ;
+ [<memberdata name="c_inputfile" display="c_InputFile"/>] ;
+ [<memberdata name="c_originalfilename" display="c_OriginalFileName"/>] ;
+ [<memberdata name="c_outputfile" display="c_OutputFile"/>] ;
+ [<memberdata name="c_type" display="c_Type"/>] ;
+ [<memberdata name="c_logfile" display="c_LogFile"/>] ;
@@ -322,6 +328,7 @@ DEFINE CLASS c_foxbin2prg AS CUSTOM
+ [<memberdata name="dobackup" display="doBackup"/>] ;
+ [<memberdata name="ejecutar" display="Ejecutar"/>] ;
+ [<memberdata name="exception2str" display="Exception2Str"/>] ;
+ [<memberdata name="get_program_header" display="get_PROGRAM_HEADER"/>] ;
+ [<memberdata name="getnext_bak" display="getNext_BAK"/>] ;
+ [<memberdata name="lfilemode" display="lFileMode"/>] ;
+ [<memberdata name="l_debug" display="l_Debug"/>] ;
@@ -343,11 +350,12 @@ DEFINE CLASS c_foxbin2prg AS CUSTOM
*--
n_FB2PRG_Version = 1.16
n_FB2PRG_Version = 1.17
*--
c_Foxbin2prg_FullPath = ''
c_CurDir = ''
c_InputFile = ''
c_OriginalFileName = ''
c_LogFile = ''
c_TextLog = ''
c_OutputFile = ''
@@ -381,6 +389,8 @@ DEFINE CLASS c_foxbin2prg AS CUSTOM
SET CENTURY ON
SET SAFETY OFF
SET TABLEPROMPT OFF
SET POINT TO '.'
SET SEPARATOR TO ','
THIS.c_Foxbin2prg_FullPath = SUBSTR( SYS(16), AT( 'C_FOXBIN2PRG.INIT', SYS(16) ) + LEN('C_FOXBIN2PRG.INIT') + 1 )
THIS.c_CurDir = SYS(5) + CURDIR()
THIS.o_FSO = NEWOBJECT("Scripting.FileSystemObject")
@@ -489,7 +499,7 @@ DEFINE CLASS c_foxbin2prg AS CUSTOM
ENDPROC
PROCEDURE Ejecutar
PROCEDURE ejecutar
*--------------------------------------------------------------------------------------------------------------
* PAR<41>METROS: (!=Obligatorio | ?=Opcional) (@=Pasar por referencia | v=Pasar por valor) (IN/OUT)
* tc_InputFile (!v IN ) Nombre del archivo de entrada
@@ -682,6 +692,7 @@ DEFINE CLASS c_foxbin2prg AS CUSTOM
IF NOT EMPTY(tcOriginalFileName)
tcOriginalFileName = loFSO.GetAbsolutePathName( tcOriginalFileName )
ENDIF
.c_OriginalFileName = EVL( tcOriginalFileName, .c_InputFile )
THIS.writeLog( 'c_InputFile=' + .c_InputFile )
.o_Conversor = NULL
@@ -819,6 +830,24 @@ DEFINE CLASS c_foxbin2prg AS CUSTOM
ENDPROC
PROCEDURE get_PROGRAM_HEADER
LOCAL lcText
lcText = ''
*-- Cabecera del PRG e inicio de DEF_CLASS
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (ES) AUTOGENERADO - <20><>ATENCI<43>N!! - <20><>NO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!!
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
*--------------------------------------------------------------------------------------------------------------------------------------------------------
<<C_FB2PRG_META_I>> Version="<<TRANSFORM(THIS.n_FB2PRG_Version)>>" SourceFile="<<EVL( THIS.c_OriginalFileName, THIS.c_InputFile )>>" Generated="<<TTOC(DATETIME())>>" <<C_FB2PRG_META_F>> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
*
ENDTEXT
RETURN lcText
ENDPROC
PROCEDURE getNext_BAK
*--------------------------------------------------------------------------------------------------------------
* PAR<41>METROS: (!=Obligatorio | ?=Opcional) (@=Pasar por referencia | v=Pasar por valor) (IN/OUT)
@@ -6205,11 +6234,13 @@ DEFINE CLASS c_conversor_prg_a_mnx AS c_conversor_prg_a_bin
LOCAL THIS AS c_conversor_prg_a_mnx OF 'FOXBIN2PRG.PRG'
#ENDIF
_MEMBERDATA = [<VFPData>] ;
+ [<memberdata name="c_menulocation" display="c_MenuLocation"/>] ;
+ [<memberdata name="n_menutype" display="n_MenuType"/>] ;
+ [</VFPData>]
n_MenuType = 0
c_MenuLocation = ''
*******************************************************************************************************************
PROCEDURE Convertir
@@ -6412,7 +6443,6 @@ DEFINE CLASS c_conversor_bin_a_prg AS c_conversor_base
+ [<memberdata name="write_hidden_properties" display="write_HIDDEN_Properties"/>] ;
+ [<memberdata name="write_include" display="write_INCLUDE"/>] ;
+ [<memberdata name="write_metadata" display="write_METADATA"/>] ;
+ [<memberdata name="write_program_header" display="write_PROGRAM_HEADER"/>] ;
+ [<memberdata name="write_protected_properties" display="write_PROTECTED_Properties"/>] ;
+ [</VFPData>]
@@ -7383,25 +7413,6 @@ DEFINE CLASS c_conversor_bin_a_prg AS c_conversor_base
ENDPROC
*******************************************************************************************************************
PROCEDURE write_PROGRAM_HEADER
LOCAL lcText
lcText = ''
*-- Cabecera del PRG e inicio de DEF_CLASS
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1 PRETEXT 1+2
*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (ES) AUTOGENERADO - <20><>ATENCI<43>N!! - <20><>NO PENSADO PARA EJECUTAR!! USAR SOLAMENTE PARA INTEGRAR CAMBIOS Y ALMACENAR CON HERRAMIENTAS SCM!!
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
*--------------------------------------------------------------------------------------------------------------------------------------------------------
<<C_FB2PRG_META_I>> Version="<<TRANSFORM(THIS.n_FB2PRG_Version)>>" SourceFile="<<EVL( THIS.c_OriginalFileName, THIS.c_InputFile )>>" Generated="<<TTOC(DATETIME())>>" <<C_FB2PRG_META_F>> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
*
ENDTEXT
RETURN lcText
ENDPROC
*******************************************************************************************************************
PROCEDURE write_PROTECTED_Properties
*-- Escribo la definici<63>n PROTECTED de propiedades
@@ -7917,7 +7928,7 @@ DEFINE CLASS c_conversor_vcx_a_prg AS c_conversor_bin_a_prg
INDEX ON PADR(LOWER(PLATFORM + IIF(EMPTY(PARENT),'',ALLTRIM(PARENT)+'.')+OBJNAME),240) TAG PARENT_OBJ OF TABLABIN ADDITIVE
SET ORDER TO 0 IN TABLABIN
C_FB2PRG_CODE = C_FB2PRG_CODE + THIS.write_PROGRAM_HEADER()
C_FB2PRG_CODE = C_FB2PRG_CODE + toFoxbin2prg.get_PROGRAM_HEADER()
THIS.get_NombresObjetosOLEPublic( @la_NombresObjsOle )
@@ -7999,7 +8010,7 @@ DEFINE CLASS c_conversor_vcx_a_prg AS c_conversor_bin_a_prg
IF THIS.l_Test
toModulo = C_FB2PRG_CODE
ELSE
lnLen = LEN( THIS.write_PROGRAM_HEADER() )
lnLen = LEN( toFoxbin2prg.get_PROGRAM_HEADER() )
DO CASE
CASE FILE(THIS.c_OutputFile) AND SUBSTR( FILETOSTR( THIS.c_OutputFile ), lnLen ) == SUBSTR( C_FB2PRG_CODE, lnLen )
THIS.writeLog( 'El archivo de salida [' + THIS.c_OutputFile + '] no se sobreescribe por ser igual al generado.' )
@@ -8063,7 +8074,7 @@ DEFINE CLASS c_conversor_scx_a_prg AS c_conversor_bin_a_prg
*toModulo = NULL
*toModulo = CREATEOBJECT('CL_MODULO')
C_FB2PRG_CODE = C_FB2PRG_CODE + THIS.write_PROGRAM_HEADER()
C_FB2PRG_CODE = C_FB2PRG_CODE + toFoxbin2prg.get_PROGRAM_HEADER()
THIS.get_NombresObjetosOLEPublic( @la_NombresObjsOle )
@@ -8164,7 +8175,7 @@ DEFINE CLASS c_conversor_scx_a_prg AS c_conversor_bin_a_prg
IF THIS.l_Test
toModulo = C_FB2PRG_CODE
ELSE
lnLen = LEN( THIS.write_PROGRAM_HEADER() )
lnLen = LEN( toFoxbin2prg.get_PROGRAM_HEADER() )
DO CASE
CASE FILE(THIS.c_OutputFile) AND SUBSTR( FILETOSTR( THIS.c_OutputFile ), lnLen ) == SUBSTR( C_FB2PRG_CODE, lnLen )
THIS.writeLog( 'El archivo de salida [' + THIS.c_OutputFile + '] no se sobreescribe por ser igual al generado.' )
@@ -8280,7 +8291,7 @@ DEFINE CLASS c_conversor_pjx_a_prg AS c_conversor_bin_a_prg
ENDSCAN
C_FB2PRG_CODE = C_FB2PRG_CODE + THIS.write_PROGRAM_HEADER()
C_FB2PRG_CODE = C_FB2PRG_CODE + toFoxbin2prg.get_PROGRAM_HEADER()
*-- Directorio de inicio
@@ -8469,7 +8480,7 @@ DEFINE CLASS c_conversor_pjx_a_prg AS c_conversor_bin_a_prg
IF THIS.l_Test
toModulo = C_FB2PRG_CODE
ELSE
lnLen = LEN( THIS.write_PROGRAM_HEADER() )
lnLen = LEN( toFoxbin2prg.get_PROGRAM_HEADER() )
DO CASE
CASE FILE(THIS.c_OutputFile) AND SUBSTR( FILETOSTR( THIS.c_OutputFile ), lnLen ) == SUBSTR( C_FB2PRG_CODE, lnLen )
THIS.writeLog( 'El archivo de salida [' + THIS.c_OutputFile + '] no se sobreescribe por ser igual al generado.' )
@@ -8572,7 +8583,7 @@ DEFINE CLASS c_conversor_frx_a_prg AS c_conversor_bin_a_prg
USE IN (SELECT("TABLABIN_0"))
C_FB2PRG_CODE = C_FB2PRG_CODE + THIS.write_PROGRAM_HEADER()
C_FB2PRG_CODE = C_FB2PRG_CODE + toFoxbin2prg.get_PROGRAM_HEADER()
*-- Recorro los registros y genero el texto
IF VARTYPE(loRegCab) = "O"
@@ -8601,7 +8612,7 @@ DEFINE CLASS c_conversor_frx_a_prg AS c_conversor_bin_a_prg
IF THIS.l_Test
toModulo = C_FB2PRG_CODE
ELSE
lnLen = LEN( THIS.write_PROGRAM_HEADER() )
lnLen = LEN( toFoxbin2prg.get_PROGRAM_HEADER() )
DO CASE
CASE FILE(THIS.c_OutputFile) AND SUBSTR( FILETOSTR( THIS.c_OutputFile ), lnLen ) == SUBSTR( C_FB2PRG_CODE, lnLen )
THIS.writeLog( 'El archivo de salida [' + THIS.c_OutputFile + '] no se sobreescribe por ser igual al generado.' )
@@ -8659,7 +8670,7 @@ DEFINE CLASS c_conversor_dbf_a_prg AS c_conversor_bin_a_prg
THIS.getDBFmetadata( THIS.c_InputFile, @ln_HexFileType, @ll_FileHasCDX, @ll_FileHasMemo, @ll_FileIsDBC, @lc_DBC_Name )
USE (THIS.c_InputFile) SHARED NOUPDATE ALIAS TABLABIN
C_FB2PRG_CODE = C_FB2PRG_CODE + THIS.write_PROGRAM_HEADER()
C_FB2PRG_CODE = C_FB2PRG_CODE + toFoxbin2prg.get_PROGRAM_HEADER()
*-- Header
loTable = CREATEOBJECT('CL_DBF_TABLE')
@@ -8672,7 +8683,7 @@ DEFINE CLASS c_conversor_dbf_a_prg AS c_conversor_bin_a_prg
IF THIS.l_Test
toModulo = C_FB2PRG_CODE
ELSE
lnLen = LEN( THIS.write_PROGRAM_HEADER() )
lnLen = LEN( toFoxbin2prg.get_PROGRAM_HEADER() )
DO CASE
CASE FILE(THIS.c_OutputFile) AND SUBSTR( FILETOSTR( THIS.c_OutputFile ), lnLen ) == SUBSTR( C_FB2PRG_CODE, lnLen )
THIS.writeLog( 'El archivo de salida [' + THIS.c_OutputFile + '] no se sobreescribe por ser igual al generado.' )
@@ -8740,7 +8751,7 @@ DEFINE CLASS c_conversor_dbc_a_prg AS c_conversor_bin_a_prg
USE (THIS.c_InputFile) SHARED NOUPDATE ALIAS TABLABIN
OPEN DATABASE (THIS.c_InputFile) SHARED NOUPDATE
C_FB2PRG_CODE = C_FB2PRG_CODE + THIS.write_PROGRAM_HEADER()
C_FB2PRG_CODE = C_FB2PRG_CODE + toFoxbin2prg.get_PROGRAM_HEADER()
*-- Header
toDatabase = CREATEOBJECT('CL_DBC')
@@ -8753,7 +8764,7 @@ DEFINE CLASS c_conversor_dbc_a_prg AS c_conversor_bin_a_prg
IF THIS.l_Test
toModulo = C_FB2PRG_CODE
ELSE
lnLen = LEN( THIS.write_PROGRAM_HEADER() )
lnLen = LEN( toFoxbin2prg.get_PROGRAM_HEADER() )
DO CASE
CASE FILE(THIS.c_OutputFile) AND SUBSTR( FILETOSTR( THIS.c_OutputFile ), lnLen ) == SUBSTR( C_FB2PRG_CODE, lnLen )
THIS.writeLog( 'El archivo de salida [' + THIS.c_OutputFile + '] no se sobreescribe por ser igual al generado.' )
@@ -8810,7 +8821,7 @@ DEFINE CLASS c_conversor_mnx_a_prg AS c_conversor_bin_a_prg
USE (THIS.c_InputFile) SHARED NOUPDATE ALIAS TABLABIN
*-- Header
C_FB2PRG_CODE = C_FB2PRG_CODE + THIS.write_PROGRAM_HEADER()
C_FB2PRG_CODE = C_FB2PRG_CODE + toFoxbin2prg.get_PROGRAM_HEADER()
toMenu = CREATEOBJECT('CL_MENU')
toMenu.get_DataFromTablabin()
@@ -8823,7 +8834,7 @@ DEFINE CLASS c_conversor_mnx_a_prg AS c_conversor_bin_a_prg
IF THIS.l_Test
toMenu = C_FB2PRG_CODE
ELSE
lnLen = LEN( THIS.write_PROGRAM_HEADER() )
lnLen = LEN( toFoxbin2prg.get_PROGRAM_HEADER() )
DO CASE
CASE FILE(THIS.c_OutputFile) AND SUBSTR( FILETOSTR( THIS.c_OutputFile ), lnLen ) == SUBSTR( C_FB2PRG_CODE, lnLen )
THIS.writeLog( 'El archivo de salida [' + THIS.c_OutputFile + '] no se sobreescribe por ser igual al generado.' )
@@ -14285,7 +14296,7 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
LOCAL loBarPop AS CL_MENU_BARPOP OF 'FOXBIN2PRG.PRG'
LOCAL llBloqueEncontrado, loReg, lcComment, lcExpr, lcProcName, lcProcCode, loEx AS EXCEPTION ;
, llBloque_SetupCode_Analizado, llBloque_CleanupCode_Analizado, llBloque_MenuCode_Analizado ;
, llBloque_MenuType_Analizado, llBloque_Procedure_Analizado
, llBloque_MenuType_Analizado, llBloque_Procedure_Analizado, llBloque_MenuLocation_Analizado
STORE '' TO lcComment
llBloqueEncontrado = .T.
@@ -14309,6 +14320,23 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
loReg.ObjType = toConversor.n_MenuType
llBloque_MenuType_Analizado = .T.
CASE NOT llBloque_MenuLocation_Analizado AND LEFT( tcLine, LEN(C_MENULOCATION_I) ) == C_MENULOCATION_I
toConversor.c_MenuLocation = STREXTRACT( tcLine, C_MENULOCATION_I, C_MENULOCATION_F )
DO CASE
CASE toConversor.c_MenuLocation == 'REPLACE'
loReg.Location = 0
CASE toConversor.c_MenuLocation == 'APPEND'
loReg.Location = 1
OTHERWISE
IF LEFT(toConversor.c_MenuLocation,7) == 'BEFORE'
loReg.Location = 2
ELSE
loReg.Location = 3
ENDIF
loReg.NAME = GETWORDNUM(toConversor.c_MenuLocation,2)
ENDCASE
llBloque_MenuLocation_Analizado = .T.
CASE NOT llBloque_SetupCode_Analizado AND THIS.analizarBloque_SetupCode( @tcLine, @taCodeLines, @I, tnCodeLines, toConversor )
llBloque_SetupCode_Analizado = .T.
@@ -14469,32 +14497,33 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
IF LEFT(tcLine, LEN(C_MENUCODE_I)) == C_MENUCODE_I
llBloqueEncontrado = .T.
*-- HEADER
WITH loReg
.OBJCODE = 22
.PROCTYPE = 1
.MARK = CHR(4)
.LOCATION = 1
.SETUPTYPE = 1
.CLEANTYPE = 1
.ITEMNUM = STR(0,3)
IF .ObjType = 4 && Shortcut menu
lcExpr = ALLTRIM( STREXTRACT( C_FB2PRG_CODE, 'ON SELECTION POPUP ALL ', CR_LF ) )
FOR I = I + 0 TO tnCodeLines
STORE '' TO lcExpr, lcProcName, lcProcCode
THIS.set_Line( @tcLine, @taCodeLines, I )
IF NOT EMPTY(lcExpr)
THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1, .F. )
DO CASE
CASE EMPTY( tcLine )
LOOP
CASE toConversor.lineIsOnlyCommentAndNoMetadata( @tcLine, @lcComment )
LOOP && Saltear comentarios
CASE LEFT( tcLine, LEN(C_MENUCODE_F) ) == C_MENUCODE_F
EXIT
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)
lcMenuType = ALLTRIM( GETWORDNUM( tcLine, 3 ) )
loReg.ObjType = IIF( lcMenuType = '_MSYSMENU', 1, 5 )
IF EMPTY(lcProcCode)
*-- Comando
.PROCEDURE = lcExpr
ELSE
*-- Procedure
lcProcCode = STRTRAN( lcProcCode, '<<ProcName>>', lcProcName )
.PROCEDURE = lcProcCode
ENDIF
ENDIF
ELSE && .OBJTYPE = 1 <20> 5
lcExpr = ALLTRIM( STREXTRACT( C_FB2PRG_CODE, 'ON SELECTION MENU _MSYSMENU ', CR_LF ) )
IF NOT EMPTY(lcExpr)
@@ -14502,52 +14531,86 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
IF EMPTY(lcProcCode)
*-- Comando
.PROCEDURE = lcExpr
loReg.PROCEDURE = lcExpr
ELSE
*-- Procedure
lcProcCode = STRTRAN( lcProcCode, '<<ProcName>>', lcProcName )
.PROCEDURE = lcProcCode
loReg.PROCEDURE = lcProcCode
ENDIF
ENDIF
ENDIF
ENDWITH
loBarPop = CREATEOBJECT('CL_MENU_BARPOP')
loBarPop.c_ParentName = ''
loBarPop.n_ParentCode = THIS.oReg.OBJCODE
loBarPop.n_ParentType = THIS.oReg.ObjType
loBarPop.analizarBloque( @tcLine, @taCodeLines, @I, @tnCodeLines, toConversor )
THIS.ADD( loBarPop )
EXIT
loBarPop = CREATEOBJECT('CL_MENU_BARPOP')
loBarPop.c_ParentName = ''
loBarPop.n_ParentCode = THIS.oReg.OBJCODE
loBarPop.n_ParentType = THIS.oReg.ObjType
loBarPop.analizarBloque( @tcLine, @taCodeLines, @I, @tnCodeLines, toConversor )
THIS.ADD( loBarPop )
CASE LEFT( tcLine, 13 ) == 'DEFINE POPUP '
loReg.OBJCODE = 22
loReg.PROCTYPE = 1
loReg.MARK = CHR(4)
loReg.SETUPTYPE = 1
loReg.CLEANTYPE = 1
loReg.ITEMNUM = STR(0,3)
*loReg.NAME = ALLTRIM( GETWORDNUM( tcLine, 3 ) )
*IF RIGHT(loReg.NAME,5) == '_FB2P' && Originalmente era vac<61>o y se la hab<61>a puesto un nombre temporal.
* loReg.NAME = ''
*ENDIF
*loReg.LevelName = loReg.NAME
loReg.SCHEME = 0
lcExpr = ALLTRIM( STREXTRACT( C_FB2PRG_CODE, 'ON SELECTION POPUP ALL ', CR_LF ) )
THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1, .F. )
IF loReg.ObjType = 4 && Shortcut menu
*-- Creo option
loOption = CREATEOBJECT("CL_MENU_OPTION")
loOption.oReg = toConversor.emptyRecord()
WITH loOption.oReg
.ObjType = 3
.OBJCODE = 77
.PROMPT = '\<Shortcut'
.LevelName = '_MSYSMENU'
loBarPop.ADD( loOption )
loBarPop.oReg.NUMITEMS = loBarPop.COUNT
.ITEMNUM = STR(loBarPop.COUNT,3)
.SCHEME = 0
IF EMPTY(lcProcCode)
*-- Comando
loReg.PROCEDURE = lcExpr
ELSE
*-- Procedure
lcProcCode = STRTRAN( lcProcCode, '<<ProcName>>', lcProcName )
loReg.PROCEDURE = lcProcCode
ENDIF
loBarPop = CREATEOBJECT('CL_MENU_BARPOP')
loBarPop.c_ParentName = ''
loBarPop.n_ParentCode = THIS.oReg.OBJCODE
loBarPop.n_ParentType = THIS.oReg.ObjType
loBarPop.analizarBloque( @tcLine, @taCodeLines, @I, @tnCodeLines, toConversor )
THIS.ADD( loBarPop )
*-- Creo option
loOption = CREATEOBJECT("CL_MENU_OPTION")
loOption.oReg = toConversor.emptyRecord()
WITH loOption.oReg
.ObjType = 3
.OBJCODE = 77
.MARK = CHR(0)
.PROMPT = '\<Shortcut'
.LevelName = '_MSYSMENU'
loBarPop.ADD( loOption )
loBarPop.oReg.NUMITEMS = loBarPop.COUNT
.ITEMNUM = STR(loBarPop.COUNT,3)
.SCHEME = 0
loBarPop = NULL
ENDWITH
*-- Creo BarPop
loBarPop = CREATEOBJECT('CL_MENU_BARPOP')
loBarPop.c_ParentName = ''
loBarPop.n_ParentCode = loOption.oReg.OBJCODE
loBarPop.n_ParentType = loOption.oReg.ObjType
loBarPop.analizarBloque( @tcLine, @taCodeLines, @I, @tnCodeLines, toConversor )
loOption.ADD( loBarPop )
loBarPop = NULL
ENDWITH
*-- Creo BarPop
loBarPop = CREATEOBJECT('CL_MENU_BARPOP')
loBarPop.c_ParentName = ''
loBarPop.n_ParentCode = loOption.oReg.OBJCODE
loBarPop.n_ParentType = loOption.oReg.ObjType
loBarPop.analizarBloque( @tcLine, @taCodeLines, @I, @tnCodeLines, toConversor )
loOption.ADD( loBarPop )
loBarPop = NULL
loOption = NULL
ENDIF
loOption = NULL
EXIT
OTHERWISE && Otro valor
I = I - 1
EXIT
ENDCASE
ENDFOR
ENDIF
CATCH TO loEx
@@ -14624,7 +14687,7 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
*---------------------------------------------------------------------------------------------------
TRY
LOCAL lcText, loReg, loHeader, lnNivel, lcEndProcedures, lcExpr, lcProcName, lcProcCode ;
LOCAL lcText, loReg, loHeader, lnNivel, lcEndProcedures, lcExpr, lcProcName, lcProcCode, lcLocation ;
, loEx AS EXCEPTION ;
, loCol_LastLevelName AS COLLECTION ;
, loBarPop AS CL_MENU_BARPOP OF 'FOXBIN2PRG.PRG' ;
@@ -14636,8 +14699,20 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
loBarPop = THIS.ITEM(1).oReg
lnNivel = 0
DO CASE
CASE loReg.Location = 0
lcLocation = 'REPLACE'
CASE loReg.Location = 1
lcLocation = 'APPEND'
CASE loReg.Location = 2
lcLocation = 'BEFORE ' + loReg.NAME
CASE loReg.Location = 3
lcLocation = 'AFTER ' + loReg.NAME
ENDCASE
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<C_MENUTYPE_I>><<loReg.ObjType>><<C_MENUTYPE_F>>
<<C_MENULOCATION_I>><<lcLocation>><<C_MENULOCATION_F>>
ENDTEXT
IF NOT EMPTY(loReg.SETUP)
@@ -14654,6 +14729,19 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
<<C_MENUCODE_I>>
ENDTEXT
DO CASE
CASE loHeader.ObjType = 1 && Menu Bar (Sistema)
lcText = lcText + CR_LF + 'DEFINE MENU _MSYSMENU BAR'
CASE loHeader.ObjType = 5 && Menu Bar (On top)
lcText = lcText + CR_LF + 'DEFINE MENU _ONTOP BAR'
CASE loHeader.ObjType = 4 && Shortcut
lcText = lcText + CR_LF + 'DEFINE POPUP ' + THIS.ITEM(1).ITEM(1).ITEM(1).oReg.NAME + ' SHORTCUT RELATIVE FROM MROW(),MCOL()'
ENDCASE
*-- Bars and Popups
IF THIS.COUNT > 0
FOR EACH loBarPop IN THIS FOXOBJECT
@@ -14802,7 +14890,7 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
+ ', Name=' + TRANSFORM(loReg.NAME) ;
+ ', LevelName=' + TRANSFORM(loReg.LevelName) ;
+ ', ItemNum=' + TRANSFORM(loReg.ITEMNUM) ;
+ ', Location=' + TRANSFORM(loReg.LOCATION) ;
+ ', Location=' + TRANSFORM(loReg.Location) ;
+ ', Prompt=' + TRANSFORM(loReg.PROMPT) ;
+ ', Message=' + TRANSFORM(loReg.MESSAGE) ;
+ ', KeyName=' + TRANSFORM(loReg.KEYNAME) ;
@@ -14875,7 +14963,7 @@ DEFINE CLASS CL_MENU_BARPOP AS CL_MENU_COL_BASE
TRY
LOCAL loOption AS CL_MENU_OPTION OF 'FOXBIN2PRG.PRG'
LOCAL llBloqueEncontrado, lcSubName, lcComment, lnLast_I, loReg, lcExpr, lcProcName, lcProcCode ;
LOCAL llBloqueEncontrado, lcSubName, lcComment, lnLast_I, loReg, lcExpr, lcProcName, lcProcCode, lcMenuType ;
, loEx AS EXCEPTION
STORE '' TO lcSubName, lcComment, lcExpr, lcProcName, lcProcCode
@@ -14883,6 +14971,7 @@ DEFINE CLASS CL_MENU_BARPOP AS CL_MENU_COL_BASE
loReg = THIS.oReg
loReg.ObjType = 2
loReg.PROCTYPE = 1
loReg.MARK = CHR(0)
loReg.ITEMNUM = STR(0,3)
llBloqueEncontrado = .T.
@@ -14900,33 +14989,41 @@ DEFINE CLASS CL_MENU_BARPOP AS CL_MENU_COL_BASE
CASE LEFT( tcLine, LEN(C_MENUCODE_F) ) == C_MENUCODE_F
EXIT
CASE LEFT( tcLine, LEN(C_MENUCODE_I) ) == C_MENUCODE_I
CASE LEFT( tcLine, LEN('ON SELECTION POPUP ' + loReg.NAME) ) == 'ON SELECTION POPUP ' + loReg.NAME
EXIT
CASE LEFT( tcLine, 12 ) == 'DEFINE MENU '
loReg.OBJCODE = 1
loReg.NAME = '_MSYSMENU'
loReg.LevelName = loReg.NAME
loReg.SCHEME = IIF( loReg.OBJCODE = 1, 3, 4 )
IF THIS.n_ParentType = 4
EXIT
ELSE
lcExpr = STREXTRACT( C_FB2PRG_CODE, 'ON SELECTION POPUP ALL ', CR_LF )
THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1 )
loReg.PROCEDURE = EVL(lcProcCode, lcExpr)
ENDIF
CASE LEFT( tcLine, LEN('ON SELECTION POPUP ' + loReg.NAME) ) == 'ON SELECTION POPUP ' + loReg.NAME
EXIT
lcExpr = STREXTRACT( C_FB2PRG_CODE, 'ON SELECTION POPUP ALL ', CR_LF )
THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1 )
loReg.PROCEDURE = EVL(lcProcCode, lcExpr)
CASE LEFT( tcLine, 13 ) == 'DEFINE POPUP '
loReg.OBJCODE = 0
loReg.NAME = ALLTRIM( GETWORDNUM( tcLine, 3 ) )
IF RIGHT(loReg.NAME,5) == '_FB2P' && Originalmente era vac<61>o y se la hab<61>a puesto un nombre temporal.
loReg.NAME = ''
IF THIS.n_ParentCode = 22
loReg.OBJCODE = 1
loReg.NAME = '_MSYSMENU'
loReg.LevelName = loReg.NAME
loReg.SCHEME = 3
IF THIS.n_ParentType = 4
EXIT
ENDIF
ELSE
loReg.OBJCODE = 0
loReg.SCHEME = 4
loReg.NAME = ALLTRIM( GETWORDNUM( tcLine, 3 ) )
IF RIGHT(loReg.NAME,5) == '_FB2P' && Originalmente era vac<61>o y se la hab<61>a puesto un nombre temporal.
loReg.NAME = ''
ENDIF
loReg.LevelName = loReg.NAME
lcExpr = ALLTRIM( STREXTRACT( C_FB2PRG_CODE, 'ON SELECTION POPUP ' + loReg.NAME + ' ', CR_LF ) )
THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1 )
loReg.PROCEDURE = EVL(lcProcCode, lcExpr)
ENDIF
loReg.LevelName = loReg.NAME
lcExpr = ALLTRIM( STREXTRACT( C_FB2PRG_CODE, 'ON SELECTION POPUP ' + loReg.NAME + ' ', CR_LF ) )
THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1 )
loReg.PROCEDURE = EVL(lcProcCode, lcExpr)
CASE LEFT( tcLine, 11 ) == 'DEFINE PAD ' OR LEFT( tcLine, 11 ) == 'DEFINE BAR '
loOption = CREATEOBJECT("CL_MENU_OPTION")
@@ -14993,10 +15090,6 @@ DEFINE CLASS CL_MENU_BARPOP AS CL_MENU_COL_BASE
IF toHeader.ObjType = 4
*-- Shortcut
IF NOT PEMSTATUS(toHeader,'_MenuInicializado', 5) && Header
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<lcTab>>*----------------------------------
<<lcTab>>DEFINE POPUP <<loReg.Name>> SHORTCUT RELATIVE FROM MROW(),MCOL()
ENDTEXT
ADDPROPERTY(toHeader,'_MenuInicializado', .T.)
ELSE && Rest
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
@@ -15099,6 +15192,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
THIS.oReg = toConversor.emptyRecord()
loReg = THIS.oReg
loReg.MARK = CHR(0)
loReg.ITEMNUM = STR(0,3)
llBloqueEncontrado = .T.
@@ -15216,7 +15310,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
loReg.NAME = lcPadName
loReg.LevelName = ALLTRIM( STREXTRACT( tcLine, ' OF ', ' PROMPT ' ) )
IF loReg.LevelName # THIS.c_ParentName
IF UPPER(loReg.LevelName) # UPPER(THIS.c_ParentName)
EXIT
ENDIF
@@ -15244,7 +15338,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
, '______,NONE__,LEFT__,MIDDLE,RIGHT_' ) / 7 - 1 )
lnNegObject = INT( AT( ',' + PADR( ALLTRIM(GETWORDNUM( lcExpr, 2, ',' )), 6, '_' ) ;
, '______,NONE__,LEFT__,MIDDLE,RIGHT_' ) / 7 - 1 )
loReg.LOCATION = lnNegContainer + lnNegObject * 2^4
loReg.Location = lnNegContainer + lnNegObject * 2^4
CASE LEFT( tcLine, 4 ) == 'KEY '
lcExpr = ALLTRIM( STREXTRACT( tcLine, 'KEY ', ';', 1, 2 ) )
@@ -15399,7 +15493,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
loReg.LevelName = ALLTRIM( STREXTRACT( tcLine, ' OF ', ' PROMPT ' ) )
IF loReg.LevelName # THIS.c_ParentName
IF UPPER(loReg.LevelName) # UPPER(THIS.c_ParentName)
EXIT
ENDIF
@@ -15427,7 +15521,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
, '______,NONE__,LEFT__,MIDDLE,RIGHT_' ) / 7 - 1 )
lnNegObject = INT( AT( ',' + PADR( ALLTRIM(GETWORDNUM( lcExpr, 2, ',' )), 6, '_' ) ;
, '______,NONE__,LEFT__,MIDDLE,RIGHT_' ) / 7 - 1 )
loReg.LOCATION = lnNegContainer + lnNegObject * 2^4
loReg.Location = lnNegContainer + lnNegObject * 2^4
CASE LEFT( tcLine, 4 ) == 'KEY '
lcExpr = ALLTRIM( STREXTRACT( tcLine, 'KEY ', ';', 1, 2 ) )
@@ -15719,9 +15813,9 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
+ ' PROMPT "' + toReg.PROMPT + '"' ;
+ ' COLOR SCHEME ' + TRANSFORM(toBarPop.SCHEME)
IF NOT EMPTY(toReg.LOCATION)
lnContainer = toReg.LOCATION % 2^4
lnObject = INT( (toReg.LOCATION - lnContainer) / 2^4 )
IF NOT EMPTY(toReg.Location)
lnContainer = toReg.Location % 2^4
lnObject = INT( (toReg.Location - lnContainer) / 2^4 )
lcText = lcText + ' ;' + CR_LF + lcTab + ' NEGOTIATE ' + GETWORDNUM('NONE,LEFT,MIDDLE,RIGHT',lnContainer+1,',') ;
+ ', ' + GETWORDNUM('NONE,LEFT,MIDDLE,RIGHT',lnObject+1,',')
ENDIF