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