Para limitar la entrada de un campo memo a X lineas, simplemente hay que poner en el keypress lo siguiente:
LPARAMETERS nKeyCode, nShiftAltCtrl
IF nkeycode = 13
IF OCCURS(chr(13),this.value) >=5
NODEFAULT
ENDIF
ENDIF
En este ejemplo se limita a 6 lineas.
Pablo Roca
Desconectar una unidad de red con Microsoft Windows Script Host
o = CREATEOBJECT('Wscript.Network')
* o.RemoveNetworkDrive(Unidad)
o.RemoveNetworkDrive("Z:")
Luis María Guayán
? damenumaleatorio(10,99)
*---------------------------
FUNCTION damenumaleatorio
PARAMETERS primero, segundo
RAND(-1)
RETURN INT((segundo - primero + 1) ;
* RAND() + primero)
ENDFUNC
*---------------------------
Nota del editor: Para que los valores retornados por la función RAND() sean lo mas aleatorio posible tener en cuenta la ayuda de la función en la documentación de Visual FoxPro:
Sintaxis:
RAND([nSeedValue])
Parámetros
nSeedValue: Especifica el valor Seed que determina la secuencia de valores que devuelve RAND().
RAND() devuelve la misma secuencia de números aleatorios si utiliza el mismo valor Seed para nSeedValue la primera vez que ejecuta la función RAND(), seguida de llamadas posteriores a la función RAND() sin nSeedValue.
Si nSeedValue es negativo la primera vez que ejecuta RAND(), se usará un valor Seed a partir del reloj del sistema. Para obtener la serie más aleatoria de números, utilice inicialmente RAND() con un argumento negativo y después, ejecute RAND() sin ningún argumento.
Si omite nSeedValue, RAND() utilizará de forma predeterminada el valor Seed 100.001.
lc = "Bienvenidos a Visual FoxPro"
ln = ALINES(la, STRTRAN(ALLTRIM(lc), " ", chr(13)))
FOR i = 1 TO ln
? la(i)
ENDFOR
Luis María Guayán
*--- Español en formato largo y Separador "-"
? DTOCNA({07/10/2000}, "E", "L", "-")
-> 07-OCT-2000
*--- Alemán en formato corto y Separador "/"
? DTOCNA({07/10/2000}, "A", "C", "/")
-> 07/OKT/00
*-----------------------------------------------------------------
* FUNCTION DTOCNA(tdFecha, tcLeng, tcLong, tcSep)
*-----------------------------------------------------------------
* Date TO Caracter No Ambiguo
* PARAMETROS:
* tdFecha: Fecha a convertir. Default = DATE()
* tcLeng:
* [E]spañol [I]nglés [F]rancés [A]lemán
* i[T]aliano [P]ortugués
* tcLong:
* [L]argo: 12 ENE 2000 ó [C]orto: 01 ENE 00
* tcSep:
* Caracter separador del dia-mes-año. Default = " "
* Si tcSep = .NULL. no tiene separador
* RETORNO: Caracter
* USO: ? DTOCNA({01/01/1999}, "I", "C", "-") -> 01-JAN-99
* AUTOR: LMG - 2000/06/15
*-----------------------------------------------------------------
FUNCTION DTOCNA(tdFecha, tcLeng, tcLong, tcSep)
LOCAL lcMes, lnI
IF EMPTY(tdFecha) OR NOT VARTYPE(tdFecha) $ "DT"
tdFecha = DATE()
ENDIF
IF EMPTY(tcLeng) OR NOT UPPER(tcLeng) $ "EIFATP"
tcLeng = "E"
ELSE
tcLeng = UPPER(tcLeng)
ENDIF
IF EMPTY(tcLong) OR NOT UPPER(tcLong) $ "CL"
tcLong = "L"
ELSE
tcLong = UPPER(tcLong)
ENDIF
IF EMPTY(tcSep)
tcSep = " "
ELSE
IF ISNULL(tcSep)
tcSep = ""
ENDIF
ENDIF
lnI = (MONTH(tdFecha)* 3) - 2
DO CASE
CASE tcLeng = "E"
lcMes = SUBS("ENEFEBMARABRMAYJUNJULAGOSETOCTNOVDIC", lnI, 3)
CASE tcLeng = "I"
lcMes = SUBS("JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC", lnI, 3)
CASE tcLeng = "F"
lcMes = SUBS("JANFEVMARAVRMAIJUNJULAOUSEPOCTNOVDEC", lnI, 3)
CASE tcLeng = "A"
lcMes = SUBS("JANFEBMARAPRMAIJUNJULAUGSEPOKTNOVDEZ", lnI, 3)
CASE tcLeng = "T"
lcMes = SUBS("GENFEBMARAPRMAGGIULUGAGOSETOTTNOVDIC", lnI, 3)
CASE tcLeng = "P"
lcMes = SUBS("JANFEVMARABRMAIJUNJULAGOSETOUTNOVDEZ", lnI, 3)
ENDCASE
RETURN TRAN(DAY(tdFecha), "@L 99") + tcSep + lcMes + tcSep + ;
IIF(tcLong = "L", TRAN(YEAR(tdFecha), "@L 9999"), ;
TRAN(YEAR(tdFecha) % 100, "@L 99"))
ENDFUNC
*-----------------------------------------------------------------
Luis María Guayán
*-----------------------------
* FUNCTION Dif_DHMS(ttIni,ttFin)
*-----------------------------
* Calcula la diferencia de dos variables
* DATETIME y retorna en formato
* ### Días, ## Horas, ## Minutos, ## Segundos
*-----------------------------
FUNCTION Dif_DHMS(ttIni,ttFin)
LOCAL ln, lnDia, lnHor, lnMin, lnSeg
IF EMPTY(ttFin)
ttFin = DATETIME()
ENDIF
ln = ttFin - ttIni
lnSeg = MOD(ln,60)
ln = INT(ln/60)
lnMin = MOD(ln,60)
ln = INT(ln/60)
lnHor = MOD(ln,24)
lnDia = INT(ln/24)
RETURN ALLTRIM(STR(lnDia))+ " Días, "+ ;
TRAN(lnHor, "@L 99")+ " Horas, "+ ;
TRAN(lnMin, "@L 99")+ " Minutos, "+ ;
TRAN(lnSeg, "@L 99")+ " Segundos"
ENDFUNC
*-----------------------------
Luis María Guayán
IF _Login(1)
MESSAGEBOX("Usuario autenticado OK.",64,"Login")
ELSE
*-- Usuario no válido
RETURN
ENDIF
* ----------------------------------------
* Function _Login( lnNivel, lnNivelSup)
* ----------------------------------------
* Funcion que muestra el form de LOGIN
* Parámetros:
* lnNivel [opc] - Nivel autorizado.
* si se omite permite cualquier
* usuario registrado
* ----------------------------------------
FUNCTION _Login( lnNivel, lnNivelSup)
LOCAL llRet
IF PARAMETERS() < 1
lnNivel = 0
ENDIF
IF PARAMETERS() < 2
lnNivelSup = 10
ENDIF
loForm = CREATEOBJECT("Login", lnNivel, lnNivelSup)
loForm.SHOW()
llRet = loForm.lRetorno
RELEASE loForm
loForm = .NULL.
RETURN llRet
ENDFUNC
* ----------------------------------------
*-- Class: Login
*-- Ingreso de password
* ----------------------------------------
DEFINE CLASS Login AS FORM
HEIGHT = 110
WIDTH = 220
DOCREATE = .T.
AUTOCENTER = .T.
BORDERSTYLE = 2
CAPTION = "Ingrese usuario y contraseña"
CONTROLBOX = .F.
CLOSABLE = .F.
MAXBUTTON = .F.
MINBUTTON = .F.
WINDOWTYPE = 1
*-- Nivel inferior de acceso
nNivelInf = -1
*-- Nivel superior de acceso
nNivelSup = -1
*-- Numero de intentos de validacion
nIntentos = -1
NAME = "Login"
*-- retorna .T. si el usuario y contraseña son correctos
lRetorno = .F.
ADD OBJECT cmdaceptar AS COMMANDBUTTON WITH ;
TOP = 72, LEFT = 48, HEIGHT = 25, WIDTH = 72, ;
FONTNAME = "MS Sans Serif", FONTSIZE = 8, ;
CAPTION = "Aceptar", DEFAULT = .T., ;
TABINDEX = 5, NAME = "cmdAceptar"
ADD OBJECT cmdcancelar AS COMMANDBUTTON WITH ;
TOP = 72, LEFT = 133, HEIGHT = 25, WIDTH = 72, ;
FONTNAME = "MS Sans Serif", ;
FONTSIZE = 8, CANCEL = .T., ;
CAPTION = "Cancelar", ;
TABINDEX = 6, NAME = "cmdCancelar"
ADD OBJECT lblusuario AS LABEL WITH ;
FONTNAME = "MS Sans Serif", FONTSIZE = 8, ;
ALIGNMENT = 1, BACKSTYLE = 0, CAPTION = "Usuario", ;
HEIGHT = 15, LEFT = 12, TOP = 16, WIDTH = 60, ;
TABINDEX = 2, NAME = "lblUsuario"
ADD OBJECT lblcontrasena AS LABEL WITH ;
FONTNAME = "MS Sans Serif", FONTSIZE = 8, ;
ALIGNMENT = 1, BACKSTYLE = 0, CAPTION = "Contraseña", ;
HEIGHT = 15, LEFT = 12, TOP = 40, WIDTH = 60, ;
TABINDEX = 4, NAME = "lblContrasena"
ADD OBJECT txtusuario AS TEXTBOX WITH ;
FONTNAME = "MS Sans Serif", FONTSIZE = 8, ;
FORMAT = "k", HEIGHT = 21, ;
LEFT = 85, MAXLENGTH = 15, ;
TABINDEX = 1, TOP = 12, ;
WIDTH = 120, NAME = "txtUsuario"
ADD OBJECT txtcontrasena AS TEXTBOX WITH ;
FONTNAME = "MS Sans Serif", FONTSIZE = 8, ;
FORMAT = "k", HEIGHT = 21, ;
LEFT = 85, MAXLENGTH = 15, ;
TABINDEX = 3, TOP = 36, ;
WIDTH = 120, PASSWORDCHAR = "*", ;
NAME = "txtContrasena"
PROCEDURE validausuario
LPARAMETERS tcUsuario, tcContrasena, tnNivelInf, tnNivelSup
LOCAL lcUser, lcPass, lnNivel
*--- pasa usuario a mayuscula
tcUsuario = ALLTRIM(UPPER(tcUsuario))
tcContrasena = ALLTRIM(tcContrasena)
*-----------------------------
*--- Aqui busco los datos del usuario
*--- en la tabla de Usuarios
*-----------------------------
lcUser = "LUIS"
lcPass = "siul"
lnNivel = 5
*-----------------------------
*--- valido usuario y contraseña
IF NOT (tcUsuario == lcUser ;
AND tcContrasena == lcPass)
*--- No existe usuario o Contraseña no válida
=MESSAGEBOX('Usuario o contraseña inválida',48,'Advertencia')
RETURN .F.
ENDI
IF NOT BETWEEN(lnNivel, tnNivelInf, tnNivelSup)
*--- Nivel no autorizado
=MESSAGEBOX('Usuario no autorizado para este módulo',48,'Advertencia')
RETURN .F.
ENDI
*--- Todo correcto
RETURN .T.
ENDPROC
PROCEDURE UNLOAD
RETURN THISFORM.lRetorno
ENDPROC
PROCEDURE INIT
LPARAMETERS tnNivelInf, tnNivelSup
IF PARAMETERS() < 0
tnNivelInf = 0
ENDIF
IF PARAMETERS() < 1
tnNivelSup = 10
ENDIF
THISFORM.nIntentos = 0
THISFORM.nNivelInf = tnNivelInf
THISFORM.nNivelSup = tnNivelSup
THISFORM.txtUsuario.SETFOCUS
THISFORM.cmdAceptar.DEFAULT = .T. && porque lo pierde en el SetFocus
ENDPROC
PROCEDURE cmdaceptar.CLICK
THISFORM.nIntentos=THISFORM.nIntentos+1
THISFORM.lRetorno=THISFORM.ValidaUsuario( ;
THISFORM.txtUsuario.VALUE, ;
THISFORM.txtContrasena.VALUE, ;
THISFORM.nNivelInf, THISFORM.nNivelSup)
IF THISFORM.lRetorno
THISFORM.HIDE
ELSE
IF THISFORM.nIntentos < 3
IF EMPTY(THISFORM.txtUsuario.VALUE)
THISFORM.txtUsuario.SETFOCUS
ELSE
THISFORM.txtContrasena.SETFOCUS
ENDI
ELSE
=MESSAGEBOX('Acceso denegado',16,'Advertencia')
THISFORM.HIDE
ENDI
ENDI
ENDPROC
PROCEDURE cmdcancelar.CLICK
THISFORM.lRetorno=.F.
THISFORM.HIDE
ENDPROC
ENDDEFINE
* ----------------------------------------
*-- EndDefine: Login
* ----------------------------------------
Luis María Guayán
Con estas dos funciones podemos saber si Word ® o Excel ® están instalados en la PC.
*----------------------------------------------------
* FUNCTION BuscaWord
* Busca si MS Word está instalado en la PC
*----------------------------------------------------
FUNCTION BuscaWord
LOCAL lcErrorAnt, loApp, CR
CR = CHR(13)
lcErrorAnt = ON("ERROR")
ON ERROR DO _MiError
loApp = CREATEOBJECT("Word.Application")
IF VARTYPE(loApp) = "O"
MESSAGEBOX("Nombre: " + loApp.NAME + CR + ;
"Versión: " + loApp.VERSION + CR + ;
"Build: " + TRANSFORM(loApp.BUILD), 64 )
RELEASE loApp
ELSE
MESSAGEBOX("Word no está instalado", 16)
ENDIF
ON ERROR &lcErrorAnt
RETURN
ENDFUNC
*----------------------------------------------------
* FUNCTION BuscaExcel
* Busca si MS Excel está instalado en la PC
*----------------------------------------------------
FUNCTION BuscaExcel
LOCAL lcErrorAnt, loApp, CR
CR = CHR(13)
lcErrorAnt = ON("ERROR")
ON ERROR DO _MiError
loApp = CREATEOBJECT("Excel.Application")
IF VARTYPE(loApp) = "O"
MESSAGEBOX("Nombre: " + loApp.NAME + CR + ;
"Versión: " + loApp.VERSION + CR + ;
"Build: " + TRANSFORM(loApp.BUILD), 64 )
RELEASE loApp
ELSE
MESSAGEBOX("Word no está instalado", 16)
ENDIF
ON ERROR &lcErrorAnt
RETURN
ENDFUNC
*----------------------------------------------------
* PROCEDURE _MiError
* Usado por BuscaWord y BuscaExcel
*----------------------------------------------------
PROCEDURE _MiError
RETURN
ENDPROC
*----------------------------------------------------
Luis María Guayán