23 de octubre de 2018

Cambia la resolución de la pantalla

*!* Cambia la resolución de la pantalla
*!* Sintaxis: ChangeRes(tnWidth, tnHeight)
*!* Valor devuelto: llRetVal
*!* Argumentos: tnWidth, tnHeight
*!* tnWidth especifica la nueva anchura de la pantalla en pixels
*!* tnHeight especifica la nueva altura de la pantalla en pixels

FUNCTION ChangeRes
    LPARAMETERS tnWidth, tnHeight
    LOCAL lnWidth, lnHeight, lnModeNum, lcDevMode
    *!* Valores
    lnModeNum  = 0
    lcDevMode  = REPLICATE(CHR(0), 156)
    lnWidth    = IIF(EMPTY(tnWidth), 800, tnWidth)
    lnHeight   = IIF(EMPTY(tnHeight), 600, tnHeight)
    *!* Instrucciones DECLARE DLL para cambiar resolución
    DECLARE INTEGER EnumDisplaySettings   IN Win32API STRING lpszDeviceName,;
 INTEGER iModeNum, STRING @lpDevMode
    DECLARE INTEGER ChangeDisplaySettings IN Win32API STRING @lpDevMode ,;
 INTEGER dwFlags
    *!* Bucle para obtener todos los modos disponibles
    DO WHILE EnumDisplaySettings(NULL, lnModeNum, @lcDevMode) <> 0
        lnModeNum = lnModeNum +1
    ENDDO
    *!* Configurar la structura DevMode
    lcDevMode = STUFF(lcDevMode,  41, 4, LongToStr(1572864))
    lcDevMode = STUFF(lcDevMode, 109, 4, LongToStr(tnWidth))  && Ancho
    lcDevMode = STUFF(lcDevMode, 113, 4, LongToStr(tnHeight))  && Alto
    *!* Cambiar resolucion
    ChangeDisplaySettings(@lcDevMode, 1)
ENDFUNC

*!* Convierte un long integer a un 4-byte character string
*!* Sintaxis: LongToStr(lnLongVal)
*!* Valor devuelto: lcRetStr
*!* Argumentos: lnLongVal
*!* lnLongVal especifica el long integer a convertir
FUNCTION LongToStr
    LPARAMETERS lnLongVal
    LOCAL lnCnt, lcRetStr
    lcRetStr = ''
    FOR lnCnt = 24 TO 0 STEP -8
        lcRetStr = CHR(INT(lnLongVal/(2^lnCnt))) + lcRetStr
        lnLongVal = MOD(lnLongVal, (2^lnCnt))
    NEXT
    RETURN lcRetStr
ENDFUNC

7 de octubre de 2018

Una funcion ADIR() Extendida que devuelve los nombres de los archivos con la ruta completa

Retorna en un vector la ruta y nombre de de todos los archivos que concuerden con lo especificado en "tcWild".

*--------------------------------------------------------
* FUNCTION ADIRX() - ADIR Extendido
*--------------------------------------------------------
* Devuelve en un array "taArray" pasado por referencia
* el listado de archivos especificado en "tcWild" con 
* la ruta completa. Ej: "D:\WORD\DOCUMENTO.DOC"
* PARAMETROS:
*    taArray: Array pasado por referencia
*    tcWild: Tipos de archivo. Ej: *.DBF
*    tcRoot: Directorio donde busca los archivos
* RETORNA: Numerico = Cantidad de archivos
* USO:
*    DIMENSION MiArray[1]
*    ? ADIRX(@MiArray, "*.PRG", "C:\PROGRAMAS\")
*--------------------------------------------------------
FUNCTION ADIRX(taArray, tcWild, tcRoot)
  IF EMPTY(tcWild)
    *--- Por defecto "*.*"
    tcWild = "*.*"
  ENDIF
  IF EMPTY(tcRoot)
    *--- Por defecto directorio actual
    tcRoot = SYS(5) + CURDIR()
  ENDIF
  tcRoot = ADDBS(tcRoot)
  DIMENSION taArray[1]
  lnCant = ADIR(taAux, tcRoot + tcWild)
  FOR lnI = 1 TO lnCant
    taArray[lnI] = tcRoot + taAux[lnI, 1]
    DIMENSION taArray[ALEN(taArray) + 1]
  ENDFOR
  IF ALEN(taArray) > 1
    DIMENSION taArray[ALEN(taArray) - 1]
    RETURN ALEN(taArray)
  ELSE
    RETURN 0
  ENDIF
ENDFUNC

Luis María Guayán
Yerba Buena, Tucumán

24 de septiembre de 2018

Como me aseguro que los formularios apuntan a las tablas correctas

Los formularios almacenan el path de las tablas definidas en el Entorno de Datos.

Por desgracia cuando se distribuye la aplicación, estos formularios pueden apuntar al directorio donde se desarrollaron. Estos paths deben ser reseteados en tiempo de ejecución para asegurarnos que apuntan a las tablas correctas.

* en el programa principal o en la de conexion determinar el directorio actual
* almacenarlo en variables globalos o del objeto aplicación.
gcAppPath = sys(2003)
gcDBPath = alltrim(gcAppPath)+"datos"
gcDBName = "mibasededatos.dbc"

Poner en el entorno de datos la propiedad AutoOpenTables = .F.

modificar la clase base del formulario (o cambialo en cada formulario) en el Metodo Load:

* apuntar todas las tablas al directorio y base de datos correcto
thisform.SetAll("Database",gcDbPath+gcDbname,"Cursor")
* abrir las tablas
thisform.dataenvironment.opentables()

NOTA: esto funciona con tablas de una base de datos, este codigo debe ser modificado si se usan tablas libres.

Pablo Roca