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

Changeset: 116 Menu a Texto finalizado

Browse Source
This commit is contained in:
fernando
2013-12-29 01:31:45 +01:00
parent 48a3f1edca
commit bf9ddb6cdd
1 changed files with 137 additions and 67 deletions
Download Patch File Download Diff File Expand all files Collapse all files

204
foxbin2prg.prg
View File

@@ -13910,10 +13910,6 @@ DEFINE CLASS CL_MENU_COL_BASE AS CL_COL_BASE
SCATTER MEMO NAME loReg SCATTER MEMO NAME loReg
IF EMPTY(loReg.NAME)
loReg.NAME = SYS(2015)
ENDIF
lnLastKey = toCol_LastLevelName.GETKEY(loReg.LevelName) lnLastKey = toCol_LastLevelName.GETKEY(loReg.LevelName)
DO CASE DO CASE
@@ -14087,26 +14083,30 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
PROCEDURE toText PROCEDURE toText
*--------------------------------------------------------------------------------------------------- *---------------------------------------------------------------------------------------------------
* 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)
* tc_InputFile (v! IN ) Nombre del archivo de salida
*--------------------------------------------------------------------------------------------------- *---------------------------------------------------------------------------------------------------
TRY TRY
LOCAL lcText, lcLastLevelName, loReg, lnNivel ; LOCAL lcText, loReg, lnNivel, lcEndProcedures ;
, loEx AS EXCEPTION ; , loEx AS EXCEPTION ;
, loCol_LastLevelName AS COLLECTION ; , loCol_LastLevelName AS COLLECTION ;
, loBarPop AS CL_MENU_BARPOP OF 'FOXBIN2PRG.PRG' ; , loBarPop AS CL_MENU_BARPOP OF 'FOXBIN2PRG.PRG' ;
, loOption AS CL_MENU_OPTION OF 'FOXBIN2PRG.PRG' , loOption AS CL_MENU_OPTION OF 'FOXBIN2PRG.PRG'
STORE '' TO lcText, lcLastLevelName STORE '' TO lcText, lcEndProcedures
loReg = THIS.oReg loReg = THIS.oReg
loBarPop = THIS.ITEM(1) loBarPop = THIS.ITEM(1).oReg
lnNivel = 0 lnNivel = 0
IF NOT EMPTY(loReg.Setup)
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<>>
<<C_SETUPCODE_I>>
<<loReg.Setup>>
<<C_SETUPCODE_F>>
ENDTEXT
ENDIF
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>>
<<loReg.Setup>>
<<C_SETUPCODE_F>>
<<>> <<>>
<<C_MENUCODE_I>> <<C_MENUCODE_I>>
ENDTEXT ENDTEXT
@@ -14114,33 +14114,44 @@ DEFINE CLASS CL_MENU AS CL_MENU_COL_BASE
*-- Bars and Popups *-- Bars and Popups
IF THIS.COUNT > 0 IF THIS.COUNT > 0
FOR EACH loBarPop IN THIS FOXOBJECT FOR EACH loBarPop IN THIS FOXOBJECT
lcText = lcText + loBarPop.toText(loReg, lnNivel+0) lcText = lcText + loBarPop.toText(loReg, lnNivel+0, @lcEndProcedures)
ENDFOR ENDFOR
ENDIF ENDIF
loBarPop = THIS.ITEM(1).oReg
*-- Propecimiento principal de _MSYSMENU (ObjType:1, ObjCode:22) *-- Propecimiento principal de _MSYSMENU (ObjType:1, ObjCode:22)
IF NOT EMPTY(loReg.PROCEDURE) IF NOT EMPTY(loReg.PROCEDURE)
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
ON SELECTION MENU <<loBarPop.oReg.Name>> <<loReg.Procedure>> ON SELECTION MENU <<loBarPop.Name>> <<loReg.Procedure>>
ENDTEXT ENDTEXT
ENDIF ENDIF
*-- Procedimiento del Menu Bar (ObjType:2, ObjCode:1) *-- Procedimiento del Menu Bar (ObjType:2, ObjCode:1)
IF NOT EMPTY(loBarPop.oReg.PROCEDURE) IF NOT EMPTY(loBarPop.PROCEDURE)
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
ON SELECTION POPUP ALL <<loBarPop.oReg.Procedure>> ON SELECTION POPUP ALL <<loBarPop.Procedure>>
ENDTEXT ENDTEXT
ENDIF ENDIF
*-- Procedimientos finales
IF NOT EMPTY(lcEndProcedures)
lcText = lcText + CR_LF + CR_LF + lcEndProcedures
ENDIF
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>>
<<>>
<<C_CLEANUPCODE_I>>
<<THIS.oReg.Cleanup>>
<<C_CLEANUPCODE_F>>
<<>>
ENDTEXT ENDTEXT
IF NOT EMPTY(loReg.Cleanup)
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<>>
<<C_CLEANUPCODE_I>>
<<loReg.Cleanup>>
<<C_CLEANUPCODE_F>>
ENDTEXT
ENDIF
CATCH TO loEx CATCH TO loEx
IF THIS.l_Debug AND _VFP.STARTMODE = 0 IF THIS.l_Debug AND _VFP.STARTMODE = 0
@@ -14248,8 +14259,9 @@ DEFINE CLASS CL_MENU_BARPOP AS CL_MENU_COL_BASE
* 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)
* toParentReg (v? IN ) Objeto registro Padre * toParentReg (v? IN ) Objeto registro Padre
* tnNivel (v? IN ) Nivel para indentar * tnNivel (v? IN ) Nivel para indentar
* tcEndProcedures (@! OUT) Agregar aqu<71> los procedimientos que ir<69>n al final
*--------------------------------------------------------------------------------------------------- *---------------------------------------------------------------------------------------------------
LPARAMETERS toParentReg, tnNivel LPARAMETERS toParentReg, tnNivel, tcEndProcedures
TRY TRY
LOCAL loReg, I, lcText, lcTab, loEx AS EXCEPTION ; LOCAL loReg, I, lcText, lcTab, loEx AS EXCEPTION ;
@@ -14271,7 +14283,7 @@ DEFINE CLASS CL_MENU_BARPOP AS CL_MENU_COL_BASE
*-- Options (ObjType:3) *-- Options (ObjType:3)
IF THIS.COUNT > 0 IF THIS.COUNT > 0
FOR EACH loOption IN THIS FOXOBJECT FOR EACH loOption IN THIS FOXOBJECT
lcText = lcText + loOption.toText(loReg, tnNivel+0) lcText = lcText + loOption.toText(loReg, tnNivel+0, @tcEndProcedures)
ENDFOR ENDFOR
ENDIF ENDIF
@@ -14372,52 +14384,78 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
* 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)
* toParentReg (v? IN ) Objeto registro Padre * toParentReg (v? IN ) Objeto registro Padre
* tnNivel (v? IN ) Nivel para indentar * tnNivel (v? IN ) Nivel para indentar
* tcEndProcedures (@! OUT) Agregar aqu<71> los procedimientos que ir<69>n al final
*--------------------------------------------------------------------------------------------------- *---------------------------------------------------------------------------------------------------
LPARAMETERS toParentReg, tnNivel LPARAMETERS toParentReg, tnNivel, tcEndProcedures
TRY TRY
LOCAL loReg, I, lcText, lcTab, loEx AS EXCEPTION ; LOCAL loReg, I, lcText, lcTab, lcProcName, lcProcCode, laProcLines(1), lnProcLines, loEx AS EXCEPTION ;
, loBarPop AS CL_MENU_BARPOP OF 'FOXBIN2PRG.PRG' ; , loBarPop AS CL_MENU_BARPOP OF 'FOXBIN2PRG.PRG' ;
, loOption AS CL_MENU_OPTION OF 'FOXBIN2PRG.PRG' , loOption AS CL_MENU_OPTION OF 'FOXBIN2PRG.PRG'
lcText = ''
loReg = THIS.oReg lcText = ''
lcTab = REPLICATE(CHR(9),tnNivel) lcProcName = ''
loReg = THIS.oReg
lcTab = REPLICATE(CHR(9),tnNivel)
loBarPop = toParentReg
*-- Actualizaci<63>n de procedimientos
IF loReg.OBJCODE = 80 && Procedure
*-- Si existe el snippet #NAME, lo usa
IF NOT EMPTY(loReg.Procedure)
lnProcLines = ALINES(laProcLines, loReg.Procedure)
FOR I = 1 TO lnProcLines
IF UPPER( LEFT( ALLTRIM(laProcLines(I)), 6 ) ) == '#NAME '
lcProcName = ALLTRIM( SUBSTR( ALLTRIM(laProcLines(I)), 7 ) )
ADEL(laProcLines,I)
lnProcLines = lnProcLines - 1
DIMENSION laProcLines(lnProcLines)
EXIT
ENDIF
ENDFOR
IF NOT EMPTY(lcProcName)
*-- Rearmo el Procedure sin el snippet
WITH loReg
.Procedure = ''
FOR I = 1 TO lnProcLines
.Procedure = .Procedure + laProcLines(I) + CR_LF
ENDFOR
ENDWITH
ENDIF
ENDIF
ENDIF
*-- Options (ObjType:3) *-- Options (ObjType:3)
DO CASE IF toParentReg.ObjType=2 AND toParentReg.OBJCODE=0
CASE loReg.OBJCODE=67 && Command *-- Define Bar
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<THIS.get_DefineBarText(loReg, loBarPop, tnNivel)>> <<THIS.get_DefineBarText(loReg, loBarPop, tnNivel)>>
ENDTEXT ENDTEXT
ELSE && Define Pad (toParentReg.ObjType=2 AND toParentReg.OBJCODE=1)
CASE loReg.OBJCODE=77 && Submenu TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
IF toParentReg.ObjType=2 AND toParentReg.OBJCODE=0 <<THIS.get_DefinePadText(loReg, loBarPop, tnNivel)>>
*-- Define Bar ENDTEXT
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 ENDIF
<<THIS.get_DefineBarText(loReg, loBarPop, tnNivel)>>
ENDTEXT IF loReg.OBJCODE = 80 && Procedure
ELSE && Define Pad *-- Reemplazo el nombre definitivo
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 IF EMPTY(lcProcName)
<<THIS.get_DefinePadText(loReg, loBarPop, tnNivel)>> lcProcName = CHRTRAN( ALLTRIM( STREXTRACT( lcText, 'DEFINE ', 'PROMPT ' ) ), ' ', '_' )
ENDTEXT
ENDIF ENDIF
CASE loReg.OBJCODE=78 && BAR# lcText = STRTRAN( lcText, '<<ProcName>>', lcProcName )
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2 tcEndProcedures = tcEndProcedures ;
<<THIS.get_DefineBarText(loReg, loBarPop, tnNivel)>> + 'PROCEDURE ' + lcProcName + CR_LF ;
ENDTEXT + ALLTRIM(loReg.Procedure) + CR_LF ;
+ 'ENDPROC' + CR_LF + CR_LF
CASE loReg.OBJCODE=80 && Procedure ENDIF
TEXT TO lcText ADDITIVE TEXTMERGE NOSHOW FLAGS 1+2 PRETEXT 1+2
<<THIS.get_DefineBarText(loReg, loBarPop, tnNivel)>>
ENDTEXT
ENDCASE
*-- 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
lcText = lcText + loBarPop.toText(loReg, tnNivel+1) lcText = lcText + loBarPop.toText(loReg, tnNivel+1, @tcEndProcedures)
ENDFOR ENDFOR
ENDIF ENDIF
@@ -14445,12 +14483,13 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
LPARAMETERS toReg, toBarPop, tnNivel LPARAMETERS toReg, toBarPop, tnNivel
TRY TRY
LOCAL lcText, lcTab, loEx as Exception LOCAL lcText, lcTab, loEx as Exception ;
, loBarPop AS CL_MENU_BARPOP OF 'FOXBIN2PRG.PRG'
lcTab = REPLICATE(CHR(9),tnNivel) lcTab = REPLICATE(CHR(9),tnNivel)
*-- DEFINE BAR *-- DEFINE BAR
lcText = lcTab + '*----------------------------------' + CR_LF lcText = lcTab + '*----------------------------------' + CR_LF
lcText = lcText + lcTab + 'DEFINE BAR ' + ALLTRIM(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)
@@ -14463,7 +14502,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
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
@@ -14478,10 +14517,23 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
ENDIF ENDIF
*-- ON BAR *-- ON BAR
IF toReg.OBJCODE <> 78 IF toReg.OBJCODE <> 78 && Bar#
lcText = lcText + CR_LF IF toReg.OBJCODE = 77 && Submenu
lcText = lcText + lcTab + 'ON BAR ' + ALLTRIM(toReg.ItemNum) + ' OF ' + ALLTRIM(toReg.LevelName) ; loBarPop = THIS.Item(1).oReg
+ ' ACTIVATE POPUP ' + ALLTRIM(toReg.Name) && VER ESTO lcText = lcText + CR_LF
lcText = lcText + lcTab + 'ON BAR ' + ALLTRIM(toReg.ItemNum) + ' OF ' + ALLTRIM(toReg.LevelName) ;
+ ' ACTIVATE POPUP ' + ALLTRIM(loBarPop.Name)
ELSE
lcText = lcText + CR_LF
lcText = lcText + lcTab + 'ON SELECTION BAR ' + ALLTRIM(toReg.ItemNum) + ' OF ' + ALLTRIM(toReg.LevelName)
DO CASE
CASE toReg.OBJCODE = 67 && Command
lcText = lcText + ' ' + ALLTRIM(toReg.Command)
CASE toReg.OBJCODE = 80 && Procedure
lcText = lcText + ' DO <<ProcName>>'
ENDCASE
ENDIF
ENDIF ENDIF
lcText = lcText + CR_LF lcText = lcText + CR_LF
@@ -14509,14 +14561,16 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
LPARAMETERS toReg, toBarPop, tnNivel LPARAMETERS toReg, toBarPop, tnNivel
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'
lcTab = REPLICATE(CHR(9),tnNivel) lcTab = REPLICATE(CHR(9),tnNivel)
toReg.Name = EVL(toReg.Name,SYS(2015))
*-- 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(toReg.SCHEME) && VER ESTO: Deberia ir toBarPop + ' 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
@@ -14535,7 +14589,7 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
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
@@ -14552,8 +14606,24 @@ DEFINE CLASS CL_MENU_OPTION AS CL_MENU_COL_BASE
lcText = lcText + CR_LF lcText = lcText + CR_LF
*-- ON PAD *-- ON PAD
lcText = lcText + lcTab + 'ON PAD ' + ALLTRIM(toReg.ItemNum) + ' OF ' + ALLTRIM(toReg.LevelName) ; IF toReg.OBJCODE <> 78 && Bar#
+ ' ACTIVATE POPUP ' + ALLTRIM(toReg.LevelName) && VER ESTO: Deberia ir toBarPop IF toReg.OBJCODE = 77 && Submenu
loBarPop = THIS.Item(1).oReg
lcText = lcText + CR_LF
lcText = lcText + lcTab + 'ON PAD ' + ALLTRIM(toReg.Name) + ' OF ' + ALLTRIM(toReg.LevelName) ;
+ ' ACTIVATE POPUP ' + ALLTRIM(loBarPop.Name)
ELSE
lcText = lcText + CR_LF
lcText = lcText + lcTab + 'ON SELECTION PAD ' + ALLTRIM(toReg.Name) + ' OF ' + ALLTRIM(toReg.LevelName)
DO CASE
CASE toReg.OBJCODE = 67 && Command
lcText = lcText + ' ' + ALLTRIM(toReg.Command)
CASE toReg.OBJCODE = 80 && Procedure
lcText = lcText + ' DO <<ProcName>>'
ENDCASE
ENDIF
ENDIF
lcText = lcText + CR_LF lcText = lcText + CR_LF