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

Changeset: 122 Fin desarrollo Menu > Texto > Menu! :-)

Browse Source
This commit is contained in:
fernando
2014-01-02 01:24:51 +01:00
parent 578a46f5a6
commit 7c14118efc
3 changed files with 293 additions and 269 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
foxbin2prg.pjt
View File

Binary file not shown.

BIN
foxbin2prg.pjx
View File

Binary file not shown.

490
foxbin2prg.prg
View File

@@ -2852,24 +2852,24 @@ DEFINE CLASS c_conversor_prg_a_bin AS c_conversor_base
CREATE TABLE (THIS.c_OutputFile) ; CREATE TABLE (THIS.c_OutputFile) ;
( 'OBJTYPE' Numeric(2) ; ( 'OBJTYPE' Numeric(2) ;
, 'OBJCODE' Numeric(2) ; , 'OBJCODE' Numeric(2) ;
, 'NAME' Memo ; , 'NAME' MEMO ;
, 'PROMPT' Memo ; , 'PROMPT' MEMO ;
, 'COMMAND' Memo ; , 'COMMAND' MEMO ;
, 'MESSAGE' Memo ; , 'MESSAGE' MEMO ;
, 'PROCTYPE' Numeric(1) ; , 'PROCTYPE' Numeric(1) ;
, 'PROCEDURE' Memo ; , 'PROCEDURE' MEMO ;
, 'SETUPTYPE' Numeric(1) ; , 'SETUPTYPE' Numeric(1) ;
, 'SETUP' Memo ; , 'SETUP' MEMO ;
, 'CLEANTYPE' Numeric(1) ; , 'CLEANTYPE' Numeric(1) ;
, 'CLEANUP' Memo ; , 'CLEANUP' MEMO ;
, 'MARK' Character(1) ; , 'MARK' CHARACTER(1) ;
, 'KEYNAME' Memo ; , 'KEYNAME' MEMO ;
, 'KEYLABEL' Memo ; , 'KEYLABEL' MEMO ;
, 'SKIPFOR' Memo ; , 'SKIPFOR' MEMO ;
, 'NAMECHANGE' Logical ; , 'NAMECHANGE' Logical ;
, 'NUMITEMS' Numeric(2) ; , 'NUMITEMS' Numeric(2) ;
, 'LEVELNAME' Character(10) ; , 'LEVELNAME' CHARACTER(10) ;
, 'ITEMNUM' Character(3) ; , 'ITEMNUM' CHARACTER(3) ;
, 'COMMENT' MEMORY(4) ; , 'COMMENT' MEMORY(4) ;
, 'LOCATION' Numeric(2) ; , 'LOCATION' Numeric(2) ;
, 'SCHEME' Numeric(2) ; , 'SCHEME' Numeric(2) ;
@@ -14225,7 +14225,8 @@ DEFINE CLASS CL_MENU_COL_BASE AS CL_COL_BASE
tcProcCode = '' tcProcCode = ''
IF tlAddProcEndproc IF tlAddProcEndproc
tcProcCode = '*' + REPLICATE('-',34) + CR_LF + 'PROCEDURE <<ProcName>>' + CR_LF *tcProcCode = '*' + REPLICATE('-',34) + CR_LF + 'PROCEDURE <<ProcName>>' + CR_LF
tcProcCode = 'PROCEDURE <<ProcName>>' + CR_LF
ENDIF ENDIF
DO CASE DO CASE
@@ -14321,30 +14322,6 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
THIS.oReg = toConversor.emptyRecord() THIS.oReg = toConversor.emptyRecord()
loReg = THIS.oReg loReg = THIS.oReg
WITH loReg
.OBJCODE = 22
.PROCTYPE = 1
.MARK = CHR(4)
.LOCATION = 1
.SETUPTYPE = 1
.CLEANTYPE = 1
.ITEMNUM = STR(0,3)
lcExpr = ALLTRIM( STREXTRACT( C_FB2PRG_CODE, 'ON SELECTION MENU _MSYSMENU ', CR_LF ) )
IF NOT EMPTY(lcExpr)
THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1, .F. )
IF EMPTY(lcProcCode)
*-- Comando
.PROCEDURE = lcExpr
ELSE
*-- Procedure
lcProcCode = STRTRAN( lcProcCode, '<<ProcName>>', lcProcName )
.PROCEDURE = lcProcCode
ENDIF
ENDIF
ENDWITH
FOR I = I + 0 TO tnCodeLines FOR I = I + 0 TO tnCodeLines
THIS.set_Line( @tcLine, @taCodeLines, I ) THIS.set_Line( @tcLine, @taCodeLines, I )
@@ -14357,7 +14334,7 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
CASE NOT llBloque_MenuType_Analizado AND LEFT( tcLine, LEN(C_MENUTYPE_I) ) == C_MENUTYPE_I CASE NOT llBloque_MenuType_Analizado AND LEFT( tcLine, LEN(C_MENUTYPE_I) ) == C_MENUTYPE_I
toConversor.n_MenuType = INT( VAL( STREXTRACT( tcLine, C_MENUTYPE_I, C_MENUTYPE_F ) ) ) toConversor.n_MenuType = INT( VAL( STREXTRACT( tcLine, C_MENUTYPE_I, C_MENUTYPE_F ) ) )
loReg.OBJTYPE = toConversor.n_MenuType loReg.ObjType = toConversor.n_MenuType
llBloque_MenuType_Analizado = .T. llBloque_MenuType_Analizado = .T.
CASE NOT llBloque_SetupCode_Analizado AND THIS.analizarBloque_SetupCode( @tcLine, @taCodeLines, @I, tnCodeLines, toConversor ) CASE NOT llBloque_SetupCode_Analizado AND THIS.analizarBloque_SetupCode( @tcLine, @taCodeLines, @I, tnCodeLines, toConversor )
@@ -14373,7 +14350,7 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
llBloque_Procedure_Analizado = .T. llBloque_Procedure_Analizado = .T.
OTHERWISE && Otro valor OTHERWISE && Otro valor
*-- No hay otros valores que reconocer *EXIT
ENDCASE ENDCASE
ENDFOR ENDFOR
@@ -14426,7 +14403,7 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
ENDFOR ENDFOR
I = I - 1 I = I - 1
THIS.oReg.Setup = SUBSTR( lcText, 3 ) && Quito el primer CR_LF THIS.oReg.SETUP = SUBSTR( lcText, 3 ) && Quito el primer CR_LF
ENDIF ENDIF
CATCH TO loEx CATCH TO loEx
@@ -14512,18 +14489,92 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
TRY TRY
LOCAL loOptions AS CL_MENU_OPTION OF 'FOXBIN2PRG.PRG' LOCAL loOptions AS CL_MENU_OPTION OF 'FOXBIN2PRG.PRG'
LOCAL loBarPop AS CL_MENU_BARPOP OF 'FOXBIN2PRG.PRG' LOCAL loBarPop AS CL_MENU_BARPOP OF 'FOXBIN2PRG.PRG'
LOCAL llBloqueEncontrado, lcPropName, lcValue, lcComment, loEx AS EXCEPTION ; LOCAL llBloqueEncontrado, lcExpr, lcProcName, lcProcCode, lcComment, loReg, loEx AS EXCEPTION ;
, llBloque_SetupCode_Analizado , llBloque_SetupCode_Analizado
STORE '' TO lcPropName, lcValue, lcComment STORE '' TO lcExpr, lcProcName, lcProcCode, lcComment
loReg = THIS.oReg
IF LEFT(tcLine, LEN(C_MENUCODE_I)) == C_MENUCODE_I IF LEFT(tcLine, LEN(C_MENUCODE_I)) == C_MENUCODE_I
llBloqueEncontrado = .T. 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 ) )
IF NOT EMPTY(lcExpr)
THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1, .F. )
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)
THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1, .F. )
IF EMPTY(lcProcCode)
*-- Comando
.PROCEDURE = lcExpr
ELSE
*-- Procedure
lcProcCode = STRTRAN( lcProcCode, '<<ProcName>>', lcProcName )
.PROCEDURE = lcProcCode
ENDIF
ENDIF
ENDIF
ENDWITH
loBarPop = CREATEOBJECT('CL_MENU_BARPOP') loBarPop = CREATEOBJECT('CL_MENU_BARPOP')
loBarPop.c_ParentName = '' loBarPop.c_ParentName = ''
loBarPop.n_ParentCode = THIS.oReg.OBJCODE loBarPop.n_ParentCode = THIS.oReg.OBJCODE
loBarPop.n_ParentType = THIS.oReg.ObjType
loBarPop.analizarBloque( @tcLine, @taCodeLines, @I, @tnCodeLines, toConversor ) loBarPop.analizarBloque( @tcLine, @taCodeLines, @I, @tnCodeLines, toConversor )
THIS.Add( loBarPop ) THIS.ADD( loBarPop )
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
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
ENDIF ENDIF
@@ -14534,6 +14585,10 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
THROW THROW
FINALLY
loBarPop = NULL
loReg = NULL
ENDTRY ENDTRY
RETURN llBloqueEncontrado RETURN llBloqueEncontrado
@@ -14613,7 +14668,7 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
<<C_MENUTYPE_I>><<loReg.ObjType>><<C_MENUTYPE_F>> <<C_MENUTYPE_I>><<loReg.ObjType>><<C_MENUTYPE_F>>
ENDTEXT ENDTEXT
IF NOT EMPTY(loReg.Setup) IF NOT EMPTY(loReg.SETUP)
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<>> <<>>
<<C_SETUPCODE_I>> <<C_SETUPCODE_I>>
@@ -14645,72 +14700,33 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
IF EMPTY(lcProcCode) IF EMPTY(lcProcCode)
*-- Comando *-- Comando
lcText = lcText + 'ON SELECTION MENU ' + loBarPop.Name + ' ' + lcExpr + CR_LF lcText = lcText + 'ON SELECTION MENU ' + loBarPop.NAME + ' ' + lcExpr + CR_LF
*TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
* ON SELECTION MENU <<loBarPop.Name>> <<lcExpr>>
*ENDTEXT
ELSE ELSE
*-- Procedure *-- Procedure
lcProcName = EVL( lcProcName, CHRTRAN('SELECTION MENU ' + loBarPop.Name, ' ', '_') ) lcProcName = EVL( lcProcName, CHRTRAN('SELECTION MENU ' + loBarPop.NAME, ' ', '_') + '_FB2P' )
lcText = lcText + 'ON SELECTION MENU ' + loBarPop.Name + ' DO ' + lcProcName + CR_LF lcText = lcText + 'ON SELECTION MENU ' + loBarPop.NAME + ' DO ' + lcProcName + CR_LF
* ON SELECTION MENU <<loBarPop.Name>> DO <<lcProcName>> && <MenuProc/>
*TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
* ON SELECTION MENU <<loBarPop.Name>> DO <<lcProcName>>
*ENDTEXT
lcProcCode = STRTRAN( lcProcCode, '<<ProcName>>', lcProcName ) lcProcCode = STRTRAN( lcProcCode, '<<ProcName>>', lcProcName )
lcEndProcedures = lcEndProcedures + lcProcCode + CR_LF lcEndProcedures = lcEndProcedures + lcProcCode + CR_LF
ENDIF ENDIF
ENDIF ENDIF
*!* *-- Procedimiento del Menu Bar (ObjType:2, ObjCode:1)
*!* IF NOT EMPTY(loBarPop.PROCEDURE)
*!* lcExpr = loBarPop.PROCEDURE
*!* THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, '', 1, .T. )
*!* IF EMPTY(lcProcCode)
*!* *-- Comando
*!* TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
*!* ON SELECTION POPUP ALL <<lcExpr>>
*!* ENDTEXT
*!* ELSE
*!* *-- Procedure
*!* lcProcName = EVL( lcProcName, CHRTRAN('SELECTION POPUP ALL', ' ', '_') )
*!* * ON SELECTION POPUP ALL DO <<lcProcName>> && <MenuProc/>
*!* TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
*!* ON SELECTION POPUP ALL DO <<lcProcName>>
*!* ENDTEXT
*!* lcProcCode = STRTRAN( lcProcCode, '<<ProcName>>', lcProcName )
*!* lcEndProcedures = lcEndProcedures + lcProcCode + CR_LF
*!* ENDIF
*!* ENDIF
CASE loHeader.ObjType = 4 CASE loHeader.ObjType = 4
*-- Propecimiento principal de _MSYSMENU (ObjType:1, ObjCode:22) IF NOT EMPTY(loHeader.PROCEDURE)
*!* IF NOT EMPTY(loReg.PROCEDURE) lcExpr = loHeader.PROCEDURE
*!* lcExpr = loReg.PROCEDURE THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, '', 1, .T. )
*!* THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, '', 1, .T. )
*!* IF EMPTY(lcProcCode) IF EMPTY(lcProcCode)
*!* *-- Comando *-- Comando
*!* TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 lcText = lcText + 'ON SELECTION POPUP ALL ' + lcExpr + CR_LF
*!* ON SELECTION POPUP <<THIS.Item(1).Item(1).Item(1).oReg.Name>> <<loReg.Procedure>> ELSE
*!* ENDTEXT *-- Procedure
*!* ELSE lcText = lcText + 'ON SELECTION POPUP ALL ' + loBarPop.NAME + ' DO ' + lcProcName + CR_LF
*!* *-- Procedure lcProcCode = STRTRAN( lcProcCode, '<<ProcName>>', lcProcName )
*!* lcProcName = EVL( lcProcName, CHRTRAN('SELECTION POPUP ' + THIS.Item(1).Item(1).Item(1).oReg.Name, ' ', '_') ) lcEndProcedures = lcEndProcedures + lcProcCode + CR_LF
*!* * ON SELECTION POPUP <<THIS.Item(1).Item(1).Item(1).oReg.Name>> DO <<lcProcName>> && <MenuProc/> ENDIF
*!* TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 ENDIF
*!* ON SELECTION POPUP <<THIS.Item(1).Item(1).Item(1).oReg.Name>> DO <<lcProcName>>
*!* ENDTEXT
*!* lcProcCode = STRTRAN( lcProcCode, '<<ProcName>>', lcProcName )
*!* lcEndProcedures = lcEndProcedures + lcProcCode + CR_LF
*!* ENDIF
*!* ENDIF
lcText = lcText + 'ACTIVATE POPUP ' + THIS.Item(1).Item(1).Item(1).oReg.Name + CR_LF lcText = lcText + 'ACTIVATE POPUP ' + THIS.ITEM(1).ITEM(1).ITEM(1).oReg.NAME + CR_LF
*TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
* ACTIVATE POPUP <<THIS.Item(1).Item(1).Item(1).oReg.Name>>
*ENDTEXT
ENDCASE ENDCASE
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
@@ -14795,8 +14811,8 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
* tnNivel (v! IN ) Nivel de indentaci<63>n (solo para debug) * tnNivel (v! IN ) Nivel de indentaci<63>n (solo para debug)
* toConversor (v! IN ) Referencia al conversor para poder usar sus m<>todos * toConversor (v! IN ) Referencia al conversor para poder usar sus m<>todos
*--------------------------------------------------------------------------------------------------- *---------------------------------------------------------------------------------------------------
LPARAMETERS toObj as Collection, tnNivel, toConversor LPARAMETERS toObj AS COLLECTION, tnNivel, toConversor
LOCAL loReg, loEx as Exception LOCAL loReg, loEx AS EXCEPTION
#IF .F. #IF .F.
LOCAL toConversor AS c_conversor_prg_a_mnx OF 'FOXBIN2PRG.PRG' LOCAL toConversor AS c_conversor_prg_a_mnx OF 'FOXBIN2PRG.PRG'
@@ -14810,28 +14826,28 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
IF THIS.l_Debug IF THIS.l_Debug
toConversor.writeLog( REPLICATE(C_TAB,tnNivel) ; toConversor.writeLog( REPLICATE(C_TAB,tnNivel) ;
+ 'ObjType=' + TRANSFORM(loReg.ObjType) ; + 'ObjType=' + TRANSFORM(loReg.ObjType) ;
+ ', ObjCode=' + TRANSFORM(loReg.ObjCode) ; + ', ObjCode=' + TRANSFORM(loReg.OBJCODE) ;
+ ', Name=' + TRANSFORM(loReg.NAME) ; + ', Name=' + TRANSFORM(loReg.NAME) ;
+ ', LevelName=' + TRANSFORM(loReg.LEVELNAME) ; + ', LevelName=' + TRANSFORM(loReg.LevelName) ;
+ ', ItemNum=' + TRANSFORM(loReg.ItemNum) ; + ', ItemNum=' + TRANSFORM(loReg.ITEMNUM) ;
+ ', Location=' + TRANSFORM(loReg.Location) ; + ', Location=' + TRANSFORM(loReg.LOCATION) ;
+ ', Prompt=' + TRANSFORM(loReg.PROMPT) ; + ', Prompt=' + TRANSFORM(loReg.PROMPT) ;
+ ', Message=' + TRANSFORM(loReg.Message) ; + ', Message=' + TRANSFORM(loReg.MESSAGE) ;
+ ', KeyName=' + TRANSFORM(loReg.KEYNAME) ; + ', KeyName=' + TRANSFORM(loReg.KEYNAME) ;
+ ', KeyLabel=' + TRANSFORM(loReg.KeyLabel) ; + ', KeyLabel=' + TRANSFORM(loReg.KeyLabel) ;
+ ', Comment=' + TRANSFORM(loReg.Comment) ; + ', Comment=' + TRANSFORM(loReg.COMMENT) ;
+ ', SkipFor=' + TRANSFORM(loReg.SkipFor) ) + ', SkipFor=' + TRANSFORM(loReg.SKIPFOR) )
ENDIF ENDIF
ELSE ELSE
IF THIS.l_Debug IF THIS.l_Debug
toConversor.writeLog( REPLICATE(C_TAB,tnNivel) ; toConversor.writeLog( REPLICATE(C_TAB,tnNivel) ;
+ 'Objeto [' + toObj.Class + '] sin registro oReg (nivel ' + TRANSFORM(tnNivel) + ')' ) + 'Objeto [' + toObj.CLASS + '] sin registro oReg (nivel ' + TRANSFORM(tnNivel) + ')' )
ENDIF ENDIF
ENDIF ENDIF
IF toObj.Count > 0 THEN IF toObj.COUNT > 0 THEN
FOR EACH loReg IN toObj FOXOBJECT FOR EACH loReg IN toObj FOXOBJECT
THIS.UpdateMenu_Recursivo( loReg, tnNivel + 1, @toConversor ) THIS.UpdateMenu_Recursivo( loReg, tnNivel + 1, @toConversor )
ENDFOR ENDFOR
@@ -14858,6 +14874,7 @@ DEFINE CLASS CL_MENU_BARPOP AS CL_MENU_COL_BASE
+ [<memberdata name="updatemenu" display="updateMENU"/>] ; + [<memberdata name="updatemenu" display="updateMENU"/>] ;
+ [<memberdata name="c_parentname" display="c_ParentName"/>] ; + [<memberdata name="c_parentname" display="c_ParentName"/>] ;
+ [<memberdata name="n_parentcode" display="n_ParentCode"/>] ; + [<memberdata name="n_parentcode" display="n_ParentCode"/>] ;
+ [<memberdata name="n_parenttype" display="n_ParentType"/>] ;
+ [</VFPData>] + [</VFPData>]
#IF .F. #IF .F.
@@ -14866,6 +14883,7 @@ DEFINE CLASS CL_MENU_BARPOP AS CL_MENU_COL_BASE
c_ParentName = '' c_ParentName = ''
n_ParentCode = 0 n_ParentCode = 0
n_ParentType = 0
PROCEDURE analizarBloque PROCEDURE analizarBloque
@@ -14889,66 +14907,77 @@ DEFINE CLASS CL_MENU_BARPOP AS CL_MENU_COL_BASE
, loEx AS EXCEPTION , loEx AS EXCEPTION
STORE '' TO lcSubName, lcComment, lcExpr, lcProcName, lcProcCode STORE '' TO lcSubName, lcComment, lcExpr, lcProcName, lcProcCode
THIS.oReg = toConversor.emptyRecord() THIS.oReg = toConversor.emptyRecord()
loReg = THIS.oReg loReg = THIS.oReg
loReg.OBJTYPE = 2 loReg.ObjType = 2
loReg.PROCTYPE = 1 loReg.PROCTYPE = 1
loReg.ITEMNUM = STR(0,3) loReg.ITEMNUM = STR(0,3)
llBloqueEncontrado = .T.
*LEFT( tcLine, 13 ) == 'DEFINE POPUP ' FOR I = I + 0 TO tnCodeLines
llBloqueEncontrado = .T. STORE '' TO lcExpr, lcProcName, lcProcCode
THIS.set_Line( @tcLine, @taCodeLines, I )
FOR I = I + 0 TO tnCodeLines DO CASE
STORE '' TO lcExpr, lcProcName, lcProcCode CASE EMPTY( tcLine )
THIS.set_Line( @tcLine, @taCodeLines, I ) LOOP
DO CASE CASE toConversor.lineIsOnlyCommentAndNoMetadata( @tcLine, @lcComment )
CASE EMPTY( tcLine ) LOOP && Saltear comentarios
LOOP
CASE toConversor.lineIsOnlyCommentAndNoMetadata( @tcLine, @lcComment ) CASE LEFT( tcLine, LEN(C_MENUCODE_F) ) == C_MENUCODE_F
LOOP && Saltear comentarios EXIT
CASE LEFT( tcLine, LEN(C_MENUCODE_F) ) == C_MENUCODE_F CASE LEFT( tcLine, LEN(C_MENUCODE_I) ) == C_MENUCODE_I
loReg.OBJCODE = 1
loReg.NAME = '_MSYSMENU'
loReg.LevelName = loReg.NAME
loReg.SCHEME = IIF( loReg.OBJCODE = 1, 3, 4 )
IF THIS.n_ParentType = 4
EXIT EXIT
ELSE
CASE LEFT( tcLine, LEN(C_MENUCODE_I) ) == C_MENUCODE_I
loReg.OBJCODE = 1
loReg.NAME = '_MSYSMENU'
loReg.LEVELNAME = loReg.NAME
lcExpr = STREXTRACT( C_FB2PRG_CODE, 'ON SELECTION POPUP ALL ', CR_LF ) lcExpr = STREXTRACT( C_FB2PRG_CODE, 'ON SELECTION POPUP ALL ', CR_LF )
THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1 ) THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1 )
loReg.PROCEDURE = EVL(lcProcCode, lcExpr) loReg.PROCEDURE = EVL(lcProcCode, lcExpr)
ENDIF
CASE LEFT( tcLine, 13 ) == 'DEFINE POPUP ' CASE LEFT( tcLine, LEN('ON SELECTION POPUP ' + loReg.NAME) ) == 'ON SELECTION POPUP ' + loReg.NAME
loReg.OBJCODE = 0 EXIT
loReg.NAME = ALLTRIM( GETWORDNUM( tcLine, 3 ) )
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, 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 = ''
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 ' CASE LEFT( tcLine, 11 ) == 'DEFINE PAD ' OR LEFT( tcLine, 11 ) == 'DEFINE BAR '
loOption = CREATEOBJECT("CL_MENU_OPTION") loOption = CREATEOBJECT("CL_MENU_OPTION")
lnLast_I = I lnLast_I = I
loOption.c_ParentName = loReg.LEVELNAME loOption.c_ParentName = loReg.LevelName
loOption.n_ParentCode = loReg.OBJCODE loOption.n_ParentCode = loReg.OBJCODE
IF NOT loOption.analizarBloque( @tcLine, @taCodeLines, @I, tnCodeLines, toConversor ) loOption.n_ParentType = loReg.ObjType
I = lnLast_I IF NOT loOption.analizarBloque( @tcLine, @taCodeLines, @I, tnCodeLines, toConversor )
llBloqueEncontrado = .F. I = lnLast_I
EXIT llBloqueEncontrado = .F.
ENDIF EXIT
THIS.ADD( loOption ) ENDIF
loOption.oReg.ITEMNUM = STR(THIS.Count,3) THIS.ADD( loOption )
loReg.NUMITEMS = THIS.Count loOption.oReg.ITEMNUM = STR(THIS.COUNT,3)
loReg.SCHEME = IIF( loReg.OBJCODE = 1, 3, 4 ) loReg.NUMITEMS = THIS.COUNT
loOption = NULL loReg.SCHEME = IIF( loReg.OBJCODE = 1, 3, 4 )
loOption = NULL
OTHERWISE && Otro valor OTHERWISE && Otro valor
*-- No I = I - 1
ENDCASE EXIT
ENDFOR ENDCASE
ENDFOR
*ENDIF *ENDIF
CATCH TO loEx CATCH TO loEx
@@ -15025,9 +15054,9 @@ DEFINE CLASS CL_MENU_BARPOP AS CL_MENU_COL_BASE
THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, '', 1, .T. ) THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, '', 1, .T. )
IF EMPTY(lcProcName) IF EMPTY(lcProcName)
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 = 0, loReg.NAME, 'ALL' ) + ' ' + lcExpr + CR_LF
ELSE ELSE
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 = 0, loReg.NAME, 'ALL' ) + ' DO ' + lcProcName + CR_LF
tcEndProcedures = tcEndProcedures + STRTRAN( lcProcCode, '<<ProcName>>', lcProcName ) + CR_LF tcEndProcedures = tcEndProcedures + STRTRAN( lcProcCode, '<<ProcName>>', lcProcName ) + CR_LF
ENDIF ENDIF
@@ -15063,6 +15092,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
+ [<memberdata name="get_procnamefromsnippet" display="get_ProcNameFromSnippet"/>] ; + [<memberdata name="get_procnamefromsnippet" display="get_ProcNameFromSnippet"/>] ;
+ [<memberdata name="c_parentname" display="c_ParentName"/>] ; + [<memberdata name="c_parentname" display="c_ParentName"/>] ;
+ [<memberdata name="n_parentcode" display="n_ParentCode"/>] ; + [<memberdata name="n_parentcode" display="n_ParentCode"/>] ;
+ [<memberdata name="n_parenttype" display="n_ParentType"/>] ;
+ [</VFPData>] + [</VFPData>]
#IF .F. #IF .F.
@@ -15071,6 +15101,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
c_ParentName = '' c_ParentName = ''
n_ParentCode = 0 n_ParentCode = 0
n_ParentType = 0
PROCEDURE analizarBloque PROCEDURE analizarBloque
@@ -15110,8 +15141,11 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
CASE toConversor.lineIsOnlyCommentAndNoMetadata( @tcLine, @lcComment ) CASE toConversor.lineIsOnlyCommentAndNoMetadata( @tcLine, @lcComment )
LOOP && Saltear comentarios 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, LEN(C_MENUCODE_I) ) == C_MENUCODE_I
loReg.OBJTYPE = 2 loReg.ObjType = 2
loReg.OBJCODE = 1 loReg.OBJCODE = 1
CASE THIS.analizarBloque_DefinePAD( @tcLine, @taCodeLines, @I, tnCodeLines, toConversor ) CASE THIS.analizarBloque_DefinePAD( @tcLine, @taCodeLines, @I, tnCodeLines, toConversor )
@@ -15137,8 +15171,9 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
CASE LEFT( tcLine, 13 ) == 'DEFINE POPUP ' CASE LEFT( tcLine, 13 ) == 'DEFINE POPUP '
loBarPop = CREATEOBJECT("CL_MENU_BARPOP") loBarPop = CREATEOBJECT("CL_MENU_BARPOP")
lnLast_I = I lnLast_I = I
loBarPop.c_ParentName = loReg.LEVELNAME loBarPop.c_ParentName = loReg.LevelName
loBarPop.n_ParentCode = loReg.OBJCODE loBarPop.n_ParentCode = loReg.OBJCODE
loBarPop.n_ParentType = loReg.ObjType
THIS.ADD( loBarPop ) THIS.ADD( loBarPop )
IF NOT loBarPop.analizarBloque( @tcLine, @taCodeLines, @I, tnCodeLines, toConversor ) IF NOT loBarPop.analizarBloque( @tcLine, @taCodeLines, @I, tnCodeLines, toConversor )
I = I - 1 I = I - 1
@@ -15147,11 +15182,12 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
EXIT EXIT
OTHERWISE && Otro valor OTHERWISE && Otro valor
*-- No I = I - 1
EXIT
ENDCASE ENDCASE
ENDFOR ENDFOR
CATCH TO loEx WHEN loEx.Message = 'Nivel_Anterior' CATCH TO loEx WHEN loEx.MESSAGE = 'Nivel_Anterior'
*-- OK. Volver a evaluar en el nivel anterior *-- OK. Volver a evaluar en el nivel anterior
llBloqueEncontrado = .F. llBloqueEncontrado = .F.
@@ -15202,17 +15238,13 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
*-------------------------------- *--------------------------------
IF LEFT( tcLine, 11 ) == 'DEFINE PAD ' IF LEFT( tcLine, 11 ) == 'DEFINE PAD '
llBloqueEncontrado = .T. llBloqueEncontrado = .T.
loReg = THIS.oReg loReg = THIS.oReg
loReg.OBJTYPE = 3 loReg.ObjType = 3
lcPadName = ALLTRIM( STREXTRACT( tcLine, 'PAD ' , ' OF' ) ) lcPadName = ALLTRIM( STREXTRACT( tcLine, 'PAD ' , ' OF' ) )
*IF LEFT(lcPadName,1) == '_' AND LEN(lcPadName) = 10 loReg.NAME = lcPadName
* *-- Es un nombre temporal, no se guarda. loReg.LevelName = ALLTRIM( STREXTRACT( tcLine, ' OF ', ' PROMPT ' ) )
*ELSE
loReg.NAME = lcPadName
*ENDIF
loReg.LEVELNAME = ALLTRIM( STREXTRACT( tcLine, ' OF ', ' PROMPT ' ) )
IF loReg.LEVELNAME # THIS.c_ParentName IF loReg.LevelName # THIS.c_ParentName
EXIT EXIT
ENDIF ENDIF
@@ -15246,7 +15278,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
lcExpr = ALLTRIM( STREXTRACT( tcLine, 'KEY ', ';', 1, 2 ) ) lcExpr = ALLTRIM( STREXTRACT( tcLine, 'KEY ', ';', 1, 2 ) )
lnPos = AT( ',', lcExpr ) lnPos = AT( ',', lcExpr )
loReg.KEYNAME = ALLTRIM( LEFT( lcExpr, lnPos-1 ) ) loReg.KEYNAME = ALLTRIM( LEFT( lcExpr, lnPos-1 ) )
loReg.KEYLABEL = ALLTRIM( STREXTRACT( lcExpr, '"', '"' ) ) loReg.KeyLabel = ALLTRIM( STREXTRACT( lcExpr, '"', '"' ) )
CASE LEFT( tcLine, 9 ) == 'SKIP FOR ' CASE LEFT( tcLine, 9 ) == 'SKIP FOR '
loReg.SKIPFOR = ALLTRIM( STREXTRACT( tcLine, 'SKIP FOR ', ';', 1, 2 ) ) loReg.SKIPFOR = ALLTRIM( STREXTRACT( tcLine, 'SKIP FOR ', ';', 1, 2 ) )
@@ -15276,7 +15308,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
*-------------------------------- *--------------------------------
* ON PAD _3YM1DR90Z OF _MSYSMENU ACTIVATE POPUP Opci<63>nA_CS * ON PAD _3YM1DR90Z OF _MSYSMENU ACTIVATE POPUP Opci<63>nA_CS
* ON PAD _3YM1DR90Z OF _MSYSMENU wait window "algo" * ON PAD _3YM1DR90Z OF _MSYSMENU wait window "algo"
* ON PAD _3YM1DR90Z OF _MSYSMENU DO Menu1_Opci<63>n_A_2_Sub_SNIPPET && <MenuProc/> * ON PAD _3YM1DR90Z OF _MSYSMENU DO Menu1_Opci<63>n_A_2_Sub_SNIPPET
*-------------------------------- *--------------------------------
*-- ANALISIS DEL "ON PAD" u "ON SELECTION PAD" *-- ANALISIS DEL "ON PAD" u "ON SELECTION PAD"
@@ -15294,13 +15326,15 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
EXIT EXIT
CASE LEFT( tcLine, 17 ) == 'ON SELECTION PAD ' CASE LEFT( tcLine, 17 ) == 'ON SELECTION PAD '
lcExpr = ALLTRIM( STREXTRACT( tcLine, ' OF ' + loReg.LEVELNAME + ' ', '', 1, 2 ) ) lcExpr = ALLTRIM( STREXTRACT( tcLine, ' OF ' + loReg.LevelName + ' ', '', 1, 2 ) )
THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1, .F. ) THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1, .F. )
DO CASE DO CASE
*CASE ' &'+'& <MenuProc/>' $ lcExpr CASE EMPTY(lcProcCode)
CASE NOT EMPTY(lcProcCode) loReg.OBJCODE = 67
*lcProcName = ALLTRIM( STREXTRACT( lcExpr, 'DO ', '&'+'&', 1, 2 ) ) loReg.COMMAND = lcExpr
OTHERWISE
loReg.PROCEDURE = STRTRAN( lcProcCode, '<<ProcName>>', lcProcName ) loReg.PROCEDURE = STRTRAN( lcProcCode, '<<ProcName>>', lcProcName )
IF EMPTY( loReg.PROCEDURE ) IF EMPTY( loReg.PROCEDURE )
@@ -15311,10 +15345,6 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
loReg.PROCTYPE = 1 loReg.PROCTYPE = 1
ENDIF ENDIF
OTHERWISE
loReg.OBJCODE = 67
loReg.COMMAND = lcExpr
ENDCASE ENDCASE
I = I + 1 I = I + 1
@@ -15386,17 +15416,18 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
*-------------------------------- *--------------------------------
IF LEFT( tcLine, 11 ) == 'DEFINE BAR ' IF LEFT( tcLine, 11 ) == 'DEFINE BAR '
llBloqueEncontrado = .T. llBloqueEncontrado = .T.
loReg = THIS.oReg loReg = THIS.oReg
loReg.OBJTYPE = 3 loReg.ObjType = 3
lcBarName = ALLTRIM( STREXTRACT( tcLine, 'BAR ' , ' OF' ) ) lcBarName = ALLTRIM( STREXTRACT( tcLine, 'BAR ' , ' OF' ) )
*IF LEFT(lcBarName,1) == '_'
IF NOT ISDIGIT(lcBarName) IF NOT ISDIGIT(lcBarName)
*-- Es un BAR del sistema *-- Es un BAR del sistema
loReg.NAME = lcBarName loReg.NAME = lcBarName
ENDIF ENDIF
loReg.LEVELNAME = ALLTRIM( STREXTRACT( tcLine, ' OF ', ' PROMPT ' ) )
IF loReg.LEVELNAME # THIS.c_ParentName loReg.LevelName = ALLTRIM( STREXTRACT( tcLine, ' OF ', ' PROMPT ' ) )
IF loReg.LevelName # THIS.c_ParentName
EXIT EXIT
ENDIF ENDIF
@@ -15430,7 +15461,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
lcExpr = ALLTRIM( STREXTRACT( tcLine, 'KEY ', ';', 1, 2 ) ) lcExpr = ALLTRIM( STREXTRACT( tcLine, 'KEY ', ';', 1, 2 ) )
lnPos = AT( ',', lcExpr ) lnPos = AT( ',', lcExpr )
loReg.KEYNAME = ALLTRIM( LEFT( lcExpr, lnPos-1 ) ) loReg.KEYNAME = ALLTRIM( LEFT( lcExpr, lnPos-1 ) )
loReg.KEYLABEL = ALLTRIM( STREXTRACT( lcExpr, '"', '"' ) ) loReg.KeyLabel = ALLTRIM( STREXTRACT( lcExpr, '"', '"' ) )
CASE LEFT( tcLine, 9 ) == 'SKIP FOR ' CASE LEFT( tcLine, 9 ) == 'SKIP FOR '
loReg.SKIPFOR = ALLTRIM( STREXTRACT( tcLine, 'SKIP FOR ', ';', 1, 2 ) ) loReg.SKIPFOR = ALLTRIM( STREXTRACT( tcLine, 'SKIP FOR ', ';', 1, 2 ) )
@@ -15458,6 +15489,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
IF LEFT(lcBarName,1) == '_' IF LEFT(lcBarName,1) == '_'
*-- Es un BAR del Sistema, as<61> que no tiene ON BAR ni nada m<>s. *-- Es un BAR del Sistema, as<61> que no tiene ON BAR ni nada m<>s.
loReg.OBJCODE = 78 && Bar# loReg.OBJCODE = 78 && Bar#
I = I + 1
EXIT EXIT
ENDIF ENDIF
@@ -15466,7 +15498,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
*-------------------------------- *--------------------------------
* ON BAR _3YM1DR90Z OF _MSYSMENU ACTIVATE POPUP Opci<63>nA_CS * ON BAR _3YM1DR90Z OF _MSYSMENU ACTIVATE POPUP Opci<63>nA_CS
* ON BAR _3YM1DR90Z OF _MSYSMENU wait window "algo" * ON BAR _3YM1DR90Z OF _MSYSMENU wait window "algo"
* ON BAR _3YM1DR90Z OF _MSYSMENU DO Menu1_Opci<63>n_A_2_Sub_SNIPPET && <MenuProc/> * ON BAR _3YM1DR90Z OF _MSYSMENU DO Menu1_Opci<63>n_A_2_Sub_SNIPPET
*-------------------------------- *--------------------------------
*-- ANALISIS DEL "ON BAR" u "ON SELECTION BAR" *-- ANALISIS DEL "ON BAR" u "ON SELECTION BAR"
@@ -15484,13 +15516,11 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
EXIT EXIT
CASE LEFT( tcLine, 17 ) == 'ON SELECTION BAR ' CASE LEFT( tcLine, 17 ) == 'ON SELECTION BAR '
lcExpr = ALLTRIM( STREXTRACT( tcLine, ' OF ' + loReg.LEVELNAME + ' ', '', 1, 2 ) ) lcExpr = ALLTRIM( STREXTRACT( tcLine, ' OF ' + loReg.LevelName + ' ', '', 1, 2 ) )
THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1, .F. ) THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1, .F. )
DO CASE DO CASE
*CASE ' &'+'& <MenuProc/>' $ lcExpr
CASE NOT EMPTY(lcProcCode) CASE NOT EMPTY(lcProcCode)
*lcProcName = ALLTRIM( STREXTRACT( lcExpr, 'DO ', '&'+'&', 1, 2 ) )
loReg.PROCEDURE = STRTRAN( lcProcCode, '<<ProcName>>', lcProcName ) loReg.PROCEDURE = STRTRAN( lcProcCode, '<<ProcName>>', lcProcName )
IF EMPTY( loReg.PROCEDURE ) IF EMPTY( loReg.PROCEDURE )
@@ -15521,7 +15551,6 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
ENDFOR ENDFOR
I = I - 1 I = I - 1
*THIS.oReg.Cleanup = lcText
ENDIF ENDIF
CATCH TO loEx CATCH TO loEx
@@ -15558,9 +15587,6 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
lcTab = REPLICATE(CHR(9),tnNivel) lcTab = REPLICATE(CHR(9),tnNivel)
loBarPop = toParentReg loBarPop = toParentReg
*-- Actualizaci<63>n de procedimientos
*lcProcName = THIS.get_ProcNameFromSnippet(loReg)
*-- Options (ObjType:3) *-- Options (ObjType:3)
DO CASE DO CASE
CASE toParentReg.ObjType = 2 AND toParentReg.OBJCODE = 0 CASE toParentReg.ObjType = 2 AND toParentReg.OBJCODE = 0
@@ -15583,7 +15609,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, '', 1, .T. ) THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, '', 1, .T. )
IF EMPTY(lcProcName) IF EMPTY(lcProcName)
lcProcName = CHRTRAN( ALLTRIM( STREXTRACT( lcText, 'DEFINE ', 'PROMPT ' ) ), ' ', '_' ) lcProcName = CHRTRAN( ALLTRIM( STREXTRACT( lcText, 'DEFINE ', 'PROMPT ' ) ), ' ', '_' ) + '_FB2P'
ENDIF ENDIF
lcText = STRTRAN( lcText, '<<ProcName>>', lcProcName ) lcText = STRTRAN( lcText, '<<ProcName>>', lcProcName )
@@ -15629,29 +15655,29 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
LPARAMETERS toReg, toBarPop, tnNivel, toHeader LPARAMETERS toReg, toBarPop, tnNivel, toHeader
TRY TRY
LOCAL lcText, lcTab, loEx as Exception ; LOCAL lcText, lcTab, loEx AS EXCEPTION ;
, loBarPop AS CL_MENU_BARPOP OF 'FOXBIN2PRG.PRG' , loBarPop AS CL_MENU_BARPOP OF 'FOXBIN2PRG.PRG'
lcTab = REPLICATE(CHR(9),tnNivel) lcTab = REPLICATE(CHR(9),tnNivel)
lcText = '' lcText = ''
*-- DEFINE BAR *-- DEFINE BAR
*lcText = lcTab + '*----------------------------------' + CR_LF *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 + '"' + ' PROMPT "' + toReg.PROMPT + '"'
IF NOT EMPTY(toReg.KeyName) IF NOT EMPTY(toReg.KEYNAME)
lcText = lcText + ' ;' + CR_LF + lcTab + ' KEY ' + toReg.KeyName + ', "' + toReg.KeyLabel + '"' lcText = lcText + ' ;' + CR_LF + lcTab + ' KEY ' + toReg.KEYNAME + ', "' + toReg.KeyLabel + '"'
ENDIF ENDIF
IF NOT EMPTY(toReg.SKIPFOR) IF NOT EMPTY(toReg.SKIPFOR)
lcText = lcText + ' ;' + CR_LF + lcTab + ' SKIP FOR ' + toReg.SKIPFOR lcText = lcText + ' ;' + CR_LF + lcTab + ' SKIP FOR ' + toReg.SKIPFOR
ENDIF ENDIF
IF NOT EMPTY(toReg.ResName) IF NOT EMPTY(toReg.RESNAME)
IF toReg.SysRes = 1 IF toReg.SYSRES = 1
lcText = lcText + ' ;' + CR_LF + lcTab + ' PICTRES ' + toReg.ResName lcText = lcText + ' ;' + CR_LF + lcTab + ' PICTRES ' + toReg.RESNAME
ELSE ELSE
lcText = lcText + ' ;' + CR_LF + lcTab + ' PICTURE "' + toReg.ResName + '"' lcText = lcText + ' ;' + CR_LF + lcTab + ' PICTURE "' + toReg.RESNAME + '"'
ENDIF ENDIF
ENDIF ENDIF
@@ -15668,17 +15694,16 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
lcText = lcText + CR_LF lcText = lcText + CR_LF
IF toReg.OBJCODE = 77 && Submenu IF toReg.OBJCODE = 77 && Submenu
loBarPop = THIS.Item(1).oReg 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) + ' ACTIVATE POPUP ' + ALLTRIM(loBarPop.NAME)
ELSE 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 DO CASE
CASE toReg.OBJCODE = 67 && Command CASE toReg.OBJCODE = 67 && Command
lcText = lcText + ' ' + ALLTRIM(toReg.Command) lcText = lcText + ' ' + ALLTRIM(toReg.COMMAND)
CASE toReg.OBJCODE = 80 && Procedure CASE toReg.OBJCODE = 80 && Procedure
*lcText = lcText + ' DO <<ProcName>>' + ' &'+'& <MenuProc/>'
lcText = lcText + ' DO <<ProcName>>' lcText = lcText + ' DO <<ProcName>>'
ENDCASE ENDCASE
ENDIF ENDIF
@@ -15710,38 +15735,38 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
LPARAMETERS toReg, toBarPop, tnNivel, toHeader LPARAMETERS toReg, toBarPop, tnNivel, toHeader
TRY TRY
LOCAL lcText, lcTab, lnContainer, lnObject, loEx as Exception ; LOCAL lcText, lcTab, lnContainer, lnObject, loEx AS EXCEPTION ;
, loBarPop AS CL_MENU_BARPOP OF 'FOXBIN2PRG.PRG' , loBarPop AS CL_MENU_BARPOP OF 'FOXBIN2PRG.PRG'
lcTab = REPLICATE(CHR(9),tnNivel) lcTab = REPLICATE(CHR(9),tnNivel)
toReg.Name = EVL(toReg.Name,SYS(2015)) toReg.NAME = EVL(toReg.NAME,SYS(2015))
lcText = '' lcText = ''
*-- DEFINE PAD *-- DEFINE PAD
*lcText = lcTab + '*----------------------------------' + CR_LF *lcText = lcTab + '*----------------------------------' + CR_LF
lcText = lcText + lcTab + 'DEFINE PAD ' + ALLTRIM(toReg.Name) + ' OF ' + ALLTRIM(toReg.LevelName) ; lcText = lcText + lcTab + 'DEFINE PAD ' + ALLTRIM(toReg.NAME) + ' OF ' + ALLTRIM(toReg.LevelName) ;
+ ' PROMPT "' + toReg.PROMPT + '"' ; + ' PROMPT "' + toReg.PROMPT + '"' ;
+ ' COLOR SCHEME ' + TRANSFORM(toBarPop.SCHEME) + ' COLOR SCHEME ' + TRANSFORM(toBarPop.SCHEME)
IF NOT EMPTY(toReg.Location) IF NOT EMPTY(toReg.LOCATION)
lnContainer = toReg.Location % 2^4 lnContainer = toReg.LOCATION % 2^4
lnObject = INT( (toReg.Location - lnContainer) / 2^4 ) lnObject = INT( (toReg.LOCATION - lnContainer) / 2^4 )
lcText = lcText + ' ;' + CR_LF + lcTab + ' NEGOTIATE ' + GETWORDNUM('NONE,LEFT,MIDDLE,RIGHT',lnContainer+1,',') ; lcText = lcText + ' ;' + CR_LF + lcTab + ' NEGOTIATE ' + GETWORDNUM('NONE,LEFT,MIDDLE,RIGHT',lnContainer+1,',') ;
+ ', ' + GETWORDNUM('NONE,LEFT,MIDDLE,RIGHT',lnObject+1,',') + ', ' + GETWORDNUM('NONE,LEFT,MIDDLE,RIGHT',lnObject+1,',')
ENDIF ENDIF
IF NOT EMPTY(toReg.KeyName) IF NOT EMPTY(toReg.KEYNAME)
lcText = lcText + ' ;' + CR_LF + lcTab + ' KEY ' + toReg.KeyName + ', "' + toReg.KeyLabel + '"' lcText = lcText + ' ;' + CR_LF + lcTab + ' KEY ' + toReg.KEYNAME + ', "' + toReg.KeyLabel + '"'
ENDIF ENDIF
IF NOT EMPTY(toReg.SKIPFOR) IF NOT EMPTY(toReg.SKIPFOR)
lcText = lcText + ' ;' + CR_LF + lcTab + ' SKIP FOR ' + toReg.SKIPFOR lcText = lcText + ' ;' + CR_LF + lcTab + ' SKIP FOR ' + toReg.SKIPFOR
ENDIF ENDIF
IF NOT EMPTY(toReg.ResName) IF NOT EMPTY(toReg.RESNAME)
IF toReg.SysRes = 1 IF toReg.SYSRES = 1
lcText = lcText + ' ;' + CR_LF + lcTab + ' PICTRES ' + toReg.ResName lcText = lcText + ' ;' + CR_LF + lcTab + ' PICTRES ' + toReg.RESNAME
ELSE ELSE
lcText = lcText + ' ;' + CR_LF + lcTab + ' PICTURE "' + toReg.ResName + '"' lcText = lcText + ' ;' + CR_LF + lcTab + ' PICTURE "' + toReg.RESNAME + '"'
ENDIF ENDIF
ENDIF ENDIF
@@ -15760,17 +15785,16 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
lcText = lcText + CR_LF lcText = lcText + CR_LF
IF toReg.OBJCODE = 77 && Submenu IF toReg.OBJCODE = 77 && Submenu
loBarPop = THIS.Item(1).oReg loBarPop = THIS.ITEM(1).oReg
lcText = lcText + lcTab + 'ON PAD ' + ALLTRIM(toReg.Name) + ' OF ' + ALLTRIM(toReg.LevelName) ; lcText = lcText + lcTab + 'ON PAD ' + ALLTRIM(toReg.NAME) + ' OF ' + ALLTRIM(toReg.LevelName) ;
+ ' ACTIVATE POPUP ' + ALLTRIM(loBarPop.Name) + ' ACTIVATE POPUP ' + ALLTRIM(loBarPop.NAME)
ELSE ELSE
lcText = lcText + lcTab + 'ON SELECTION PAD ' + ALLTRIM(toReg.Name) + ' OF ' + ALLTRIM(toReg.LevelName) lcText = lcText + lcTab + 'ON SELECTION PAD ' + ALLTRIM(toReg.NAME) + ' OF ' + ALLTRIM(toReg.LevelName)
DO CASE DO CASE
CASE toReg.OBJCODE = 67 && Command CASE toReg.OBJCODE = 67 && Command
lcText = lcText + ' ' + ALLTRIM(toReg.Command) lcText = lcText + ' ' + ALLTRIM(toReg.COMMAND)
CASE toReg.OBJCODE = 80 && Procedure CASE toReg.OBJCODE = 80 && Procedure
*lcText = lcText + ' DO <<ProcName>>' + ' &'+'& <MenuProc/>'
lcText = lcText + ' DO <<ProcName>>' lcText = lcText + ' DO <<ProcName>>'
ENDCASE ENDCASE
ENDIF ENDIF