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

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

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

Vaciar el contenido de un directorio (archivos y carpetas)

Como podemos vaciar una carpeta y todo su contenido (Modificado)

*-----------------------------------------------------------------
* FUNCTION EmptyDir(tcRoot, tlNotAsk)
*-----------------------------------------------------------------
* Vacia todo el contenido (archivos y carpetas) del directorio
* "tcRoot" pasado como parámetro
* PARAMETROS:
*   tcRoot = Directorio a vaciar
*   tlNotAsk = .T. - No pregunta antes de vaciar el directorio
* USO:
*   =EmptyDir("C:TEMP", .F.)
*-----------------------------------------------------------------
FUNCTION EmptyDir(tcRoot, tlNotAsk)
  PRIVATE lnI, lnCant, laAux, lcSubDir
  tcRoot = ADDBS(tcRoot)
  IF NOT tlNotAsk
    IF 1 <> MESSAGEBOX("¿Esta Ud. seguro de borrar " + ;
        "todos los archivos y carpetas de" +CHR(13) + ;
        tcRoot + "?", 1+32+256, "Atención")
      RETURN
    ENDIF
  ENDIF

  ********************************
  **** Agregado por Leonel Ortega ***
  ********************************
  miComm = "attrib -r -h "+(tcRoot + "*.*")+" /S /D"
  =wScript(miComm,2)
  ********************************

  DELETE FILE (tcRoot + "*.*")
  lnCant = ADIR(laAux, tcRoot + "*.", "D")
  FOR lnI = 1 TO lnCant
    IF "D" $ laAux[lnI, 5]
      IF laAux[lnI, 1] == "." OR laAux[lnI, 1] == ".."
        LOOP
      ELSE
        lcSubDir = ADDBS(tcRoot + laAux[lnI, 1])
        =EmptyDir(lcSubDir, .T.)
        RMDIR (lcSubDir)
      ENDIF
    ENDIF
  ENDFOR
  RETURN
ENDFUNC

********************************
**** Agregado por Leonel Ortega ***
********************************
FUNCTION wScript
 LPARAMETER eComm, eWindowType
 IF pCount()=0
  WAIT WINDOW 'Faltan parametros en WScript' TIMEOUT 2
 ENDIF

 IF pCount()=1
  eWindowType = 1
 ENDIF

 LOCAL loWshShell
 loWshShell = CREATEOBJECT("WScript.shell")
 loWshShell.RUN( eComm ,eWindowType,.T.)  && el 2 es minimizado, 1 es Normal

ENDFUNC
********************************

Cerrar aplicación si un usuario esta mucho tiempo sin trabajar

¿Cuantas veces nos hemos encontrado que nuestros usuarios se van a tomar un cafe o marchan a comer con la aplicación abierta?

La verdad, es que a mi esto me há dado bastantes problemas, ya que realizo las copias de seguridad al mediodia. Y día si, día también hay usuarios que dejan la aplicación abierta, con el problema de que la copia no se realiza ya que los usuarios dejan archivos abiertos.

La solución es la siguiente:

crear un timer (p.ejemplo) programado para 15-20 minutos, y el el evento timer programar los pasos necesarios para cerrar la aplicación.

para que el timer no se dispare cuando los usuarios estan trabajando hago lo siguiente:

En el evento mouse move del formulario y en el keypress de cada objeto, hago:

IF VARTYPE(gotimer_inactividad)="O"
 * la cuenta atras de tiempo se inicia otra vez
    gotimer_inactividad.interval = gocsapp.tiempo_espera
ENDIF

En mi caso la parte del formulario la hago solo una vez, ya que todos mis formularios son hijos de uno maestro definido como una clase base.

¿Que codigo se pone para cerrar la aplicación? Depende de lo que desees hacer, es decir puedes no querer cerrar a un usuario si esta en el medio de una grabación,... yo en mi caso les cierro la aplicación descartando cualquier cambio que hayan realizado.

¿Drastico? Si, pero despues de que los usuarios pierden su trabajo dos veces, debido a su negligencia, os aseguro que no volveran a dejar el ordenador indebidamente encendido.

NOTAS:

gotimer_inactividad - es el objeto timer creado al iniciar la aplicación

gocsapp - es una clase general a todas las aplicaciones que desarrollo,
   tiene propiedades y metodos habituales.

gocsapp.tiempo_espera - define el tiempo de espera para lanzar el timer. Es
   por si aumento o disminuyo el tiempo de espera para no tener que cambiarselo
   a todos los objetos. Normalmente ahi le pongo 900000

Pablo Roca