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.

562
foxbin2prg.prg
View File

@@ -1194,14 +1194,14 @@ DEFINE CLASS c_conversor_base AS SESSION
* RETURN: Memo desindentado * RETURN: Memo desindentado
*--------------------------------------------------------------------------------------------------- *---------------------------------------------------------------------------------------------------
LPARAMETERS tcMemo, tcIndentacion LPARAMETERS tcMemo, tcIndentacion
LOCAL lcMemo, laLines(1), I LOCAL lcMemo, laLines(1), I
lcMemo = '' lcMemo = ''
FOR I = 1 TO ALINES( laLines, tcMemo ) FOR I = 1 TO ALINES( laLines, tcMemo )
lcMemo = lcMemo + SUBSTR( laLines(I), LEN(tcIndentacion) + 1 ) + CR_LF lcMemo = lcMemo + SUBSTR( laLines(I), LEN(tcIndentacion) + 1 ) + CR_LF
ENDFOR ENDFOR
RETURN lcMemo RETURN lcMemo
ENDPROC ENDPROC
@@ -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) ;
@@ -14185,13 +14185,13 @@ DEFINE CLASS CL_MENU_COL_BASE AS CL_COL_BASE
* y luego al generar el c<>digo lo muestran como Comando si es una sola l<>nea, y si no como Procedure. * y luego al generar el c<>digo lo muestran como Comando si es una sola l<>nea, y si no como Procedure.
*--------------------------------------------------------------------------------------------------- *---------------------------------------------------------------------------------------------------
LPARAMETERS tcExpr, tcProcName, tcProcCode, tcSourceCode, tnIndentation, tlAddProcEndproc LPARAMETERS tcExpr, tcProcName, tcProcCode, tcSourceCode, tnIndentation, tlAddProcEndproc
LOCAL laProcLines(1), lnLine_Count, I LOCAL laProcLines(1), lnLine_Count, I
tcProcName = '' tcProcName = ''
tcProcCode = '' tcProcCode = ''
tnIndentation = EVL(tnIndentation,0) tnIndentation = EVL(tnIndentation,0)
lnLine_Count = ALINES( laProcLines, tcExpr ) lnLine_Count = ALINES( laProcLines, tcExpr )
IF lnLine_Count > 1 IF lnLine_Count > 1
*-- ES UN PROCEDIMIENTO *-- ES UN PROCEDIMIENTO
tcProcCode = tcExpr tcProcCode = tcExpr
@@ -14218,14 +14218,15 @@ DEFINE CLASS CL_MENU_COL_BASE AS CL_COL_BASE
ENDIF ENDIF
ENDIF ENDIF
ENDIF ENDIF
*-- Si se indic<69> indentaci<63>n, se reprocesa el c<>digo del procedimiento *-- Si se indic<69> indentaci<63>n, se reprocesa el c<>digo del procedimiento
IF NOT EMPTY(tcProcCode) AND (tnIndentation <> 0 OR tlAddProcEndproc) IF NOT EMPTY(tcProcCode) AND (tnIndentation <> 0 OR tlAddProcEndproc)
lnLine_Count = ALINES( laProcLines, tcProcCode ) lnLine_Count = ALINES( laProcLines, tcProcCode )
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
@@ -14256,7 +14257,7 @@ DEFINE CLASS CL_MENU_COL_BASE AS CL_COL_BASE
tcProcCode = tcProcCode + 'ENDPROC &' + '& <<ProcName>>' + CR_LF tcProcCode = tcProcCode + 'ENDPROC &' + '& <<ProcName>>' + CR_LF
ENDIF ENDIF
ENDIF ENDIF
ENDPROC ENDPROC
@@ -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,74 +14700,35 @@ 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
<<C_MENUCODE_F>> <<C_MENUCODE_F>>
ENDTEXT ENDTEXT
@@ -14724,7 +14740,7 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
+ lcEndProcedures ; + lcEndProcedures ;
+ C_PROC_CODE_F + CR_LF + C_PROC_CODE_F + CR_LF
ENDIF ENDIF
IF NOT EMPTY(loReg.Cleanup) IF NOT EMPTY(loReg.Cleanup)
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<>> <<>>
@@ -14773,7 +14789,7 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
#ENDIF #ENDIF
SELECT TABLABIN SELECT TABLABIN
IF THIS.l_Debug IF THIS.l_Debug
toConversor.writeLog( '' ) toConversor.writeLog( '' )
toConversor.writeLog( REPLICATE('-',80) ) toConversor.writeLog( REPLICATE('-',80) )
@@ -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,33 +14826,33 @@ 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
ENDIF ENDIF
CATCH TO loEx CATCH TO loEx
IF THIS.l_Debug AND _VFP.STARTMODE = 0 IF THIS.l_Debug AND _VFP.STARTMODE = 0
SET STEP ON SET STEP ON
@@ -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
@@ -14888,67 +14906,78 @@ DEFINE CLASS CL_MENU_BARPOP AS CL_MENU_COL_BASE
LOCAL llBloqueEncontrado, lcSubName, lcComment, lnLast_I, loReg, lcExpr, lcProcName, lcProcCode ; LOCAL llBloqueEncontrado, lcSubName, lcComment, lnLast_I, loReg, lcExpr, lcProcName, lcProcCode ;
, loEx AS EXCEPTION , loEx AS EXCEPTION
STORE '' TO lcSubName, lcComment, lcExpr, lcProcName, lcProcCode STORE '' TO lcSubName, lcComment, lcExpr, lcProcName, lcProcCode
THIS.oReg = toConversor.emptyRecord()
loReg = THIS.oReg
loReg.OBJTYPE = 2
loReg.PROCTYPE = 1
loReg.ITEMNUM = STR(0,3)
*LEFT( tcLine, 13 ) == 'DEFINE POPUP ' THIS.oReg = toConversor.emptyRecord()
llBloqueEncontrado = .T. loReg = THIS.oReg
loReg.ObjType = 2
loReg.PROCTYPE = 1
loReg.ITEMNUM = STR(0,3)
llBloqueEncontrado = .T.
FOR I = I + 0 TO tnCodeLines FOR I = I + 0 TO tnCodeLines
STORE '' TO lcExpr, lcProcName, lcProcCode STORE '' TO lcExpr, lcProcName, lcProcCode
THIS.set_Line( @tcLine, @taCodeLines, I ) THIS.set_Line( @tcLine, @taCodeLines, I )
DO CASE DO CASE
CASE EMPTY( tcLine ) CASE EMPTY( tcLine )
LOOP LOOP
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 CASE LEFT( tcLine, LEN(C_MENUCODE_F) ) == C_MENUCODE_F
EXIT
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 '
loReg.OBJCODE = 0
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, LEN('ON SELECTION POPUP ' + loReg.NAME) ) == 'ON SELECTION POPUP ' + loReg.NAME
EXIT
CASE LEFT( tcLine, 11 ) == 'DEFINE PAD ' OR LEFT( tcLine, 11 ) == 'DEFINE BAR ' CASE LEFT( tcLine, 13 ) == 'DEFINE POPUP '
loOption = CREATEOBJECT("CL_MENU_OPTION") loReg.OBJCODE = 0
lnLast_I = I loReg.NAME = ALLTRIM( GETWORDNUM( tcLine, 3 ) )
loOption.c_ParentName = loReg.LEVELNAME IF RIGHT(loReg.NAME,5) == '_FB2P' && Originalmente era vac<61>o y se la hab<61>a puesto un nombre temporal.
loOption.n_ParentCode = loReg.OBJCODE loReg.NAME = ''
IF NOT loOption.analizarBloque( @tcLine, @taCodeLines, @I, tnCodeLines, toConversor ) ENDIF
I = lnLast_I loReg.LevelName = loReg.NAME
llBloqueEncontrado = .F. lcExpr = ALLTRIM( STREXTRACT( C_FB2PRG_CODE, 'ON SELECTION POPUP ' + loReg.NAME + ' ', CR_LF ) )
EXIT THIS.AnalizarSiExpresionEsComandoOProcedimiento( lcExpr, @lcProcName, @lcProcCode, @C_FB2PRG_CODE, -1 )
ENDIF loReg.PROCEDURE = EVL(lcProcCode, lcExpr)
THIS.ADD( loOption )
loOption.oReg.ITEMNUM = STR(THIS.Count,3)
loReg.NUMITEMS = THIS.Count
loReg.SCHEME = IIF( loReg.OBJCODE = 1, 3, 4 )
loOption = NULL
OTHERWISE && Otro valor CASE LEFT( tcLine, 11 ) == 'DEFINE PAD ' OR LEFT( tcLine, 11 ) == 'DEFINE BAR '
*-- No loOption = CREATEOBJECT("CL_MENU_OPTION")
ENDCASE lnLast_I = I
ENDFOR loOption.c_ParentName = loReg.LevelName
loOption.n_ParentCode = loReg.OBJCODE
loOption.n_ParentType = loReg.ObjType
IF NOT loOption.analizarBloque( @tcLine, @taCodeLines, @I, tnCodeLines, toConversor )
I = lnLast_I
llBloqueEncontrado = .F.
EXIT
ENDIF
THIS.ADD( loOption )
loOption.oReg.ITEMNUM = STR(THIS.COUNT,3)
loReg.NUMITEMS = THIS.COUNT
loReg.SCHEME = IIF( loReg.OBJCODE = 1, 3, 4 )
loOption = NULL
OTHERWISE && Otro valor
I = I - 1
EXIT
ENDCASE
ENDFOR
*ENDIF *ENDIF
CATCH TO loEx CATCH TO loEx
@@ -15018,16 +15047,16 @@ DEFINE CLASS CL_MENU_BARPOP AS CL_MENU_COL_BASE
lcText = lcText + loOption.toText(loReg, tnNivel+0, @tcEndProcedures, toHeader) lcText = lcText + loOption.toText(loReg, tnNivel+0, @tcEndProcedures, toHeader)
ENDFOR ENDFOR
ENDIF ENDIF
*-- Procedure del POPUP o MENU *-- Procedure del POPUP o MENU
IF NOT EMPTY(loReg.PROCEDURE) IF NOT EMPTY(loReg.PROCEDURE)
lcExpr = loReg.PROCEDURE lcExpr = loReg.PROCEDURE
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,10 +15141,13 @@ 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 )
IF EMPTY(loReg.PROMPT) IF EMPTY(loReg.PROMPT)
*-- Esta opci<63>n no corresponde a este nivel. Debe subir. *-- Esta opci<63>n no corresponde a este nivel. Debe subir.
@@ -15123,7 +15157,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
IF loReg.OBJCODE <> 77 IF loReg.OBJCODE <> 77
EXIT EXIT
ENDIF ENDIF
CASE THIS.analizarBloque_DefineBAR( @tcLine, @taCodeLines, @I, tnCodeLines, toConversor ) CASE THIS.analizarBloque_DefineBAR( @tcLine, @taCodeLines, @I, tnCodeLines, toConversor )
IF EMPTY(loReg.PROMPT) IF EMPTY(loReg.PROMPT)
*-- Esta opci<63>n no corresponde a este nivel. Debe subir. *-- Esta opci<63>n no corresponde a este nivel. Debe subir.
@@ -15133,12 +15167,13 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
IF loReg.OBJCODE <> 77 IF loReg.OBJCODE <> 77
EXIT EXIT
ENDIF ENDIF
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,14 +15182,15 @@ 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.
CATCH TO loEx CATCH TO loEx
IF THIS.l_Debug AND _VFP.STARTMODE = 0 IF THIS.l_Debug AND _VFP.STARTMODE = 0
SET STEP ON SET STEP ON
@@ -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
@@ -15241,12 +15273,12 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
lnNegObject = INT( AT( ',' + PADR( ALLTRIM(GETWORDNUM( lcExpr, 2, ',' )), 6, '_' ) ; lnNegObject = INT( AT( ',' + PADR( ALLTRIM(GETWORDNUM( lcExpr, 2, ',' )), 6, '_' ) ;
, '______,NONE__,LEFT__,MIDDLE,RIGHT_' ) / 7 - 1 ) , '______,NONE__,LEFT__,MIDDLE,RIGHT_' ) / 7 - 1 )
loReg.LOCATION = lnNegContainer + lnNegObject * 2^4 loReg.LOCATION = lnNegContainer + lnNegObject * 2^4
CASE LEFT( tcLine, 4 ) == 'KEY ' CASE LEFT( tcLine, 4 ) == 'KEY '
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 ) )
@@ -15271,14 +15303,14 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
ENDFOR ENDFOR
ENDIF && ';' $ tcLine ENDIF && ';' $ tcLine
* Estructuras ejemplo a analizar: * Estructuras ejemplo a analizar:
*-------------------------------- *--------------------------------
* 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"
FOR I = I + 1 TO tnCodeLines FOR I = I + 1 TO tnCodeLines
THIS.set_Line( @tcLine, @taCodeLines, I ) THIS.set_Line( @tcLine, @taCodeLines, I )
@@ -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
@@ -15425,12 +15456,12 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
lnNegObject = INT( AT( ',' + PADR( ALLTRIM(GETWORDNUM( lcExpr, 2, ',' )), 6, '_' ) ; lnNegObject = INT( AT( ',' + PADR( ALLTRIM(GETWORDNUM( lcExpr, 2, ',' )), 6, '_' ) ;
, '______,NONE__,LEFT__,MIDDLE,RIGHT_' ) / 7 - 1 ) , '______,NONE__,LEFT__,MIDDLE,RIGHT_' ) / 7 - 1 )
loReg.LOCATION = lnNegContainer + lnNegObject * 2^4 loReg.LOCATION = lnNegContainer + lnNegObject * 2^4
CASE LEFT( tcLine, 4 ) == 'KEY ' CASE LEFT( tcLine, 4 ) == 'KEY '
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,17 +15489,18 @@ 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
* Estructuras ejemplo a analizar: * Estructuras ejemplo a analizar:
*-------------------------------- *--------------------------------
* 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"
FOR I = I + 1 TO tnCodeLines FOR I = I + 1 TO tnCodeLines
THIS.set_Line( @tcLine, @taCodeLines, I ) THIS.set_Line( @tcLine, @taCodeLines, I )
@@ -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
@@ -15576,21 +15602,21 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
ENDTEXT ENDTEXT
ENDCASE ENDCASE
IF loReg.OBJCODE = 80 && Procedure de BAR o PAD IF loReg.OBJCODE = 80 && Procedure de BAR o PAD
*-- Reemplazo el nombre definitivo *-- Reemplazo el nombre definitivo
lcExpr = loReg.PROCEDURE lcExpr = loReg.PROCEDURE
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 )
tcEndProcedures = tcEndProcedures + STRTRAN( lcProcCode, '<<ProcName>>', lcProcName ) + CR_LF tcEndProcedures = tcEndProcedures + STRTRAN( lcProcCode, '<<ProcName>>', lcProcName ) + CR_LF
ENDIF ENDIF
*-- Menu Bar or Popup (ObjType:2, ObjCode:0 <20> 1) *-- Menu Bar or Popup (ObjType:2, ObjCode:0 <20> 1)
IF THIS.COUNT > 0 IF THIS.COUNT > 0
FOR EACH loBarPop IN THIS FOXOBJECT FOR EACH loBarPop IN THIS FOXOBJECT
@@ -15616,8 +15642,8 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
RETURN lcText RETURN lcText
ENDPROC ENDPROC
PROCEDURE get_DefineBarText PROCEDURE get_DefineBarText
*--------------------------------------------------------------------------------------------------- *---------------------------------------------------------------------------------------------------
* PAR<41>METROS: (!=Obligatorio | ?=Opcional) (@=Pasar por referencia | v=Pasar por valor) (IN/OUT) * PAR<41>METROS: (!=Obligatorio | ?=Opcional) (@=Pasar por referencia | v=Pasar por valor) (IN/OUT)
@@ -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