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

Merge pull request #63 from lscheffler/fork_mod

Browse Source 
mnx bar number and pad name
This commit is contained in:
Doug Hennig
2021-04-22 13:16:31 -05:00
committed by GitHub
parent d612cf6698 61f82666d3
commit 665fc4bf67
13 changed files with 322 additions and 281 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
.github/ISSUE_TEMPLATE/bug_report.md vendored
View File

@@ -11,6 +11,7 @@ assignees: ''
- VFP version:
- FoxBin2PRG version:
- Last FoxBin2PRG version w/o bug (if available):
## 📝 Provide detailed reproduction steps (if any)

8
FoxBin2PRGVersionFile.txt
View File

@@ -2,7 +2,7 @@ Lparameters toUpdateInfo
Local lcNote
With toUpdateInfo
.VersionNumber = 'v1.19.57.0'
.VersionNumber = 'v1.19.64.0'
.VersionDate = Date(2021,03,25)
.SourceFileUrl = 'http://vfpxrepository.com/dl/thorupdate/Projects/FoxBin2Prg/FoxBin2Prg.Zip'
@@ -21,7 +21,11 @@ Demo video using FoxBin2Prg with PlasticSCM: http://youtu.be/sE4wQ50Itqg
+++++++++++++++++++++++ Change History +++++++++++++++++++++++
2021-08-12 v1.19.63
2021-04-22 v1.19.64
- Bug Fix: Converting MN2 to MNX ignores the programmer-defined bar # found in "Prompt Options" screen. (Jimrnelson)
- Bug Fix: Converting MN2 to MNX ignores the programmer-defined Pad Name found in "Prompt Options" screen. (LScheffler)
2021-04-12 v1.19.63
- Bug Fix: Tables without indexes cause an error that the __Table ## is not marked as belonging to the ## database.__ (jstagerGH)
2021-03-23 v1.19.62

56
README.md
View File

