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

Enhancement: Make FoxBin2Prg more COM friendly when using ESC key (Tracy Pearson)

Browse Source
This commit is contained in:
fdbozzo
2019-02-24 21:01:25 +01:00
parent d71238bf89 625d31a5ec
commit 8f765199b1
1 changed files with 28 additions and 24 deletions
Download Patch File Download Diff File Expand all files Collapse all files

52
foxbin2prg.prg
View File

@@ -219,6 +219,7 @@
* 20/06/2018 FDBOZZO v1.19.51.2 Bug Fix: Cuando se exporta un DBF que pertenece a un DBC sin eventos, falla (Jairo Argüelles/Juan C.Perdomo) * 20/06/2018 FDBOZZO v1.19.51.2 Bug Fix: Cuando se exporta un DBF que pertenece a un DBC sin eventos, falla (Jairo Argüelles/Juan C.Perdomo)
* 09/07/2018 FDBOZZO v1.19.51.3 Bug Fix: Error 1098, Cannot find ... [ENDT] that closes ... [TEXT] Issue#26 when there is a field named TEXT as first line-word (KIRIDES) * 09/07/2018 FDBOZZO v1.19.51.3 Bug Fix: Error 1098, Cannot find ... [ENDT] that closes ... [TEXT] Issue#26 when there is a field named TEXT as first line-word (KIRIDES)
* 10/07/2018 FDBOZZO v1.19.51.4 Bug Fix: El ordenamiento alfabético de los objetos de los ADD OBJECT puede causar que algunos objetos se creen en el orden erróneo, provocando comportamientos inesperados (Jochen Kauz) * 10/07/2018 FDBOZZO v1.19.51.4 Bug Fix: El ordenamiento alfabético de los objetos de los ADD OBJECT puede causar que algunos objetos se creen en el orden erróneo, provocando comportamientos inesperados (Jochen Kauz)
* 14/02/2019 TRACY_P v1.19.51.5 Enhancement: Make FoxBin2Prg more COM friendly when using ESC key (Tracy Pearson)
* </HISTORIAL DE CAMBIOS Y NOTAS IMPORTANTES> * </HISTORIAL DE CAMBIOS Y NOTAS IMPORTANTES>
* *
*--------------------------------------------------------------------------------------------------- *---------------------------------------------------------------------------------------------------
@@ -2888,6 +2889,7 @@ DEFINE CLASS c_foxbin2prg AS Session
lcInputFile_Type = '' lcInputFile_Type = ''
.l_Error = .F. .l_Error = .F.
tcType = UPPER( EVL(tcType,'') ) tcType = UPPER( EVL(tcType,'') )
llEscKeyRestored = .T.
.declareDLL() .declareDLL()
IF THIS.l_CancelWithEscKey THEN IF THIS.l_CancelWithEscKey THEN
@@ -2895,6 +2897,7 @@ DEFINE CLASS c_foxbin2prg AS Session
lcOldOnEscape = ON("Escape") lcOldOnEscape = ON("Escape")
ON ESCAPE ERROR 1799 ON ESCAPE ERROR 1799
SET ESCAPE ON SET ESCAPE ON
llEscKeyRestored = .F.
ENDIF ENDIF
DO CASE DO CASE
@@ -3441,7 +3444,7 @@ DEFINE CLASS c_foxbin2prg AS Session
ENDWITH && THIS ENDWITH && THIS
CATCH TO toEx CATCH TO toEx
IF THIS.l_CancelWithEscKey THEN IF NOT llEscKeyRestored AND THIS.l_CancelWithEscKey THEN
IF EMPTY(lcOldOnEscape) IF EMPTY(lcOldOnEscape)
ON ESCAPE ON ESCAPE
ELSE ELSE
@@ -3504,6 +3507,7 @@ DEFINE CLASS c_foxbin2prg AS Session
ELSE ELSE
SET ESCAPE &lcOldSetEscape. SET ESCAPE &lcOldSetEscape.
ENDIF ENDIF
llEscKeyRestored = .T.
ENDIF ENDIF
IF VARTYPE(loLang) <> 'O' THEN IF VARTYPE(loLang) <> 'O' THEN
@@ -6497,8 +6501,8 @@ DEFINE CLASS c_conversor_base AS Custom
CASE NOT lcWord == 'TEXT' CASE NOT lcWord == 'TEXT'
EXIT EXIT
*CASE UPPER( LEFT( CHRTRAN( lcLine, ' ', '' ), 5 ) ) == 'TEXT=' *CASE UPPER( LEFT( CHRTRAN( lcLine, ' ', '' ), 5 ) ) == 'TEXT='
* EXIT * EXIT
CASE lnWordCount >= 2 CASE lnWordCount >= 2
IF lcWord2 == "TO" IF lcWord2 == "TO"
* OK, es TEXT TO... * OK, es TEXT TO...
@@ -7575,8 +7579,8 @@ DEFINE CLASS c_conversor_base AS Custom
* VER: https://github.com/fdbozzo/foxbin2prg/issues/28 * VER: https://github.com/fdbozzo/foxbin2prg/issues/28
* *
* PASO 1: Obtener los nombres únicos y asignarles un código de orden * PASO 1: Obtener los nombres únicos y asignarles un código de orden
CREATE CURSOR C_OBJ (objName C(50), iOrder I AUTOINC) CREATE CURSOR C_OBJ (OBJNAME C(50), IORDER I AUTOINC)
INDEX ON objname TAG objname INDEX ON OBJNAME TAG OBJNAME
* PASO 2: Configurar las prioridades de ordenamiento (primero props, luego objs) * PASO 2: Configurar las prioridades de ordenamiento (primero props, luego objs)
FOR I = 1 TO m.tnPropsAndValues_Count FOR I = 1 TO m.tnPropsAndValues_Count
@@ -7584,29 +7588,29 @@ DEFINE CLASS c_conversor_base AS Custom
IF m.tnSortType = 2 IF m.tnSortType = 2
* Genera obj+props para BIN * Genera obj+props para BIN
lcObjName = GETWORDNUM(laPropsAndValues(m.I,1), 1, '.') lcObjName = GETWORDNUM(laPropsAndValues(m.I,1), 1, '.')
IF NOT SEEK(LOWER(lcObjName), "C_OBJ") IF NOT SEEK(LOWER(lcObjName), "C_OBJ")
INSERT INTO C_OBJ (objName) VALUES (LOWER(lcObjName)) INSERT INTO C_OBJ (OBJNAME) VALUES (LOWER(lcObjName))
ENDIF ENDIF
laPropsAndValues(m.I,1) = 'B' + PADL(C_OBJ.iOrder,3,'0') ; laPropsAndValues(m.I,1) = 'B' + PADL(C_OBJ.IORDER,3,'0') ;
+ JUSTSTEM(laPropsAndValues(m.I,1)) + '.' ; + JUSTSTEM(laPropsAndValues(m.I,1)) + '.' ;
+ .sortPropsAndValues_SetAndGetSCXPropNames( 'SETNAME', JUSTEXT(laPropsAndValues(m.I,1)) ) + .sortPropsAndValues_SetAndGetSCXPropNames( 'SETNAME', JUSTEXT(laPropsAndValues(m.I,1)) )
*laPropsAndValues(m.I,1) = 'B000' + lcObjName + '.' ; *laPropsAndValues(m.I,1) = 'B000' + lcObjName + '.' ;
+ .sortPropsAndValues_SetAndGetSCXPropNames( 'SETNAME', JUSTEXT(laPropsAndValues(m.I,1)) ) + .sortPropsAndValues_SetAndGetSCXPropNames( 'SETNAME', JUSTEXT(laPropsAndValues(m.I,1)) )
ELSE ELSE
* Genera obj+props para TX2 * Genera obj+props para TX2
lcObjName = GETWORDNUM(laPropsAndValues(m.I,1), 1, '.') lcObjName = GETWORDNUM(laPropsAndValues(m.I,1), 1, '.')
IF NOT SEEK(LOWER(lcObjName), "C_OBJ") IF NOT SEEK(LOWER(lcObjName), "C_OBJ")
INSERT INTO C_OBJ (objName) VALUES (LOWER(lcObjName)) INSERT INTO C_OBJ (OBJNAME) VALUES (LOWER(lcObjName))
ENDIF ENDIF
laPropsAndValues(m.I,1) = 'B' + PADL(C_OBJ.iOrder,3,'0') ; laPropsAndValues(m.I,1) = 'B' + PADL(C_OBJ.IORDER,3,'0') ;
+ JUSTSTEM(laPropsAndValues(m.I,1)) + '.' ; + JUSTSTEM(laPropsAndValues(m.I,1)) + '.' ;
+ JUSTEXT(laPropsAndValues(m.I,1)) + JUSTEXT(laPropsAndValues(m.I,1))
*laPropsAndValues(m.I,1) = 'B' + PADL(I,3,'0') + laPropsAndValues(m.I,1) *laPropsAndValues(m.I,1) = 'B' + PADL(I,3,'0') + laPropsAndValues(m.I,1)
ENDIF ENDIF
ELSE ELSE
@@ -17510,7 +17514,7 @@ DEFINE CLASS c_conversor_dbf_a_prg AS c_conversor_bin_a_prg
IF NOT EMPTY(lc_DBC_Name) AND ADIR(laDirInfo, FULLPATH(lc_DBC_Name, .c_InputFile)) = 1 IF NOT EMPTY(lc_DBC_Name) AND ADIR(laDirInfo, FULLPATH(lc_DBC_Name, .c_InputFile)) = 1
loDBC._DBC = FULLPATH(lc_DBC_Name, .c_InputFile) loDBC._DBC = FULLPATH(lc_DBC_Name, .c_InputFile)
llDBCEventsEnabled = loDBC.DBGETPROP(lc_DBC_Name,"DATABASE","DBCEvents") llDBCEventsEnabled = loDBC.DBGETPROP(lc_DBC_Name,"DATABASE","DBCEvents")
* llDBCEventsEnabled no siempre devuelve .T./.F., a veces devuelve "" * llDBCEventsEnabled no siempre devuelve .T./.F., a veces devuelve ""
IF EMPTY(llDBCEventsEnabled) IF EMPTY(llDBCEventsEnabled)
llDBCEventsEnabled = .F. llDBCEventsEnabled = .F.
@@ -21957,7 +21961,7 @@ DEFINE CLASS CL_DBC_FIELDS_DB AS CL_DBC_COL_BASE
STORE NULL TO loField STORE NULL TO loField
STORE 0 TO I, lnField_Count STORE 0 TO I, lnField_Count
_TALLY = 0 _TALLY = 0
SELECT LOWER(TB.ObjectName) FROM TABLABIN TB ; SELECT LOWER(TB.ObjectName) FROM TABLABIN TB ;
INNER JOIN TABLABIN TB2 ON STR(TB.ParentId)+TB.ObjectType = STR(TB2.ObjectID)+PADR('Field',10) ; INNER JOIN TABLABIN TB2 ON STR(TB.ParentId)+TB.ObjectType = STR(TB2.ObjectID)+PADR('Field',10) ;
AND LOWER(TB2.ObjectName) = PADR(LOWER(tcTable),128) ; AND LOWER(TB2.ObjectName) = PADR(LOWER(tcTable),128) ;
@@ -22701,12 +22705,12 @@ DEFINE CLASS CL_DBC_VIEWS AS CL_DBC_COL_BASE
*LG lnView_Count = ADBOBJECTS( laViews, "VIEW" ) *LG lnView_Count = ADBOBJECTS( laViews, "VIEW" )
SELECT CAST(ALLTRIM(ObjectName) as varchar(128)) ; SELECT CAST(ALLTRIM(ObjectName) as varchar(128)) ;
FROM TablaBin ; FROM TABLABIN ;
WHERE UPPER(ObjectType) = 'VIEW' ; WHERE UPPER(ObjectType) = 'VIEW' ;
ORDER BY 1 ; ORDER BY 1 ;
INTO ARRAY laViews INTO ARRAY laViews
lnView_Count = _TALLY lnView_Count = _TALLY
IF lnView_Count > 0 IF lnView_Count > 0
FOR I = 1 TO lnView_Count FOR I = 1 TO lnView_Count
loView = CREATEOBJECT("CL_DBC_VIEW") loView = CREATEOBJECT("CL_DBC_VIEW")
@@ -30262,7 +30266,7 @@ DEFINE CLASS CL_MEMVAR AS CL_COL_BASE
* Byte Offset Description * Byte Offset Description
* ----------- ------------------------------------------------------------------------------------------------- * ----------- -------------------------------------------------------------------------------------------------
* 0 - 10 NULL terminated VarName. If VarName is empty, then VarName starts at offset 32 * 0 - 10 NULL terminated VarName. If VarName is empty, then VarName starts at offset 32
* 11 VarType (A,C,N,Y,B,F,I,Q,D,T,L,0). If VarType is lowercase, then next VarName * 11 VarType (A,C,N,Y,B,F,I,Q,D,T,L,0). If VarType is lowercase, then next VarName
* begins with 2 bytes for VarName length. * begins with 2 bytes for VarName length.
* 12 - 15 Reserved * 12 - 15 Reserved
* 16 Value length * 16 Value length
@@ -30270,7 +30274,7 @@ DEFINE CLASS CL_MEMVAR AS CL_COL_BASE
* 18 - 24 Reserved * 18 - 24 Reserved
* 25 0x00 if it is an array element, 0x03 if it isn't an array element * 25 0x00 if it is an array element, 0x03 if it isn't an array element
* 26 - 31 Reserved * 26 - 31 Reserved
* 32 - n If VarName (offset 0-10) is NULL then goto TABLE 1, If VarType=A then continue in TABLE 2, * 32 - n If VarName (offset 0-10) is NULL then goto TABLE 1, If VarType=A then continue in TABLE 2,
* if VarType=0 then continue in TABLE 3, else continue in TABLE 4 * if VarType=0 then continue in TABLE 3, else continue in TABLE 4
* ... * ...
* eof Last character is EOF (0x1A) character * eof Last character is EOF (0x1A) character
@@ -30282,7 +30286,7 @@ DEFINE CLASS CL_MEMVAR AS CL_COL_BASE
* ----------- ------------------------------------------------------------------------------------------------- * ----------- -------------------------------------------------------------------------------------------------
* 32 - 33 VarName length * 32 - 33 VarName length
* 34 - n VarName * 34 - n VarName
* n + 1 Next TABLE: If VarType=A then continue in TABLE 2, if VarType=0 then continue in TABLE 3, * n + 1 Next TABLE: If VarType=A then continue in TABLE 2, if VarType=0 then continue in TABLE 3,
* else continue in TABLE 4 * else continue in TABLE 4
* ----------- ------------------------------------------------------------------------------------------------- * ----------- -------------------------------------------------------------------------------------------------
@@ -30307,7 +30311,7 @@ DEFINE CLASS CL_MEMVAR AS CL_COL_BASE
* TABLE 4 - NORMAL VALUE STRUCTURE * TABLE 4 - NORMAL VALUE STRUCTURE
* Byte Offset Description * Byte Offset Description
* ----------- ------------------------------------------------------------------------------------------------- * ----------- -------------------------------------------------------------------------------------------------
* n - x Value of length "value length". If ValTye is a Char type then Value length is the value's width, * n - x Value of length "value length". If ValTye is a Char type then Value length is the value's width,
* else the width is 8 for numbers and dates * else the width is 8 for numbers and dates
* x Next Variable structure, or EOF (0x1A) * x Next Variable structure, or EOF (0x1A)
* ----------- ------------------------------------------------------------------------------------------------- * ----------- -------------------------------------------------------------------------------------------------