@@ -125,30 +125,7 @@ To view a copy of this license, visit http://creativecommons.org/licenses/by/4.0
## Changes
See [Changes](./docs/FoxBin2prg_Changes.md)
## Changes in 1.19.60
* -cC options learned to create default FoxBin2Prg._cfg file
* -t Option learned to create default \<TableName\>._cfg file, if table is open.
* Handling of additional non structural index per DBF in Bin2Text and Text2Bin
* Debug-Logging for Index
* Bug Fix: DBF_Conversion_Condition was read, but never used
* Bug Fix: DBF_Conversion_Order sets an index that later would be stored as structural index
* Bug Fix: config options with text value fail, if line comment is set
## Changes in 1.19.59
* Added support for writing to a different folder than the source code using a new tcOutputFolder parameter
* Added a configuration item: HomeDir, which determines if HomeDir is saved in PJ2 files (the default is 1 for Yes)
* Logging of settings as settings object passed to execute method (Option debug > 0)
* Bug Fixes: RedirectClassType = 2
* Improved, Better description of ClassPerFileCheck and tcOutputFolder.
* Added option to create config file template based on current values of a directory
To create config file (working settings) with all values set for a folder.
Intended for storing the settings with the project.
```
DO FOXBIN2PRG.PRG WITH "-C","template.cfg" ==> Generates a file like FoxBin2Prg.cfg config file with recent settings
```
## Changes to Settings
### Changes to Settings
To get the new settings in config file, use the new create-a-template function:
```
@@ -157,37 +134,8 @@ DO FOXBIN2PRG.PRG WITH "-C","template.cfg" ==> Generates a template for Fox
DO FOXBIN2PRG.PRG WITH "-t","template.dbf.cfg" ==> Generates a template for table.dbf.cfg per table config file with newest settings
```
### Split of container files
VCX, SCX and DBC are container that hold different items. There is was a single option to split them.
The split of DBC the same way like VCX/SCX might not be the best choice under all circumstances.
New option _OldFilesPerDBC_ is set 1, _UseFilesPerDBC_, _RedirectFilePerDBCToMain_ and _ItemPerDBCCheck_ might be used to set the handling of the DBC.
Note that those options will be ignored, if _OldFilesPerDBC_ is 0 (default).
**Check that changes will be reflected on running projects.**
See [Internals](./docs/FoxBin2prg_Internals.md#configuration-file).
### Tanscoding of table fields with NoCPTrans
The function _DBF_BinChar_Base64: 0_ must be handled with care too.
Tables must converted to _Text_ according. **It's not recommended for running projects. Handle with extra care otherwise.**
### Inclusion of deleted records
Sometimes information left in deleted (table) records is still valuable information.
The new option _DBF_IncludeDeleted_ allows to keep those records throug conversion.
The data added by _DBF_IncludeDeleted: 1_ will be ignored by old versions generating _Binary_ files.
#### Recomendation
It's a good idea to have the _FoxBin2Prg.cfg_ per projekt and and source control,
old commits / versions would have the old config.
So the settings would fit the data and FoxBin2Prg could generate according to it.
---
---
# Folder information
Project to generate text representations of VFP binary sources for source control
## ./
This folder containes the files necessary to run FoxBin2Prg.prg or to create the FoxBin2Prg.exe
For usage see [documentation](./docs/FoxBin2prg.md)
----
## Usage
Last changed: _2021/03/09_ ![Picture](./pictures/vfpxpoweredby_alternative.gif)

BIN
ThorUpdater/FoxBin2Prg.zip
View File

Binary file not shown.

10
ThorUpdater/FoxBin2PrgVersion.txt
View File

@@ -10,8 +10,8 @@ local;
lcappName = "FoxBin2Prg"
*Set following two numbers on version
ldDate = date(2021,04,12)
lcmajorVersion = "1.19.63"
ldDate = date(2021,04,22)
lcmajorVersion = "1.19.64"
*lnJulian = val(sys(11, m.ldDate)) - val(sys(11, {^2000-01-01}))
*lcJulian = padl(transform(lnJulian), 4, '0')
@@ -39,7 +39,11 @@ Demo video using FoxBin2Prg with PlasticSCM: http://youtu.be/sE4wQ50Itqg
+++++++++++++++++++++++ Change History +++++++++++++++++++++++
2021-08-12 v1.19.63
2021-04-22 v1.19.64
- Bug Fix: Converting MN2 to MNX ignores the programmer-defined bar # found in "Prompt Options" screen. (Jimrnelson)
- Bug Fix: Converting MN2 to MNX ignores the programmer-defined Pad Name found in "Prompt Options" screen. (LScheffler)
2021-04-12 v1.19.63
- Bug Fix: Tables without indexes cause an error that the __Table ## is not marked as belonging to the ## database.__ (jstagerGH)
2021-03-23 v1.19.62

2
docs/FoxBin2Prg_Changes.md
View File

@@ -30,6 +30,8 @@ _**Note:** you can click on the version number for downloading this version from
| Rel.Date | Developer | Version | Details |
| - | - | - | - |
| 2021/04/22 | LScheffler | [v1.19.64](https://github.com/fdbozzo/foxbin2prg/releases/tag/v1.19.64) | **Bug Fix**: onverting MN2 to MNX ignores the programmer-defined bar # found in "Prompt Options" screen. (Jimrnelson) |
| | | | **Bug Fix**: Converting MN2 to MNX ignores the programmer-defined Pad Name found in "Prompt Options" screen. (LScheffler) |
| 2021/04/12 | LScheffler | [v1.19.63](https://github.com/fdbozzo/foxbin2prg/releases/tag/v1.19.63) | **Bug Fix**: Tables without indexes cause an error that the __Table ## is not marked as belonging to the ## database.__ (jstagerGH) |
| 2021/03/30 | LScheffler | [v1.19.62](https://github.com/fdbozzo/foxbin2prg/releases/tag/v1.19.62) | **Enhancement**: Debug logging, level of config file. |
| | | | **Bug Fix**: *_Conversion_Support options not read from config file. |

2
foxbin2prg.cfg.txt
View File

@@ -1,6 +1,6 @@
*################################################################################################################
*FOXBIN2PRG.CFG configuration options: (If no values given, these are the DEFAULTS)
*Version: v1.19.63
*Version: v1.19.64
*****************************************************************************************************************
*-- Settings for internal work, not processing

2
foxbin2prg.dbf.cfg.txt
View File

@@ -1,6 +1,6 @@
*################################################################################################################
*-- Individual DBF configuration file (syntax: filename.dbf.cfg) Defaults see FoxBin2prg.cfg
*Version: v1.19.63
*Version: v1.19.64
*****************************************************************************************************************
*DBF_Conversion_Support: <0,1,2,4,8> && 0=No support, 1=Generate Header TXT only (Diff), 2=Generate Header TXT and BIN (Merge/Only Structure!), 4=Generate TXT with DATA (Diff), 8=Export and Import DATA (Merge/Structure & Data)

BIN
foxbin2prg.exe
View File

Binary file not shown.

2
foxbin2prg.pj2
View File

@@ -26,7 +26,7 @@ _LegalTrademark = "MIT License"
_ProductName = "FOXBIN2PRG"
_MajorVer = "1"
_MinorVer = "19"
_Revision = "63"
_Revision = "64"
_LanguageID = "1034"
_AutoIncrement = "0"
*</DevInfo>

BIN
foxbin2prg.pjt
View File

Binary file not shown.

BIN
foxbin2prg.pjx
View File

Binary file not shown.

520
foxbin2prg.prg
View File

@@ -271,10 +271,14 @@
* 30/03/2021 LScheffler v1.19.62 Enhancement: Debug logging, level of config file.
* 12/04/2021 LScheffler v1.19.63 Bug Fix: Tables without indexes cause an error that the "Table ## is not marked as belonging to the ## database" (jstagerGH)
* 12/04/2021 LScheffler v1.19.63 Docu: Readme reworked (mattslay)
* 22/04/2021 LScheffler v1.19.64 Bug Fix: Converting MN2 to MNX ignores the programmer-defined bar # found in "Prompt Options" screen (Jimrnelson)
* 22/04/2021 LScheffler v1.19.64 Bug Fix: Converting MN2 to MNX ignores the programmer-defined Pad Name found in "Prompt Options" screen (LScheffler)
* </HISTORIAL DE CAMBIOS Y NOTAS IMPORTANTES>
*
*---------------------------------------------------------------------------------------------------
* <TESTEO, REPORTE DE BUGS Y MEJORAS (AGRADECIMIENTOS)>
* 22/04/2021 LScheffler BUG REPORT v1.19.63 Converting MN2 to MNX ignores the programmer-defined Pad Name found in "Prompt Options" screen
* 21/04/2021 Jimrnelson BUG REPORT v1.19.63 Converting MN2 to MNX ignores the programmer-defined bar # found in "Prompt Options" screen
* 08/04/2021 jstagerGH BUG REPORT v1.19.62 Tables without indexes cause an error that the "Table ## is not marked as belonging to the ## database"
* 30/03/2021 Sergej s-s-a BUG REPORT v1.19.61 Ignoring extention in foxbin2prg.cfg
* 16/03/2021 msueping BUG REPORT v1.19.57 Variable lnFileCount in get_filesfromdirectory
@@ -934,7 +938,7 @@ Define Class c_foxbin2prg As Session
Protected n_CFG_Actual, l_Main_CFG_Loaded, o_Configuration, l_CFG_CachedAccess
*--
n_FB2PRG_Version = 1.19
c_FB2PRG_Version_Real = '1.19.63'
c_FB2PRG_Version_Real = '1.19.64'
*--
c_Language = '' && EN, FR, ES, DE
c_Language_In = '(auto)'
@@ -28426,6 +28430,241 @@ Define Class CL_MENU_OPTION As CL_MENU_COL_BASE
Endproc
Procedure analyzeCodeBlock_DefineBAR
*---------------------------------------------------------------------------------------------------
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
* taCodeLines (!@ IN ) Array de líneas del programa analizado
* I (!@ IN/OUT) Número de línea en análisis
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
* toConversor (v! IN ) Referencia al conversor para poder usar sus métodos
*---------------------------------------------------------------------------------------------------
Lparameters tcLine, taCodeLines, I, tnCodeLines, toConversor
#If .F.
Local toConversor As c_conversor_prg_a_mnx Of 'FOXBIN2PRG.PRG'
#Endif
Try
Local llBloqueEncontrado, lcText, loReg, lnPos, lcBarName, lcExpr, lcComment, lcProcName, lcProcCode, loEx As Exception ;
, lnNegContainer, lnNegObject
Store '' To lcText, lcComment, lcBarName
* Estructura ejemplo a analizar:
*--------------------------------
* DEFINE BAR _3YM1DR90Z OF _MSYSMENU PROMPT "Opción A con submenú" COLOR SCHEME 3 ;
* NEGOTIATE NONE, LEFT ;
* KEY DEL, "Pulsar <DEL>" ;
* SKIP FOR SKIP_FOR() ;
* MESSAGE "Mensaje para Opción A con submenú" && Comentario
*
* ON BAR _3YM1DR90Z OF _MSYSMENU ACTIVATE POPUP OpciónA_CS
*
* DEFINE BAR 1 OF _MSYSMENU PROMPT "Opción A con submenú" ;
* NEGOTIATE NONE, LEFT ;
* KEY DEL, "Pulsar <DEL>" ;
* SKIP FOR SKIP_FOR() ;
* MESSAGE "Mensaje para Opción A con submenú" && Comentario
*
* ON BAR 1 OF _MSYSMENU ACTIVATE POPUP OpciónA_CS
*--------------------------------
If Left( tcLine, 11 ) == 'DEFINE BAR '
llBloqueEncontrado = .T.
With This As CL_MENU_OPTION Of 'FOXBIN2PRG.PRG'
loReg = .oReg
loReg.ObjType = C_OBJTYPE_MENUTYPE_OPTION
lcBarName = Alltrim( Strextract( tcLine, 'BAR ' , ' OF' ) )
*!* Changd By: SF 22.4.2021
*!* <pdm>
*!* <change date="{^2021-04-22,06:49:00}">Changd By: SF<br />
*!* Old style determeines generic name from set name by testing as digit. It could be only digit. :(
*!* New style wraps it in ", so anything in " is set name
*!* </change>
*!* </pdm>
Do Case
Case LEFT ( m.lcBarName, 1 ) = '"'
lcBarName = Substr( m.lcBarName, 2, Len( m.lcBarName ) - 2 )
loReg.Name = m.lcBarName
loReg.OBJCODE = C_OBJCODE_MENUOPTION_BARNUM
Case Isdigit( m.lcBarName )
*-- Bar#
loReg.OBJCODE = C_OBJCODE_MENUOPTION_BARNUM
Otherwise
*-- Es un BAR del sistema
loReg.Name = m.lcBarName
Endcase
*!* /Changd By: SF 22.4.2021
loReg.LevelName = Alltrim( Strextract( tcLine, ' OF ', ' PROMPT ' ) )
If Upper(loReg.LevelName) # Upper(.c_ParentName)
Exit
Endif
loReg.Prompt = Alltrim( Strextract( tcLine, ' PROMPT ', ';', 1, 2 ) )
loReg.Prompt = Substr( loReg.Prompt, 2, Len( loReg.Prompt ) - 2 )
*-- ANALISIS DEL "DEFINE BAR"
Do Case
Case ';' $ tcLine
For I = m.I + 1 To tnCodeLines
.set_Line( @tcLine, @taCodeLines, m.I )
If Empty(loReg.Comment) && No volver a buscar el comentario si ya existe
*-- Busco si tiene comentario
If .get_SeparatedLineAndComment( @tcLine, @lcComment )
loReg.Comment = Strtran( Strtran( lcComment, '<CR>', Chr(13) ), '<LF>', Chr(10) )
Endif
Endif
Do Case
Case Left( tcLine, 10 ) == 'NEGOTIATE '
lcExpr = Alltrim( Strextract( tcLine, 'NEGOTIATE ', ';', 1, 2 ) )
lnNegContainer = Int( At( ',' + Padr( Alltrim(Getwordnum( lcExpr, 1, ',' )), 6, '_' ) ;
, '______,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
Case Left( tcLine, 4 ) == 'KEY '
lcExpr = Alltrim( Strextract( tcLine, 'KEY ', ';', 1, 2 ) )
lnPos = At( ',', lcExpr )
loReg.KEYNAME = Alltrim( Left( lcExpr, lnPos-1 ) )
loReg.KeyLabel = Alltrim( Strextract( lcExpr, '"', '"' ) )
Case Left( tcLine, 9 ) == 'SKIP FOR '
loReg.SkipFor = Alltrim( Strextract( tcLine, 'SKIP FOR ', ';', 1, 2 ) )
Case Left( tcLine, 8 ) == 'MESSAGE '
loReg.Message = Alltrim( Substr( tcLine, 9 ) )
Case Left( tcLine, 8 ) == 'PICTURE '
loReg.RESNAME = Alltrim( Strextract( tcLine, '"', '"' ) )
Case Left( tcLine, 8 ) == 'PICTRES '
loReg.RESNAME = Alltrim( Strextract( tcLine, 'PICTRES ', ';', 1, 2 ) )
loReg.SYSRES = 1
Otherwise
* Nada
Endcase
If Not ';' $ tcLine && Fin
Exit
Endif
Endfor
Case .set_Line( @tcLine, @taCodeLines, m.I ) And .get_SeparatedLineAndComment( @tcLine, @lcComment )
*-- Es un Bar de una sola línea y con comentarios
loReg.Comment = Strtran( Strtran( lcComment, '<CR>', Chr(13) ), '<LF>', Chr(10) )
Endcase
*!* Changd By: SF 22.4.2021
*!* <pdm>
*!* <change date="{^2021-04-22,15:26:00}">Changd By: SF<br />
*!* This is not valid here - "_" is never set in get_DefineBarText
*!* </change>
*!* </pdm>
*!* If Left(lcBarName,1) == '_'
*!* *-- Es un BAR del Sistema, así que no tiene ON BAR ni nada más.
*!* loReg.OBJCODE = C_OBJCODE_MENUOPTION_BARNUM && Bar#
*!* I = m.I + 1
*!* Exit
*!* Endif
*!* /Changd By: SF 22.4.2021
* Estructuras ejemplo a analizar:
*--------------------------------
* 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"
For I = m.I + 1 To tnCodeLines
.set_Line( @tcLine, @taCodeLines, m.I )
Do Case
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 = C_OBJCODE_MENUOPTION_SUBMENU && Submenu
I = m.I + 1
Exit
Case Left( tcLine, 17 ) == 'ON SELECTION BAR '
lcExpr = Alltrim( Strextract( tcLine, ' OF ' + loReg.LevelName + ' ', '', 1, 2 ) )
.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1, .F. )
Do Case
Case Not Empty(lcProcCode)
loReg.Procedure = Strtran( lcProcCode, '<<ProcName>>', lcProcName )
If Empty( loReg.Procedure )
loReg.OBJCODE = C_OBJCODE_MENUOPTION_COMMAND
loReg.Command = lcExpr
Else
loReg.OBJCODE = C_OBJCODE_MENUOPTION_PROCEDURE
loReg.ProcType = 1
Endif
Otherwise
loReg.OBJCODE = C_OBJCODE_MENUOPTION_COMMAND && Command
loReg.Command = lcExpr
Endcase
I = m.I + 1
Exit
Case Left( tcLine, 19 ) == 'ON SELECTION POPUP '
Exit
Otherwise
* Nada
Endcase
If Not ';' $ tcLine && Fin
I = m.I + 1
Exit
Endif
Endfor
Endwith && THIS
I = m.I - 1
Endif
Catch To loEx
If This.n_Debug > 0 And _vfp.StartMode = 0
Set Step On
Endif
Throw
Endtry
Return llBloqueEncontrado
Endproc
Procedure analyzeCodeBlock_DefinePAD
*---------------------------------------------------------------------------------------------------
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
@@ -28464,7 +28703,22 @@ Define Class CL_MENU_OPTION As CL_MENU_COL_BASE
loReg = .oReg
loReg.ObjType = C_OBJTYPE_MENUTYPE_OPTION
lcPadName = Alltrim( Strextract( tcLine, 'PAD ' , ' OF' ) )
loReg.Name = lcPadName
*!* Changd By: SF 22.4.2021
*!* <pdm>
*!* <change date="{^2021-04-22,15:56:00}">Changd By: SF<br />
*!* Old style determeines generic name from set name by testing as digit. It could be only digit. :(
*!* New style wraps it in ", so anything in " is set name
*!* </change>
*!* </pdm>
*!* loReg.Name = lcPadName
IF LEFT ( m.lcPadName, 1 ) = '"' THEN
lcPadName = Substr( m.lcPadName, 2, Len( m.lcPadName ) - 2 )
loReg.Name = m.lcPadName
ENDIF &&LEFT ( m.lcPadName, 1 ) = '"'
*!* /Changd By: SF 22.4.2021
loReg.LevelName = Alltrim( Strextract( tcLine, ' OF ', ' PROMPT ' ) )
If Upper(loReg.LevelName) # Upper(.c_ParentName)
@@ -28610,216 +28864,6 @@ Define Class CL_MENU_OPTION As CL_MENU_COL_BASE
Endproc
Procedure analyzeCodeBlock_DefineBAR
*---------------------------------------------------------------------------------------------------
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
* tcLine (!@ IN/OUT) Contenido de la línea en análisis
* taCodeLines (!@ IN ) Array de líneas del programa analizado
* I (!@ IN/OUT) Número de línea en análisis
* tnCodeLines (!@ IN ) Cantidad de líneas del programa analizado
* toConversor (v! IN ) Referencia al conversor para poder usar sus métodos
*---------------------------------------------------------------------------------------------------
Lparameters tcLine, taCodeLines, I, tnCodeLines, toConversor
#If .F.
Local toConversor As c_conversor_prg_a_mnx Of 'FOXBIN2PRG.PRG'
#Endif
Try
Local llBloqueEncontrado, lcText, loReg, lnPos, lcBarName, lcExpr, lcComment, lcProcName, lcProcCode, loEx As Exception ;
, lnNegContainer, lnNegObject
Store '' To lcText, lcComment, lcBarName
* Estructura ejemplo a analizar:
*--------------------------------
* DEFINE BAR _3YM1DR90Z OF _MSYSMENU PROMPT "Opción A con submenú" COLOR SCHEME 3 ;
* NEGOTIATE NONE, LEFT ;
* KEY DEL, "Pulsar <DEL>" ;
* SKIP FOR SKIP_FOR() ;
* MESSAGE "Mensaje para Opción A con submenú" && Comentario
*
* ON BAR _3YM1DR90Z OF _MSYSMENU ACTIVATE POPUP OpciónA_CS
*
* DEFINE BAR 1 OF _MSYSMENU PROMPT "Opción A con submenú" ;
* NEGOTIATE NONE, LEFT ;
* KEY DEL, "Pulsar <DEL>" ;
* SKIP FOR SKIP_FOR() ;
* MESSAGE "Mensaje para Opción A con submenú" && Comentario
*
* ON BAR 1 OF _MSYSMENU ACTIVATE POPUP OpciónA_CS
*--------------------------------
If Left( tcLine, 11 ) == 'DEFINE BAR '
llBloqueEncontrado = .T.
With This As CL_MENU_OPTION Of 'FOXBIN2PRG.PRG'
loReg = .oReg
loReg.ObjType = C_OBJTYPE_MENUTYPE_OPTION
lcBarName = Alltrim( Strextract( tcLine, 'BAR ' , ' OF' ) )
If Isdigit(lcBarName)
*-- Bar#
loReg.OBJCODE = C_OBJCODE_MENUOPTION_BARNUM
Else
*-- Es un BAR del sistema
loReg.Name = lcBarName
Endif
loReg.LevelName = Alltrim( Strextract( tcLine, ' OF ', ' PROMPT ' ) )
If Upper(loReg.LevelName) # Upper(.c_ParentName)
Exit
Endif
loReg.Prompt = Alltrim( Strextract( tcLine, ' PROMPT ', ';', 1, 2 ) )
loReg.Prompt = Substr( loReg.Prompt, 2, Len( loReg.Prompt ) - 2 )
*-- ANALISIS DEL "DEFINE BAR"
Do Case
Case ';' $ tcLine
For I = m.I + 1 To tnCodeLines
.set_Line( @tcLine, @taCodeLines, m.I )
If Empty(loReg.Comment) && No volver a buscar el comentario si ya existe
*-- Busco si tiene comentario
If .get_SeparatedLineAndComment( @tcLine, @lcComment )
loReg.Comment = Strtran( Strtran( lcComment, '<CR>', Chr(13) ), '<LF>', Chr(10) )
Endif
Endif
Do Case
Case Left( tcLine, 10 ) == 'NEGOTIATE '
lcExpr = Alltrim( Strextract( tcLine, 'NEGOTIATE ', ';', 1, 2 ) )
lnNegContainer = Int( At( ',' + Padr( Alltrim(Getwordnum( lcExpr, 1, ',' )), 6, '_' ) ;
, '______,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
Case Left( tcLine, 4 ) == 'KEY '
lcExpr = Alltrim( Strextract( tcLine, 'KEY ', ';', 1, 2 ) )
lnPos = At( ',', lcExpr )
loReg.KEYNAME = Alltrim( Left( lcExpr, lnPos-1 ) )
loReg.KeyLabel = Alltrim( Strextract( lcExpr, '"', '"' ) )
Case Left( tcLine, 9 ) == 'SKIP FOR '
loReg.SkipFor = Alltrim( Strextract( tcLine, 'SKIP FOR ', ';', 1, 2 ) )
Case Left( tcLine, 8 ) == 'MESSAGE '
loReg.Message = Alltrim( Substr( tcLine, 9 ) )
Case Left( tcLine, 8 ) == 'PICTURE '
loReg.RESNAME = Alltrim( Strextract( tcLine, '"', '"' ) )
Case Left( tcLine, 8 ) == 'PICTRES '
loReg.RESNAME = Alltrim( Strextract( tcLine, 'PICTRES ', ';', 1, 2 ) )
loReg.SYSRES = 1
Otherwise
* Nada
Endcase
If Not ';' $ tcLine && Fin
Exit
Endif
Endfor
Case .set_Line( @tcLine, @taCodeLines, m.I ) And .get_SeparatedLineAndComment( @tcLine, @lcComment )
*-- Es un Bar de una sola línea y con comentarios
loReg.Comment = Strtran( Strtran( lcComment, '<CR>', Chr(13) ), '<LF>', Chr(10) )
Endcase
If Left(lcBarName,1) == '_'
*-- Es un BAR del Sistema, así que no tiene ON BAR ni nada más.
loReg.OBJCODE = C_OBJCODE_MENUOPTION_BARNUM && Bar#
I = m.I + 1
Exit
Endif
* Estructuras ejemplo a analizar:
*--------------------------------
* 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"
For I = m.I + 1 To tnCodeLines
.set_Line( @tcLine, @taCodeLines, m.I )
Do Case
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 = C_OBJCODE_MENUOPTION_SUBMENU && Submenu
I = m.I + 1
Exit
Case Left( tcLine, 17 ) == 'ON SELECTION BAR '
lcExpr = Alltrim( Strextract( tcLine, ' OF ' + loReg.LevelName + ' ', '', 1, 2 ) )
.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1, .F. )
Do Case
Case Not Empty(lcProcCode)
loReg.Procedure = Strtran( lcProcCode, '<<ProcName>>', lcProcName )
If Empty( loReg.Procedure )
loReg.OBJCODE = C_OBJCODE_MENUOPTION_COMMAND
loReg.Command = lcExpr
Else
loReg.OBJCODE = C_OBJCODE_MENUOPTION_PROCEDURE
loReg.ProcType = 1
Endif
Otherwise
loReg.OBJCODE = C_OBJCODE_MENUOPTION_COMMAND && Command
loReg.Command = lcExpr
Endcase
I = m.I + 1
Exit
Case Left( tcLine, 19 ) == 'ON SELECTION POPUP '
Exit
Otherwise
* Nada
Endcase
If Not ';' $ tcLine && Fin
I = m.I + 1
Exit
Endif
Endfor
Endwith && THIS
I = m.I - 1
Endif
Catch To loEx
If This.n_Debug > 0 And _vfp.StartMode = 0
Set Step On
Endif
Throw
Endtry
Return llBloqueEncontrado
Endproc
Procedure toText
*---------------------------------------------------------------------------------------------------
* PARÁMETROS: (v=Pasar por valor | @=Pasar por referencia) (!=Obligatorio | ?=Opcional) (IN/OUT)
@@ -28931,14 +28975,34 @@ Define Class CL_MENU_OPTION As CL_MENU_COL_BASE
Try
Local lcText, lcTab, loEx As Exception ;
, loBarPop As CL_MENU_BARPOP Of 'FOXBIN2PRG.PRG'
, loBarPop As CL_MENU_BARPOP Of 'FOXBIN2PRG.PRG' ;
, lcName , lcName2
Store Null To loBarPop
lcTab = Replicate(Chr(9),tnNivel)
lcText = ''
*!* Changed by SF 22.4.2021
*!* <pdm>
*!* <change date="{^2021-04-22,06:24:00}">Changed by SF<br />
*!* If the BAR real name starts (legaly) with a digit it could not be recreated
*!* added code to add additional information to recreate the name
*!* name will wrap into " , so we got DEFINE BAR "Number" OF
*!* also use variable on all places instead of EVL(..
*!* </change>
*!* </pdm>
If !Empty(toReg.Name) And ISDIGIT( toReg.Name ) Then
lcName = ALLTRIM( toReg.Name )
lcName2 = '"' + Alltrim(toReg.Name) + '"'
Else &&!Empty(toReg.Name) And ISDIGIT( toReg.Name )
lcName = Alltrim( Evl( toReg.Name, toReg.ItemNum ) )
lcName2 = m.lcName
Endif &&!Empty(toReg.Name) And ISDIGIT( toReg.Name )
* SF
* location of definition of MENU BAR Evl( toReg.Name, toReg.ItemNum )
* /SF
*-- 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 ' + m.lcName2 + ' OF ' + Alltrim(toReg.LevelName) ;
+ ' PROMPT "' + toReg.Prompt + '"'
If Not Empty(toReg.KEYNAME)
@@ -28971,10 +29035,10 @@ Define Class CL_MENU_OPTION As CL_MENU_COL_BASE
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 ' + m.lcName + ' 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 ' + m.lcName + ' OF ' + Alltrim(toReg.LevelName)
Do Case
Case toReg.OBJCODE = C_OBJCODE_MENUOPTION_COMMAND && Command
@@ -29003,6 +29067,7 @@ Define Class CL_MENU_OPTION As CL_MENU_COL_BASE
Release lcTab, loBarPop
Endtry
*!* /Changed by SF 22.4.2021
Return lcText
Endproc
@@ -29017,18 +29082,35 @@ Define Class CL_MENU_OPTION As CL_MENU_COL_BASE
* toHeader (v! IN ) Objeto Registro de cabecera del menu
*---------------------------------------------------------------------------------------------------
Lparameters toReg, toBarPop, tnNivel, toHeader
*!* Changed by SF 21.4.2021
*!* <pdm>
*!* <change date="{^2021-04-21,22:33:00}">Changed by SF<br />
*!* If the PAD real name starts (leagly) with "_" it could not be recreated
*!* added code to add additional information to recreate the name
*!* name will simple wrapped into ", so we got DEFINE PAD "_Name" OF
*!* </change>
*!* </pdm>
Try
Local lcText, lcTab, lnContainer, lnObject, loEx As Exception ;
, loBarPop As CL_MENU_BARPOP Of 'FOXBIN2PRG.PRG'
, loBarPop As CL_MENU_BARPOP Of 'FOXBIN2PRG.PRG' ;
, lcName2
Store Null To loBarPop
lcTab = Replicate(Chr(9),tnNivel)
toReg.Name = Evl(toReg.Name, '_' + Transform( Int( Val( toReg.ItemNum ) ), '@L #########') )
If !Empty(toReg.Name) And LEFT( toReg.Name, 1 ) = '_' Then
lcName2 = '"' + Alltrim(toReg.Name) + '"'
toReg.Name = toReg.Name
Else &&!EMPTY(toReg.Name) AND toReg.Name = '_'
toReg.Name = Evl(toReg.Name, '_' + Transform( Int( Val( toReg.ItemNum ) ), '@L #########') )
lcName2 = Alltrim(toReg.Name)
Endif &&!EMPTY(toReg.Name) AND toReg.Name = '_'
*!* /Changed by SF 21.4.2021
lcText = ''
*-- DEFINE PAD
*lcText = lcTab + '*----------------------------------' + CR_LF
lcText = lcText + lcTab + 'DEFINE PAD ' + Alltrim(toReg.Name) + ' OF ' + Alltrim(toReg.LevelName) ;
lcText = lcText + lcTab + 'DEFINE PAD ' + m.lcName2 + ' OF ' + Alltrim(toReg.LevelName) ;
+ ' PROMPT "' + toReg.Prompt + '"' ;
+ ' COLOR SCHEME ' + Transform(toBarPop.Scheme)