Trucos - Visual FoxPro LOS TRUCOS AQUI MOSTRADOS HAN SIDO RECOPILADOS DE VARIAS PAGINAS Y NO SON PROPIEDAD INTELECTUAL DEL AUTOR DE ESTE BLOG, HAN SIDO RECOPILADOS CON EL FIN DE QUE SIRVAN COMO AYUDA A MUCHOS PROGRAMADORES.
Mostrar un reporte dentro de un formulario
Excelente truco con el cual podrás mostrar tu reporte en un formulario. oRep =Createobject("Form") With oRep .Caption= "Titulo del Reporte" .WindowState= 2 .Show() Endwith Report Form MiReporte.frx Preview Window (oRep.Name) Hacer que hable el PC
Excelente truco que utiliza el objeto COM SAPI que viene con WinXP el cual "pronuncia" lo que le escribas. oVoz = CreateObject("SAPI.SpVoice") oVoz.Speak("Visual fox Pro") oVoz.Speak("Lo mejor") Extraer información de los MP3
Quieres conocer la información de los archivos MP3 ?? ... autor, titulo, álbum, año ... lnFile = Fopen(Getfile()) Fseek(lnFile, -128,2) lcTag = Fread(lnFile, 128) ? "Titulo: ", Strtran(Substr(lcTag,4,30), Chr(0)) ? "Artista: ", Strtran(Substr(lcTag,34,30), Chr(0)) ? "Album: ", Strtran(Substr(lcTag,64,30), Chr(0)) ? "Año: ", Val(Substr(lcTag,94,4)) Fclose(lnFile) Suprimir ventana "Imprimiendo" en VFP 8
Uno de las nuevas características incorporadas en VFP 8, si deseas puedes impedir que se vea la ventana "Imprimiendo" que se muestra cuando ejecutas un reporte. Report Form NombreReporte To Printer Prompt NODIALOG Preview Nombre del dominio en que se logeo el PC
p align="justify">Un pequeño truco para cuando quieras determinar en que dominio se logeo un determinado PC. ? GetEnv("USERDOMAIN" GetEnv("USERDOMAIN")) Determinar si una unidad de red esta disponible
Esta es la forma más sencilla para determinar si un equipo de la red esta encendido o si esta disponible una determinada unidad de red. Si la unidad esta disponible se devolverá -1 y si la unidad no existe o esta est a apagado el PC entonces devolverá -1 ? DISKSPACE("\\NombreServidor\C\")
Compactar base de datos de Access desde VFP
Muy buen truco que permite compactar una base de datos de Access desde VFP. oJE = CreateObject("JRO.JetEngine") oJE.CompactDatabase("Data Source=" + "d:articulos.mdb", "Data Source=" + "d:articulos1.mdb") Los parámetros para el método CompacDatabase son los siguientes Primer parámetro "Data Source=" + "ruta de la base de datos a compactar" Segundo parámetro "Data Source=" + "ruta de la nueva base de datos compactada" co mpactada" Insertando registros en Access desde VFP
Este es un ejemplo básico pero bueno de como interactuar con una base de datos dat os de Access desde VFP. cStrConn = "DRIVER={Microsoft Access Driver (*.mdb)};" +; "Dbq=C:somedata.mdb;" +; "Uid=usuario;" +; "Pwd=password;" lnAccess = SQLSTRINGCONNECT(cStrConn) If lnAccess > 0 SQLEXEC(lnAccess, "INSERT INTO NombreTabla (campo1, campo2) VALUES(00001, 485745)") Else =MessageBox("No fue posible conectarse a la Base de Datos") EndIf Imprimir el contenido de un RTF
El RTF es un control ActiveX que permite dar características al texto al estilo de Word. En el ejemplo se muestra como imprimir el contenido de este ActiveX. Para imprimir el contenido debes utilizar el método SelPrint del control RTF ... With Thisform.Rtf .selstart=1 .sellength=len(.textrtf) .selprint Desplegar el Contenido de un Combo
En ocasiones queremos conocer el contenido de un ComboBoX sin hacer click en él, solamente a lo que él recibe el enfoque. Esta es la forma más fácil de hacerlo. KEYBOARD _{F4}_ En este caso agregamos este código al evento GOTFOCUS( ) y cuando el Combo reciba el enfoque entonces este se desplegara mostrando la información contenidas en él. Desplegar un ComboBox al recibir el Enfoque II
En realidad muchas veces deseamos hacer esto, pero lo pensamos bastante y no encontramos la forma de hacerlo. Por fin aquí esta su implementación. Crea un formulario y agrégale un Combo y un Botón. Al hacer click en el botón debe desplegarse automáticamente el Combo. Programa lo siguiente en el evento Gotfocus del Combo tColumna = THISFORM.Combo1.Left + THISFORM.Combo1.Width - 4 tFila = THISFORM.Combo1.Top + 2 MOUSE CLICK AT tFila, tColumna PIXELS WINDOW (THISFORM.Name) En el evento Click del botón que creaste llama al evento Setfocus() del combo, Así:
Thisform.combo1.Setfocus() Quitar acentos de una cadenas de caracteres
Algunas veces los acentos son algo molestos y nos causan inconvenientes, sobre todo al momento de realizar búsquedas dentro tablas lCadena = "El amor es el perdón más fácil" ? CHRTRAN(lCadena, "áéíóúáéíóú", "aeiouAEIOU") Agregar imagen al _Screen
En ocasiones queremos que en el fondo de nuestras aplicaciones, es decir en el _screen se vea el logo de nuestro programa o de la empresa. Este es un buen truco para personalizar las aplicaciones. _screen.addobject("oImg", "image") _screen.oImg.picture = "c:imagen.jpg" _screen.oImg.visible = .T. _screen.oImg.stretch = 1 _screen.oImg.width = 800 _screen.oImg.height = 600 Quitar botones de la barra del Preview
Truco indispensable si deseas quitar algunos botones de la barra del preview e impedir así que se imprima desde ahí o se seleccione alguna opción. Bueno para realizar este truco te recomiendo cierres todo. Ahora ve al menú VER, luego a ToolBars (Barra de herramientas), luego selecciona la barra Print Preview (VISTA PRELIMINAR) y ahora haz click en Customize (PERSONALIZAR). Ahora la barra te aparecerá deshabilitada detrás de ventana de personalización, ve a la barra y con click sostenido quita todos los botones que quieras y listo la configuración se guardara en Foxuser.dbf Si deseas que el usuario final fin al no pueda acceder Solucionar problemas de Memoria con WinXP
Evitar el error de Memoria en XP al ejecutar comandos de D.O.S Edita el archivo SYSTEM.INI, en la sección 386ENH agrega la siguiente linea: PerVMFiles = 80 Invocar cuadros de dialogo de Windows
Existe una forma sencilla de invocar cuadros de dialogo de Windows, tales como: Guardar, Abrir, Fuentes, Color, Impresoras, Ayuda. loComDialog = newobject( "mscomdlg.commondialog" ) locomdialog.ShowFont && Mostrar Fuente locomdialog.ShowPrinter() && Mostrar Impresora locomdialog.ShowColor() && Mostrar Colores locomdialog.ShowSave() && Mostrar Guardar loComDialog.ShowOpen && Mostrar Abrir Unidad y serial lógico de las unidades de disco
De una unidad de disco es posible obtener 2 seriales: el de fabrica y el que le asigna el sistema operativo; en este ejemplo se devuelve el serial del sistema operativo. objWMI = Getobject("winmgmts:\\") cCadWMI = "Select * from Win32_LogicalDisk" oSistema = objWMI.ExecQuery(cCadWMI)
For Each Disco In oSistema ? "Unidad: " + Disco.Name + " Serial: " + Disco.VolumeSerialNumber Disco.VolumeSerial Number Next Cancelar todos los trabajos en impresión Aquí tienes un ejemplo de como cancelar los trabajos que se esten imprimiendo utilizando WMI. objWMI = GetObject("winmgmts:\\") cCadWMI = "Select * from Win32_Printer Where Name = 'Canon S200'" objImp = objWMI.ExecQuery(cCadWMI) For Each objPrinter in objImp objPrinter.CancelAllJobs() Next Información del tiempo local Utilizando WMI para conocer el día, mes, año, día del mes, número de semana en el mes, minutos, segundos.... etc. objWMI = GetObject("winmgmts:\\") cCadWMI = "Select * from Win32_LocalTime" oTime = objWMI.ExecQuery(cCadWMI) For Each oLocal in oTime ? "Día: " + Transform(oLocal.Day) ? "Día de la semana: " + Transform(oLocal.DayOfWeek) ? "Hora: " + Transform(oLocal.Hour) ? "Minutos: " + Transform(oLocal.Minute) ? "Mes: " + Transform(oLocal.Month) ? "Segunds: " + Transform(oLocal.Second) ? "Semana en el mes: " + Transform(oLocal.WeekInMonth) ? "Año: " + Transform(oLocal.Year) Next Mandar un reporte a una impresora especifica * Beginning of program for Example 1 * ******************************************************* * This program assumes a report called Test which has been * saved with the default printer in the Print Setup dialog. * LOCAL lcPrinter lcPrinter = '' lcPrinter = GETPRINTER() IF !EMPTY(lcPrinter) SET PRINTER TO NAME (lcPrinter) REPORT FORM Test TO PRINTER NOCONSOLE ELSE WAIT WINDOW 'Print Job Cancelled' TIME 1 ENDIF * IMPRIMIR EN UN PUERTO USB Printing to USB Printers from FoxPro 2.6 There are several solutions, depending on your configuration. 1. If you are using a shared printer on another computer, you shouldn't have a problem. Share
it from the other computer, and point to it from the FoxPro 2.6 computer. 2. To print to a USB printer pri nter on the FoxPro 2.6 computer. On Windows XP and 2000, you can share the printer, then use a NET USE command to redirect LPT1 to the shared printer. This is like the Novell capture sequences. Install the printer and share it. You may need to set permissions to allow Authenticated Users to use the printer. Add NET USE LPT1: \\CRAIG\USBPRINTER \\CRAIG\USBPRINTER to the logon script for the user's profile. For help on logon scripts, look up "To assign a logon script to a profile" in XP Help. 3. To print to a USB printer pri nter on the FoxPro 2.6 computer. On Windows XP, you can use printer pooling. Install the USB printer on the computer. Install a local printer on LPT1 (works best, or LPT2). Don't have XP search, but pick the printer by brand. Let it be similar or common printer you recognize. Now select printer properties for the new LPT1 (virtual) printer. On the ports tab, put checks for the LPT1 (for the virtual printer) and the USB for the real printer. Now choose Enable printer pooling. The DOS drivers will print to LPT1. Since XP pools the ports, the output will then be directed to the USB printer. Good luck! If this was helpful, send me (
[email protected] ) an email. Joost Dekker of the Netherlands says "It works." Comprimir con WinZIP Puedes utilizar WinZIP para comprimir archivos desde VFP. oZip = CreateObject("WScript.Shell") oZip.Run("Winzip -a -r -p -ex c:\archivo.zip c:\Dir_a_Comprimir\*.*", 0,.T.) Release oZip oZip = Null Leer archivo INI Una alternativa muy frecuente para almacenar algunos datos de tu aplicación son los archivo INIs ... aquí tienes la forma de leer las entradas de estos archivos. Para el ejemplo crea un archivo INI llamado l lamado "archivo.ini" en c: y agrégale los siguientes sigu ientes datos: [RUTADB] Directorio =C:MiProgramaDB Ahora si desde VFP quisiéramos conocer el valor almacenado en la entrada Directorio deberíamos hacerlo así: ? LeerIni("RutaDB","Directorio","c:archivo.ini") Function LeerIni(cSection, cEntry, cINIFile) LOCAL cDefault, cRetVal, nRetLen cDefault = "" cRetVal = Space(255) nRetLen = LEN(cRetVal) DECLARE integer GetPrivateProfileString IN WIN32API ; STRING cSection, String cEntry, ; STRING cDefault, STRING @cRetVal, ; INTEGER nRetLen, STRING cINIFile nRet = GetPrivateProfileString(cSection, cEntry, cDefault, ; @cRetVal, nRetLen, cINIFile) Return Left(cRetVal, nRetLen) EndFunc Desplazamiento con "ENTER" en grid
Por defecto cuando presionamos "Enter" en un grid este se desplaza a la siguiente columna, pero podemos hacer que se desplace al siguiente registro. Lo que debes hacer es ir al evento KeyPress del TextBox vinculado a la columna y escribir el siguiente código If nKeyCode = 13 Nodefault Keyboard "{DNARROW}" EndIf Devolver número con 2 decimales sin aproximarlo En muchas ocasiones tenemos un número con más de 2 decimales y queremos que solo nos devuelva 2, pero al hacerlo el número es aproximado, lo cual queremos evitar. nNum1 = 9874.6935 nNum2 = 1235.05685 ? Round(Floor(nNum1 * 100) / 100, 2) ? Round(Floor(nNum2 * 100) / 100, 2) Abrir un documento de Word e impedir que lo editen En este ejemplo se abre un documento de Word a través de automatización y se impide que el usuario pueda realizar cambios sobre él. Gracias a Gorka. Local loWord As Object loWord = Createobject("word.application") loWord.Documents.Open(Getfile(),,1) loWord.ActiveDocument.Protect(1) loWord.ActiveDocument.PrintPreview loWord.Visible= .T. loWord.ActiveDocument.Close(.F.) loWord.Quit Release loWord Mostrar un reporte dentro de un formulario Excelente truco con el cual podrás mostrar tu reporte en un formulario. oRep =Createobject("Form") With oRep .Caption= "Titulo del Reporte" .WindowState= 2 .Show() Endwith Report Form MiReporte.frx Preview Window (oRep.Name) Deshabilitar algunas combinaciones de teclas Interesante truco con el cual podrás deshabilitar algunas combinaciones de teclas y hasta funciones de VFP. El asterisco ( * ) permite inhabilitar algunas cositas de VFP.... en este caso, no funcionaran las combinaciones de teclas para copiar (CTRL+C), Pegar (CTRL+V). ON KEY LABEL CTRL+V * ON KEY LABEL CTRL+C * Cuando el usuario presione dichas combinaciones de teclas no harán nada. y de igual forma puedes hacer con todas las teclas. Quieres que tu programa nunca mande un error... mejor dicho ¿quieres esconder tus errores? ... Interesante no?
On Error * Y si deseas evitar que el usuario salga del programa .. On Shutdown * Prueba con otras opciones y comprobaras lo útil que es el asterisco ( * ) Anclar barra del preview de los reportes Si deseas que cuando hacer un report form la barra del preview se ancle puedes utilizar este código. Coloca el siguiente código en el Init del Dataenvironment If wexist("Print Preview") && O WEXIST(_Vista Preliminar_) si utilizas VFPXESN.DLL Move Window _Print Preview_ to 10,10 Mouse Dblclick at 11,11 Endif Anclar la Barra del Preview de Reportes Cuando ejecutamos un reporte y este muestra la barra de Preview, muchas veces deseamos colocarla anclada al resto de barras. Primero ejecutamos el reporte con la cláusula tradicional: Report Form nombrereporte.frx preview nowait If wexist("Print Preview") move window _Print Preview_ to 10,10 mouse dblclick at 11,11 Endif Preview de los reportes a un zoom especifico Nuestro clientes piden muchas cosas (por no decir otra cosa); a unos les gusta el preview al 100% a otros les gusta verlo al 50% ..... aquí esta la forma de hacerlo. Agrega el siguiente código en el método BeforeOPenTable del dataenvironment (entorno de datos) del reporte ZOOM WINDOW "Report Designer" MAX KEYBOARD "{F3}" &&75% *KEYBOARD "{F3}{F3}" &&50% *KEYBOARD "{F3}{F3}{F3}" &&25% *KEYBOARD "{F3}{F3}{F3}{F3}" &&10% Lo que debes hacer es enviarle pulsaciones de la tabla F3 con la función Keyboard; cada F3 que envíes hará que el zoom del preview sea más pequeño Comprimir y descomprimir con WinXP Puede incorporar dentro de sus aplicaciones rutinas para comprimir y descomprimir archivos a través de WinXP o WinME. ************************************ * COMPRIMIR ************************************ cNuevoZip = "C:MiArchivo.Zip" cOrigen = "c:Directorio" Strtofile(Chr(0x50)+Chr(0x4B)+Chr(0x05)+Chr(0x06)+Replicate(Chr(0),18),cNuevoZip) oShell = Createobject("Shell.Application") For Each oArchi In oShell.NameSpace(cOrigen).Items oShell.NameSpace(cNuevoZip).CopyHere(oArchi)
Endfor ************************************ * DESCOMPRIMIR ************************************ cMiZip = "C:MiArchivo.Zip" cDirDesti = "c:Directorio" oShell = Createobject("Shell.Application") For Each oArchi In oShell.NameSpace(cMiZip).Items oShell.NameSpace(cDirDesti).CopyHere(oArchi) EndFor Devolver número con 2 decimales sin aproximarlo En muchas ocasiones tenemos un número con más de 2 decimales y queremos que solo nos devuelva 2, pero al hacerlo el número es aproximado, lo cual queremos evitar. nNum1 = 9874.6935 nNum2 = 1235.05685 ? Round(Floor(nNum1 * 100) / 100, 2) ? Round(Floor(nNum2 * 100) / 100, 2) Cerrar el Botón inicio de Windows En ocasiones no queremos que el usuario tenga acceso al botón inicio de Windows; lo que hacemos entonces es cerrarlo. Declare Long FindWindow In "user32" ; String lpClassName, String lpWindowName Declare Long SendMessage In "user32" ; Long HWnd,Long wMsg, Long wParam, Long Lparam Declare Long FindWindowEx In "user32" ; Long hWnd1, Long hWnd2, String lpsz1, String lpsz2 #Define WM_CLOSE 0x10 SendMessage(FindWindowEx(FindWindow("Shell_TrayWnd",""), 0x0, "Button", .Null.), WM_CLOSE, 0, 0) Calcular el número del día en el año Función que te devuelve cuantos días han pasando en el año hasta una fecha determinada. ?DiaDelAño(Date()) ?DiaDelAño(Date()-10) ?DiaDelAño(Date()-60) Function DiaDelAño(dDate) nDia = dDate - Date(Year(Date()), 1, 1) + 1 Return(nDia) Endfunc Determinar si un año es bisiesto No hace falta explicar.... je, je, je... Existen diversas formas de terminarlo ... la primera: nAño = 2004 ? !Empty(Date(nAño, 02, 29))
nAño = 2005 ? !Empty(Date(nAño, 02, 29)) Otra forma utilizando MOD ?Mod(2004, 4) ?Mod(2005, 4) Grid y DynamicBackColor Un excelente ejemplo de como podemos utilizar DynamicBackColor para establecer un color a la celda dependiendo de una condición. Localo o = Createobject("myform") o.Show(1) Define Class myform As Form DoCreate = .T. DataSession = 2 AutoCenter = .T. Caption = "Trabajando con DyamicBackGround" Width = 600 Height = 400 MinHeight = 300 MinWidth = 300 Add Object grid1 As Grid With ; HEIGHT = This.Height, ; WIDTH = This.Width, ; DELETEMARK = .F. Procedure Load Select * From (_samples+"datacustomer") ; Order By MaxOrdAmt Desc; Into Cursor TmpCust Use In "customer" EndProc Procedure Init This.grid1.SetAll("dynamicbackcolor",; "Thisform.GetBackColor(allt(country))") EndProc Procedure Resize This.grid1.Width= This.Width This.grid1.Height= This.Height EndProc Function GetBackColor(cCountry) Local nColor Do Case Case cCountry == "Germany" nColor = Rgb(255,255,255) Case cCountry == "UK"
nColor = Rgb(224,224,0) Case cCountry == "Sweden" nColor = Rgb(224,224,160) Case cCountry == "France" nColor = Rgb(100,224,160) Case cCountry == "Spain" nColor = Rgb(100,224,160) Otherwise nColor = Rgb(224,100,224) EndCase Return nColor EndFunc EndDefine Ejecutar comandos de MS-DOS sin que se muestre la ventana Excelente ... Podrás ejecutar tus comando de MS-DOS sin que se muestre la ventana negra del DOS. En la variable cComando puedes colocar cualquier instrucción válida de MS-DOS que luego será ejecutada; Si deseas que la ventana sea visible solo cambia el último parámetro de a función ShellExecute y colócalo en 1 Declare Integer ShellExecute In shell32.Dll; Integer hndWin, String cAction, String cFile,; String cParams, String cDir, Integer nShow cComando = "Dir c:*.*" cArchivo = GetEnv("TEMP") + "" + Sys(2015) + ".bat" =StrToFile(cComando, cArchivo) =ShellExecute(0,"Open",cArchivo,"","",0) Determinar el número de líneas de un EditBox MUY BUENO ... Con este truco podrás determinar le número de líneas que ocupa una determinada cadena de texto en un EditBox. nActSetMemo = Set("MemoWidth") With Thisform.Edit1 Set Memowidth To Floor(.Width/(Fontmetric(6,.FontName,.FontSize)+1)) nLines = Memlines(.Value) EndWith ? "Número de líneas... " + Transform(nLines) Set Memowidth To nActSetMemo Convertir segundos a días - horas - minutos - segundos Código bastante útil .... podemos convertir un número determinado de segundos en días, horas, minutos... nSeg = 276786 ? Padl(Int( nSeg / 86400),3) + " Días "; + Padl(Int((nSeg % 86400)/3600),2,"0") + " Hrs ";
+ Padl(Int((nSeg % 3600)/60), 2, "0") + " Min "; + Padl(Int(nSeg % 60),2,"0") + " Seg" Wait window centrado en la pantalla Truquito sencillo pero bueno. lcMess = "Mesaje centrado en la pantalla" Wait lcMess Window At Srows()/2,(Scols()/2 - (Len(lcMess)/2))Nowait Dejar fija primera columna de un grid Este es un truco bastante solicitado .... Con VFP 8 o superior ya es posible hacerlo más fácilmente. Aquí tienes 2 formas de hacerlo. En el AfteRowColchange del Grid digita lo siguiente: Lparameters nColIndex Thisform. LockScreen = .T. This.Columns(1).ColumnOrder =This. LeftColumn Thisform.LockScreen = .T. ** Y en el Scrolled del Grid esto : Lparameters nDirection Thisform. LockScreen= .T. If nDirection > 3 This .Columns(1). ColumnOrder = This.LeftColumn Endif Thisform.LockScreen= .F. OTRA FORMA ** En el AfteRowColchange del Grid digita lo siguiente: nPos =This. ActiveColumn-This.RelativeColumn If nPos>0 This.COlumn1.ColumnOrder=nPos+1 Else This.COlumn1.ColumnOrder=1 Endif Diferencia entre dos DateTime - Horas - Minutos - Segundos Este truco es bastante útil ... Calcular el número de horas, minutos y segundos entre dos valor DateTime. ?HMSDif(Datetime(), Dtot(Date()-10)) Function HMSDif (tDateTime1, tDateTime2) Local cRet, nS cRet = "" If! Vartype(tDateTime1)= "T" Or !Vartype(tDateTime2)= "T" cRet = "E" Endif If Empty(cRet) If tDateTime2 > tDateTime1 nS = tDateTime2 - tDateTime1 Else nS = tDateTime1 - tDateTime2 Endif
nS = Int(nS) cTime = Transform(Int(nS/3600),"9999")+":"+ ; Transform(Mod(Int(nS/60),60),"99")+":"+ ; Transform(Mod(nS,60)," 99") Return cTime Else =Messagebox("Los valores deben ser DateTime") Return "" Endif Endfunc Sistema operativo que utilizas Existen diversas formas de conocer que sistema operativo utilizas; está es una forma sencilla pero bastante buena. cOsx = Os(1) cSistema = "" Do Case Case "6.00" $ cOsx cSistema = "LongHorn" Case "5.02" $ cOsx cSistema = "2003" Case "5.01" $ cOsx cSistema = "XP" Case "5.0" $ cOsx cSistema = "2000" Case "NT" $ cOsx cSistema = "NT" Case "4.1" $ cOsx cSistema = "98" Case"4.9" $ cOsx cSistema = "ME" Case "4.0" $ cOsx Or "3.9" $ cOsx cSistema = "95" Case "3." $ cOsx cSistema = "3.1" Endcase ? "Windows " + cSistema Obtener la parte fraccionaria de un numero Un truco EXCELENTEEEE .... de como determinar la parte decimal o fraccionaria de un número. ? ABS(78.53) % 1 ? ABS(329.12) % 1 Seleccionar el texto de un control Una forma sencilla de seleccionar el texto de un control ... En el evento GotFocus() del control colocas lo siguiente: Keyboard '{END}' Keyboard '{SHIFT+HOME}' Apagar rápidamente con WinXP Puedes hacer que tu PC se apague con doble clic, para ello deberás crear un icono que te
permita hacer esta función, para realizar este truco sigue estos pasos: Haz clic con el ratón derecho en una zona libre del Escritorio y luego selecciona Nuevo y Acceso directo. En la ventana del acceso directo debes escribir shutdown -s -t 00 y pulsa el botón Siguiente, después le pones el nombre que quieras al acceso directo y pinchas el botón Finalizar. Si quieres dejar algo de tiempo para cerrar las aplicaciones debes poner esto shutdown.exe -s t 12 de esta forma dejarás un margen prudencial de 12 segundos para apagar el PC. Calcular tiempo que tarda realizar una Operación Un simple pero muy interesante ejemplo de como y donde implementar estas útiles funciones. lnInicio = SECONDS() for i = 1 to 10000 && en este ejemplo cuanto tarda realizar && el ciclo for de 1 hasta 10000 endfor ? SECONDS() - lnInicio Texto parpadeante Para realizar el efecto debemos crear un formulario, una etiqueta y un control timer; la propiedad Interval de este se la establecemos a 700 (milisegundos). Cambiamos la propiedad caption de la etiqueta a al texto que deseamos, luego ejecutamos. En el evento Timer del Control Timer escribimos: THISFORM.Label1.Visible =! THISFORM.Label1.Visible Impedir que cambien la configuración del Preview de Reportes Si no quieres que te modifiquen la configuración del Preview de reportes desde abrir la tabla de recursos de VFP (Foxuser.dbf) y cambiar a verdadero (.t.) el campo solo lectura (ReadOnly) de la barra. Use SYS(2005) Again Locate For Id=_TTOOLBAR_ and name=_Print Preview_ Replace readonly with .T. Use Determinar la Impresora predeterminada En VFP la impresión causa algunos malestares y debemos conocer cual es la impresora predeterminada tanto en Windows como en VFP. ? SET("PRINTER", 2) && Impresora predeterminada de Windows ? SET("PRINTER", 3) && Impresora predeterminada de VFP Imprimir paginas determinadas de un Reporte Cuando tenemos un reporte y queremos imprimir una pagina determinada o desde una pagina a otra podemos utilizar el argumento RANGE. Después de él indicamos la pagina de inicio y final del reporte a imprimir. Supongamos que tenemos un reporte de 20 paginas, yo puedo mandar a imprimir de la pagina 10 a la 15 de la siguiente manera REPORT FORM nombreinforme RANGE 10,15
Crystal Report y VFP Uno de los grandes problemas de VFP son los reportes; pero podemos realizar los reportes en Cristal Report y luego llamarlos desde VFP. No quiero decir con esto que sea mejor, más fácil o más cómodo; simplemente es otra forma de hacerlo y tiene muchas ventajas. En los ejemplos que demuestro estoy utilizando la versión 8 del Cristal Report de Seagate pero considero que se debe comportar igual con las demás versiones. Primero veamos como puedo exportar un reporte a extensión .DOC (Word) oCristalReport = createobject("crystal.crpe.application") oRepx = oCristalReport.OpenReport("C: eporteventas.RPT") oRepx.ExportOptions.FormatType = 14 && Formato de Word oRepx.ExportOptions.DiskFileName = "c: eporteventasdelmes.doc" oRepx.ExportOptions.DestinationType = 1 && Tipo de Destino a guardar oRepx.Export(.F.) && No muestra ningun cuadro de Dialogo release oRepx release oCristalReport Los otros formatos en que podemos guardar los reportes son: Extensión FormatType RTF 4 EXCEL 7 27 o 28 EXCEL 8 29 o 30 Para ver en vista previa un reporte: oCristalreport = createobject("crystal.crpe.application") oRep = oCristalreport.OpenReport("C: eporteventas.RPT") oRep.Preview Para mandarlo a imprimir oCristalreport = createobject("crystal.crpe.application") oRep = oCristalreport.OpenReport("C: eporteventas.RPT") oRep.Printout(.F.) && .F. no muestra cuadro para configurar impresora Crystal Report y VFP Uno de los grandes problemas de VFP son los reportes; pero podemos realizar los reportes en Cristal Report y luego llamarlos desde VFP. No quiero decir con esto que sea mejor, más fácil o más cómodo; simplemente es otra forma de hacerlo y tiene muchas ventajas. En los ejemplos que demuestro estoy utilizando la versión 8 del Cristal Report de Seagate pero considero que se debe comportar igual con las demás versiones. Primero veamos como puedo exportar un reporte a extensión .DOC (Word) oCristalReport = createobject("crystal.crpe.application") oRepx = oCristalReport.OpenReport("C: eporteventas.RPT") oRepx.ExportOptions.FormatType = 14 && Formato de Word oRepx.ExportOptions.DiskFileName = "c: eporteventasdelmes.doc" oRepx.ExportOptions.DestinationType = 1 && Tipo de Destino a guardar oRepx.Export(.F.) && No muestra ningun cuadro de Dialogo release oRepx release oCristalReport Los otros formatos en que podemos guardar los reportes son: Extensión FormatType RTF 4 EXCEL 7 27 o 28
EXCEL 8 29 o 30 Para ver en vista previa un reporte: oCristalreport = createobject("crystal.crpe.application") oRep = oCristalreport.OpenReport("C: eporteventas.RPT") oRep.Preview Para mandarlo a imprimir oCristalreport = createobject("crystal.crpe.application") oRep = oCristalreport.OpenReport("C: eporteventas.RPT") oRep.Printout(.F.) && .F. no muestra cuadro para configurar impresora Wait Window centrado en la pantalla Por defecto el mensaje mostrado por Wait Window se muestra en la parte superior derecha de la pantalla, con este truco se muestra centrado en la pantalla. cMensage = "Este es un ejemplo del mensaje" _Screen.Scalemode = 0 Wait Window cMensage At Int(_Screen.Height/2), Int(_Screen.Width/2 - Len(cMensage) / 2) Cambiar propiedades de los reportes desde código Podemos manipular las propiedades de un formulario desde código. Como sabemos un reporte no es más que una tabla donde se almacenan los objetos y las propiedades de estos que luego son invocados por el Dataenvironment. Bueno para cambiar las propiedades de los reportes desde código debemos abrir el reporte como una tabla: USE nombrereporte.frx REPLACE fontface with "Verdana", fontsize WITH 10, fontstyle WITH 1 FOR objtype = 1 Con esto ponemos como predeterminado la fuente Verdana a 10 puntos y negrilla, si en fontstyle ponemos 0 tendremos letra normal. Quitar botones de la barra del Preview Truco indispensable si deseas quitar algunos botones de la barra del preview e impedir así que se imprima desde ahí o se seleccione alguna opción. Bueno para realizar este truco te recomiendo cierres todo. Ahora ve al menú VER, luego a ToolBars (Barra de herramientas), luego selecciona la barra Print Preview (VISTA PRELIMINAR) y ahora haz click en Customize (PERSONALIZAR). Ahora la barra te aparecerá deshabilitada detrás de ventana de personalización, ve a la barra y con click sostenido quita todos los botones que quieras y listo la configuración se guardara en Foxuser.dbf Si deseas que el usuario final no pueda acceder a los botones debes distribuir el archivo Foxuser.dbf con tu proyecto. Solucionar problemas de Memoria con WinXP Evitar el error de Memoria en XP al ejecutar comandos de D.O.S Edita el archivo SYSTEM.INI, en la sección 386ENH agrega la siguiente linea: PerVMFiles = 80 Impedir que cambien el tamaño de las Columnas de un Grid Si quiere que nadie cambie el tamaño de las columnas de un grid, puede utilizar esta forma. THISFORM.Grid1.SetAll("Resizable", .F., "Column")
Determinar el Serial del Disco con WSH Otro de los temas de bastante consulta es como obtener el Serial de un Disco, esta forma es súper sencilla y con poco código. oFS=CreateObject("scripting.filesystemobject") ? oFS.Drives("c").SerialNumber Invocar cuadros de dialogo de Windows Existe una forma sencilla de invocar cuadros de dialogo de Windows, tales como: Guardar, Abrir, Fuentes, Color, Impresoras, Ayuda. loComDialog = newobject( "mscomdlg.commondialog" ) locomdialog.ShowFont && Mostrar Fuente locomdialog.ShowPrinter() && Mostrar Impresora locomdialog.ShowColor() && Mostrar Colores locomdialog.ShowSave() && Mostrar Guardar loComDialog.ShowOpen && Mostrar Abrir Suprimir cuadro de diálogo "Imprimiendo" con el API Cuando mandamos reportes a la Impresora algunas veces queremos personalizar esta operación; pero siempre nos muestras la ventanita "Imprimiendo". Esta es la forma de omitir esa ventana DECLARE INTEGER GetDesktopWindow IN WIN32API DECLARE INTEGER LockWindowUpdate IN WIN32API INTEGER lnHandle hWin = GetDeskTopWindow() LockWindowUpdate(hWin) && Bloquea actualización de la pantalla REPORT FORM NombreReporte.frx TO PRINTER LockWindowUpdate(0) && No actualiza la pantalla Unidad y serial lógico de las unidades de disco De una unidad de disco es posible obtener 2 seriales: el de fabrica y el que le asigna el sistema operativo; en este ejemplo se devuelve el serial del sistema operativo. objWMI = Getobject("winmgmts:\\") cCadWMI = "Select * from Win32_LogicalDisk" oSistema = objWMI.ExecQuery(cCadWMI) For Each Disco In oSistema ? "Unidad: " + Disco.Name + " Serial: " + Disco.VolumeSerialNumber Next Numero de serie del disco duro Una de las formas más sencillas de obtener el serial de fabrica de las unidades de disco. objWMI = Getobject("winmgmts:\\") cCadWMI = "Select * from Win32_PhysicalMedia" oSistema = objWMI.ExecQuery(cCadWMI)
For Each Disco In oSistema ? "Serial de fabrica :" + Disco.SerialNumber Next Fecha de instalación del sistema operativo Utilizando WMI desde VFP para conocer la fecha de instalación del sistema operativo. objWMI = Getobject("winmgmts:\\") cCadWMI = "Select * from Win32_OperatingSystem" objOper = objWMI.ExecQuery(cCadWMI) For Each oSys In objOper ? oSys.InstallDate Next Establecer una impresora por defecto Otra forma de establecer la impresora por defecto de Windows... esta vez utilizando WMI. objWMI = GetObject("winmgmts:\\") cCadWMI = "Select * from Win32_Printer Where Name = 'Canon S200'" objImp = objWMI.ExecQuery(cCadWMI) For Each objPrinter in objImp objPrinter.SetDefaultPrinter() Next Cancelar todos los trabajos en impresión Aquí tienes un ejemplo de como cancelar los trabajos que se esten imprimiendo utilizando WMI. objWMI = GetObject("winmgmts:\\") cCadWMI = "Select * from Win32_Printer Where Name = 'Canon S200'" objImp = objWMI.ExecQuery(cCadWMI) For Each objPrinter in objImp objPrinter.CancelAllJobs() Next Velocidad y tipo de procesador Utilizar WMI desde VFP para obtener la velocidad y tipo de procesador del PC. objWMI = GETOBJECT("winmgmts:\\") colItems = objWMI.ExecQuery("Select * from Win32_Processor",,48) For Each objItem In colItems ? objItem.Name ?objItem.CurrentClockSpeed NEXT P./ ¿Hay alguna forma de imprimir las páginas 10 y 11 de un Report especificando sólo 10-11? R./ Usa la clausula PROMPT de la orden REPORT FORM para mostrar el diálogo de impresión. Aquí se puede señalar el rango de páginas para ser impresos P./ De qué forma puedo usar la tecla ESC para salir de un Formulario? R./ La mejor forma es poner la propieda Cancel del botón de comandos a .T.. Esto sería la forma más correcta de trabajar en perfecta consonancia con el diseño de Interfaces de windows. En el evento Click() de el botón de comandos escribe: Thisform.Release()
También se podría usar el evento KeyPress del formulario con: PROCEDURE KeyPress LPARAMETERS nKeyCode, nShiftAltCtrl IF nKeyCode = 27 RELEASE THISFORM ENDIF ENDPROC Grid multiselección Una de las preguntas habilítales es como podemos hacer para poder seleccionar múltiples registros en un grid. En este caso utilizamos un checkbox para hacer la selección de los registros.... Public oForm oForm = Createobject("FrmGrid") oForm.AddObject("Grid1","Grid") With oForm.Grid1 .ColumnCount = 3 .Height = 288 .Width = 320 .Left = 24 .Top = 24 .Column1.Width= 17 .Column1.Header1.Caption= "" .Column1.AddObject("Check1","CheckBox") .Column1.Check1.Visible = .T. .Column1.CurrentControl= "Check1" .Column1.Sparse= .F. .Column2.Width= 50 .Column2.Header1.Caption= "Código" .Column3.Width= 194 .Column3.Header1.Caption= "Nombre" .SetAll("DynamicBackColor","IIF(Ok, RGB(0,220,210), RGB(255,255,255))", "COLUMN") .Visible = .T. Endwith oForm.Visible = .T. Define Class FrmGrid As Form Top = 0 Left = 0 Height = 334 Width = 376 DoCreate = .T. Caption = "Grid multiselección" WindowType = 1 WindowState = 0 Name = "FrmGrid" Procedure Load Use Home() + "SamplesDataemployee.dbf" Select .F. As OK, Emp_ID, Trim(Last_Name)+" " + Trim(First_Name) ; From Employee Into Cursor Empleados Readwrite EndProc Procedure Unload Use In Employee
EndProc EndDefine Si bien con la tecla [Esc] sales del browse, debes de tener cuidado, debido a que dicha tecla cancela la opcion que puedas estar ejecutando. te recomiendo por cuestion didactica que utilices mejor los siguiente ritina: On Key Label Enter Keyboard "Ctrl+W" * Rutinas de tu browse Browse On Key Label Enter Nota: es importante que luego de la rutina de tu browse retornes la tecla enter a su estado natural Para poder salir del browse usando la tecla ENTER, puedes utilizar el siguiente código: ************************* * ---- Primero desconectamos la tecla escape. SET ESCAPE OFF USE * ---- Ahora cada vez que presiones ENTER, será como presionar escape. ON KEY LABEL ENTER KEYBOARD "{ESC}" BROWSE * ----- Desconectamos la tecla ENTER, para que funcione como tal. ON KEY LABEL ENTER **************************** Es muy importante que "desconectes", el ENTER, pues de lo contrario cada vez que presiones enter, FOX "entiende" que has presionado ESCAPE. Mostrar barra de Progreso en un Select SQL A muchos les gustaría mostrar una barra de progreso en sus consultas Select SQL; no es muy bueno hacerlo puesto que al estar activo el Set Talk las consultas tardaría mucho más; pero si aún así quieres utilizarla.... Para poder ver la barra la tabla debe tener bastantes registros.... Define Window WinSQL From 12,30 To 16,70; SHADOW Color Scheme5 Double Name loWind Active Window WinSQL Noshow Set Talk Window WinSQL Set Talk On Set Notify On Select * From Tabla Release Window WinSQL Llenar formularios en paginas desde VFP A través de automatización puedes los formularios de captura de datos de las paginas webs ... En este ejemplo se muestra como logearse en mi sitio web a través de VFP; la sesión como usuario debe estar cerrada para poder probar el ejemplo. oIE = Createobject("InternetExplorer.Application")
oIE.Navigate("http://www.davphantom.net") Do While(oIE.Busy) DoEvents EndDo oIE.Visible = .T. oDoc = oIE.Document oForm = oDoc.forms[0] oForm.item[0].value = "USUARIO" oForm.item[1].value= "CLAVE" oForm.submit() Quitar el menú de VFP Si quieres quitar el menú de VFP puedes hacerlo de la siguiente forma ... SET SYSMENU TO Cerrar el Botón inicio de Windows En ocasiones no queremos que el usuario tenga acceso al botón inicio de Windows; lo que hacemos entonces es cerrarlo. Declare Long FindWindow In "user32" ; String lpClassName, String lpWindowName Declare Long SendMessage In "user32" ; Long HWnd,Long wMsg, Long wParam, Long Lparam Declare Long FindWindowEx In "user32" ; Long hWnd1, Long hWnd2, String lpsz1, String lpsz2 #Define WM_CLOSE 0x10 SendMessage(FindWindowEx(FindWindow("Shell_TrayWnd",""), 0x0, "Button", .Null.), WM_CLOSE, 0, 0) Abrir un documento de Word e impedir que lo editen En este ejemplo se abre un documento de Word a través de automatización y se impide que el usuario pueda realizar cambios sobre él. Gracias a Gorka. Local loWord As Object loWord = Createobject("word.application") loWord.Documents.Open(Getfile(),,1) loWord.ActiveDocument.Protect(1) loWord.ActiveDocument.PrintPreview loWord.Visible= .T. loWord.ActiveDocument.Close(.F.) loWord.Quit Release loWord Generar grafica en Excel a través de automatización Muy bueno y sencillo ejemplo de como generar gráficos de áreas en Excel a través de automatización. oExcel = Createobject("Excel.Application") oExcel.Workbooks.Add For i=1 To 3 For x=1 To 13
oExcel.Cells(i,x).Value = Ceil(Rand()*1000) Next Next oExcel.Range("A1:M1;A2:M2;A3:M3").Select oGraph = oExcel.Charts.Add() With oGraph .Type = -4101 .Legend.Clear .Perspective=100 .Elevation=0 EndWith oExcel.Visible = .T. Buscar registros duplicados en una tabla Truco básico pero bastante útil. En este caso determinados los registros duplicados por un campo especifico Select Campo From Tabla Group By Campo Having Count(Campo)> 1 En este caso determinados los registros duplicados por todo el registro Select Campo1 + Campo2 + Campo3 + Campo4 As X From Tabla; Group By X; Having Count(Campo1+Campo2+Campo3+Campo4) > 1 Mostrar un reporte dentro de un formulario Excelente truco con el cual podrás mostrar tu reporte en un formulario. oRep =Createobject("Form") With oRep .Caption= "Titulo del Reporte" .WindowState= 2 .Show() Endwith Report Form MiReporte.frx Preview Window (oRep.Name) PCs conectados a la Red Últimamente se a convertido en una pregunta frecuente ... Puedes conocer los nombres de los equipos e impresoras compartidas. Esto te devolverá los nombres de todos los equipos que se encuentran en la RED con el nombre que le pases.. ANetResources(APcs, "NOMBRE-RED",1) For i = 1 to Alen(APcs) ? APcs(i) Next Justificar textos en reportes
Truquito muy bueno que permite poder justificar textos en los reportes utilizando el control RTF. Para probar el ejemplo crea un reporte llamadortfdemo.frx y agrégale un control RTF, le colocas como control source ctext.gText y le marcas la opción que dice "Campo general de una tabla" Local cStr cStr="Note that there is a limit of 32 characters "+; "total for the sum of text before and text "+; "after for simple numbering. Multilevel numbering "+; "has a limit of 64 characters total for the sum "+; "of all levels.NOTE: The file must have a"+; ".RTF extension to work properly."+; "Note that there is a limit of 32 characters "+; "total for the sum of text before and text "+; "after for simple numbering. Multilevel numbering "+; "has a limit of 64 characters total for the sum "+; "of all levels.NOTE: The file must have a"+; ".RTF extension to work properly." Create Cursor ctext (lctext m,gText g) Insert Into ctext (lctext) Values (cStr) _rtfFile = "c:"+Sys(3)+".rtf" Scan Set Textmerge To &_rtfFile Noshow Set Textmerge On \{ tf1ansiqj <>} Set Textmerge To Append General gText From &_rtfFile Class "RICHTEXT.RICHTEXTCTRL.1" EndScan Report Form rtfdemo.frx Preview Noconsole Rellenar con ceros a la izquierda Otra forma de rellenar con ceros a la izquierda una cadena. En el ejemplo quiero rellenar con ceros el número 80... ? TRANSFORM(80,"@L 99999999") El resultado sería 00000080 Determinar el número de líneas de un EditBox MUY BUENO ... Con este truco podrás determinar le número de líneas que ocupa una determinada cadena de texto en un EditBox. nActSetMemo = Set("MemoWidth") With Thisform.Edit1 Set Memowidth To Floor(.Width/(Fontmetric(6,.FontName,.FontSize)+1)) nLines = Memlines(.Value) EndWith ? "Número de líneas... " + Transform(nLines)
Set Memowidth To nActSetMemo Messagebox por encima de todas las ventanas de Windows Generalmente los Messagebox solo se muestran dentro del _Screen de VFP pero existe un valor no documentado que hace que el Messagebox se muestre encima de todas las ventanas de Windows. nEstilo = 4 + 32 + 4096 && el valor no documentado es 4096 MESSAGEBOX("ESTE ES UN MESSAGEBOX", nEstilo , "DIEFERNTE" ) Código ESC para cortar el papel en impresoras Epson Este truco te explica cual es la secuencia escape que debes enviar a la impresora Epson (TMU) para que corte el papel. Set Console Off Set Device To Printer Set Printer To Name NombreDeImpresora Set Print On ??? Chr(27)+"m"&& Corta el Papel Set Print Off Set Device To Screen Set Printer To Set Console On Dejar fija primera columna de un grid Este es un truco bastante solicitado .... Con VFP 8 o superior ya es posible hacerlo más fácilmente. Aquí tienes 2 formas de hacerlo. En el AfteRowColchange del Grid digita lo siguiente: Lparameters nColIndex Thisform. LockScreen = .T. This.Columns(1).ColumnOrder =This. LeftColumn Thisform.LockScreen = .T. ** Y en el Scrolled del Grid esto : Lparameters nDirection Thisform. LockScreen= .T. If nDirection > 3 This .Columns(1). ColumnOrder = This.LeftColumn Endif Thisform.LockScreen= .F. OTRA FORMA ** En el AfteRowColchange del Grid digita lo siguiente: nPos =This. ActiveColumn-This.RelativeColumn If nPos>0 This.COlumn1.ColumnOrder=nPos+1 Else This.COlumn1.ColumnOrder=1 Endif Imprimir un archivo PDF En muchas ocasiones se necesita imprimir un archivo PDF (Acrobat Reader) y pensamos diferentes formas de hacerlo.... esta es una de las más sencillas. Para eso utilizamos la función ShellExecute del API de Windows. Declare Integer ShellExecute In shell32. Dll;
long HWnd,String cOperation, ; string cFile, String t cParam, ; string cDir, Integer nShow cRutaPDF = "C:Rutaarchivo.pdf" ShellExecute(0, "print", cRutaPDF,"", Fullpath(""),0) Nombre del dominio en que se logeo el PC p align="justify">Un pequeño truco para cuando quieras determinar en que dominio se logeo un determinado PC. ? GetEnv("USERDOMAIN") Conectarse a una base de datos de SQL Server Esta es otra de las preguntas frecuentes .... aquí tienes varios ejemplos de como hacerlo. cCadConnDSN = "driver = SQL Server;server=tu_server;uid=sa;pwd=sa_pw" O cCadConnDSN = "driver = {SQL Server};server=tu_server;uid=sa;pwd=sa_pw" O cCadConnDSN = "DRIVER = {SQL Server};" ; + "SERVER=tu_server;" ; + "UID=nombre_usuario;" ; + "PWD=clave_pw;" ; + "DATABASE=PUBS;" ; && Nombre de la base de datos + "WSID=nombre_usuario;" ; + "APP=__" nHanConn = Sqlstringconnect(m.cCadConnDSN) If nHanConn > 0 =MessageBox("Conectado a la base de datos de SQl Server") Else =MessageBox("Error al conectarse a la base de datos de SQl Server") EndIf Agregar imagen al Screen centrada Este es un antiguo truco que te permite agregar una imagen al screen de VFP centrada. Viejo pero bueno. @ 2.000,2.000 Say "c:imagen.jpg" Bitmap STYLE "T" Center Devolver el nombre físico del formulario actual En muchas ocasiones se necesario conocer el nombre del formulario que se esta ejecutando. La función Sys(1271) hace exactamente esto. Crea un formulario y un botón y coloca este código en el evento click del botón. cForm = SYS(1271,Thisform) Wait window cForm Imprimir el contenido de un RTF
El RTF es un control ActiveX que permite dar características al texto al estilo de Word. En el ejemplo se muestra como imprimir el contenido de este ActiveX. Para imprimir el contenido debes utilizar el método SelPrint del control RTF ... With Thisform.Rtf .selstart=1 .sellength=len(.textrtf) .selprint Exportar a HTML de forma sencilla Esta es una de las formas más sencillas de exportar una tabla a HTML ... En este ejemplo se recorre numero de campos que tenga la tabla y luego el total de registros... Scan For lnField = 1 To Afields(laFields) \<> Endfor Endscan
Set Textmerge Off Set Textmerge To Strtofile(lcHTML,"c:TablaExportada.htm") Determinar la Dirección IP del Equipo Una forma de conocer la dirección IP del equipo es invocando una función API, pero comentare otra forma de hacerlo y es pasándole el parámetro al programa RUN del DOS, el único inconveniente es que se mostrara la ventana del DOS, pero eso también tiene solución y será explicada en la sección de APIS Local F, X, Y, U, K F = Sys(2023) + "" + SubStr(Sys(2015),1,8) + ".txt" X = SubStr(sys(0),1, At(" ", Sys(0))-1) Run PING &X > &F Y = FileToStr(F) Delete File &F U = At("[", Y) + 1 K = At("]", Y) ? SubStr(Y,U,K-U) Lo primero que realiza este código es definir algunas variables, luego obtiene el directorio de archivo temporales y genera un archivo único. A continuación se obtiene información sobre la unidad de red y estas valores se le pasan como parámetro al programa PING. Crystal Report y VFP Uno de los grandes problemas de VFP son los reportes; pero podemos realizar los reportes en Cristal Report y luego llamarlos desde VFP. No quiero decir con esto que sea mejor, más fácil o más cómodo; simplemente es otra forma de hacerlo y tiene muchas ventajas. En los ejemplos que demuestro estoy utilizando la versión 8 del Cristal Report de Seagate pero considero que se debe comportar igual con las demás versiones. Primero veamos como puedo exportar un reporte a extensión .DOC (Word)
oCristalReport = createobject("crystal.crpe.application") oRepx = oCristalReport.OpenReport("C: eporteventas.RPT") oRepx.ExportOptions.FormatType = 14 && Formato de Word oRepx.ExportOptions.DiskFileName = "c: eporteventasdelmes.doc" oRepx.ExportOptions.DestinationType = 1 && Tipo de Destino a guardar oRepx.Export(.F.) && No muestra ningun cuadro de Dialogo release oRepx release oCristalReport Los otros formatos en que podemos guardar los reportes son: Extensión FormatType RTF 4 EXCEL 7 27 o 28 EXCEL 8 29 o 30 Para ver en vista previa un reporte: oCristalreport = createobject("crystal.crpe.application") oRep = oCristalreport.OpenReport("C: eporteventas.RPT") oRep.Preview Para mandarlo a imprimir oCristalreport = createobject("crystal.crpe.application") oRep = oCristalreport.OpenReport("C: eporteventas.RPT") oRep.Printout(.F.) && .F. no muestra cuadro para configurar impresora Quitar acentos de una cadenas de caracteres Algunas veces los acentos son algo molestos y nos causan inconvenientes, sobre todo al momento de realizar búsquedas dentro tablas lCadena = "El amor es el perdón más fácil" ? CHRTRAN(lCadena, "áéíóúáéíóú", "aeiouAEIOU") Agregar ceros ( 0 ) a la izquierda de un número Si deseas agregar 0 a un número a la izquierda de este, puedes hacer esto. Se utiliza mucho en la generación de Factura. LnVar = 350 && Variable a agregar 0 ?PADL(lnVar,5,_0_) && el número 5 especifica el ancho de la cadena de números Resultado 00350 Invocar cuadros de dialogo de Windows Existe una forma sencilla de invocar cuadros de dialogo de Windows, tales como: Guardar, Abrir, Fuentes, Color, Impresoras, Ayuda. loComDialog = newobject( "mscomdlg.commondialog" ) locomdialog.ShowFont && Mostrar Fuente locomdialog.ShowPrinter() && Mostrar Impresora
locomdialog.ShowColor() && Mostrar Colores locomdialog.ShowSave() && Mostrar Guardar loComDialog.ShowOpen && Mostrar Abrir diferencia entre horas FUNTION DifHoras Lparameters 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 ; Transform(lnHor, "@L 99")+ ":"+ ; Transform(lnMin, "@L 99") Hola Amigos: Les escribo porque tengo el siguiente problema y quizás Conozcan la solución Tengo una aplicación compilada con Vfp8 hice un instalador y anda muy bien en todas las redes en donde la he instalado salvo en una condición Cuando el cliente es un Win XP con SP2 me da el siguiente error R:\AdmCons\AdmCons.exe No se pudo iniciar la aplicación porque su configuración es incorrecta. Reinstalar la aplicación puede solucionar el problema. Por supuesto que ya la reinstale 1000 veces de 80 maneras distintas Me pasa con cualquier servidor Win Me Win XP etc pero siempre cuando el cliente es un XP con SP2 Si el cliente es otra cosa o Win XP sin SP2 anda fenómeno Tengo todas las Dll registradas esta todo perfecto En la misma situación he hecho para probar EXE compilado con VFP6 y anda sin problema También he descubierto que ejecutando Do R:\Admcons\Admcons.exe desde la ventana de comando de VFP8 anda perfectamente En la empresa tenemos la aplicación compilada en V fp8 y funcionando en varios equipos con XP
SP2 y funciona sin problemas.... Solo que como son muchos los puestos que conectan al servidor, en vez de instalar los Runtime de Vfox a cada puesto los colocamos en el Directorio Raiz de la aplicación, de esta forma no tuvimos que registrarlos en cada equipo. Los ficheros que copiamos en el directorio de la aplicación son: gdiplus.dll msvcr70.dll vfp8r.dll vfp8resn.dll vfp8t.dll Re: RESALTAR UNA CELDA DE UN GRID .... Por sotero (#866) a las 20:40 del 14-02-2006 *Metodo iluminar, a llamar desde el AFTERROWCOLCHANGE del grid. *Hay que pasarle donde esta la ubicación del grid. *Ejemplo: Thisform.Iluminar("Thisform.pgfPiso.Page6.grdVisitas", "clientes") *En el formulario hay que crear la PROPIEDAD "HITROW" LPARAMETERS tcGrid , tcTabla Thisform.HitRow = RECNO(tcTabla) ThisForm.LockScreen = .T. cDynamic = 'IIF(RECNO() = Thisform.HitRow , RGB(255,255,0), RGB(255,255,255))' &tcGrid..SetAll('DynamicBackColor', cDynamic, 'Column') &tcGrid..Refresh ThisForm.LockScreen = .F. *********************************************** Si estás en VFP 9 esto lo puedes suprimir y poner en el GRID la propiedad HighlightStyle a 2 (Enable highlighting for current row and persist when grid is not the current active control.) Re: Problema con la "Ñ" Por Ramón Rodríguez (#5229) a las 04:50 del 18-01-2006 El problema es que son códigos de página diferentes entre los archivos dos y Windows, prueba esto x="Espero que tengas el más feliz de los cumpleaños" @1,1 say cpconvert(1252, 850,Allt(x)) Re: Problema con la "Ñ" Por Christian (#4698) a las 15:17 del 19-01-2006 Hola, Al momento de imprimir, hace un chrtransc de la descripcion, cambiando un caracter por otro EJECUTAR OUTLOOK EXPRESS DESDE VFP DECLARE INTEGER ShellExecute ; IN SHELL32.DLL ;
INTEGER nWinHandle,; STRING cOperation,; STRING cFileName,; STRING cParameters,; STRING cDirectory,; INTEGER nShowWindow ShellExecute(0, "Open", "msimn.exe", "", "C:\Program Files\Outlook Express", 1) CAMBIAR RESOLUCION DE LA PANTALLA Cuando diseñamos nuestra aplicacion tenemos como base una resolucion para nuestra aplicacion, normalmente yo la diseño en 800 x 600, para garantizar el buen funcionamiento yo le indico a los usuarios si estan usando la configuración básica aceptable. Espero les pueda ayudar: IF dimensiones()=.T. =cambiar_resolucion(800,600) ENDIF FUNCTION dimensiones #DEFINE h_screenwidth 0 && Screen width #DEFINE h_screenheight 1 && Screen HEIGHT LOCAL lnalto_screen, lnancho_screen DECLARE INTEGER GetSystemMetrics IN Win32API; INTEGER nIndex lnalto_screen = getsystemmetrics(h_screenheight) lnancho_screen = getsystemmetrics(h_screenwidth) IF ( lnalto_screen < 600 OR lnancho_screen < 800 ) IF MESSAGEBOX("Es recomendable que la resolución "+CHR(13)+; "de su monitor sea de 800 x 600"+CHR(13)+"Para que el sistema se ejecute adecuadamente"+CHR(13)+CHR(13)+; "¿ Desea cambiarla ?",4+32+0,"Verifique pregunta" ) = 6 RETURN .T. ELSE RETURN .F. ENDIF ELSE RETURN .F. ENDIF #undefine h_screenwidth #undefine h_screenheight ENDFUNC FUNCTION cambiar_resolucion LPARAMETERS tnwidth, tnheight LOCAL lnwidth, lnheight, lnmodenum, lcdevmode, lnresp lnmodenum = 0 lcdevmode = REPLICATE(CHR(0), 156) lnwidth = IIF(EMPTY(tnwidth), 800, tnwidth) lnheight = IIF(EMPTY(tnheight), 600, tnheight) DECLARE INTEGER EnumDisplaySettings IN Win32API STRING lpszDeviceName, INTEGER iModeNum, STRING @lpDevMode
DECLARE INTEGER ChangeDisplaySettings IN Win32API STRING @lpDevMode , INTEGER dwFlags *!* Se usa obtener todos los modos disponibles DO WHILE enumdisplaysettings(NULL, lnmodenum, @lcdevmode) <> 0 lnmodenum = lnmodenum + 1 ENDDO lcdevmode = STUFF(lcdevmode, 41, 4, long2str(1572864)) lcdevmode = STUFF(lcdevmode, 109, 4, long2str(tnwidth)) && Ancho lcdevmode = STUFF(lcdevmode, 113, 4, long2str(tnheight)) && Alto lnresp = changedisplaysettings(@lcdevmode, 1) IF lnresp = 0 MESSAGEBOX("La resolución de su monitor ha sido cambiada"+CHR(13)+; "Ahora podra trabajar adecuamente",0+48+0,"atención" ) ELSE MESSAGEBOX("No se pudo cambiar la resolución de su monitor",0+48+0,"atención" ) ENDIF ENDFUNC FUNCTION long2str LPARAMETERS lnlongval *!* 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 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 ***** Les explico, si ud hace diseñado una aplicación en una resolución de 800x600 (en este caso); podra advertir a los usuarios que su monitor no esta configurado adecuademente y este por si solo podra sin salir del sistema cambiar la resolución. INFORMACION DE DRIVES ¿Quieres conocer toda la información de todas las unidades o drives instalados en tu sistema? Bueno pues esta función relizada con WSH lo hace para ti. Function WSHListDrives LOCAL loFSO, loDrivesCol, loDrive, ; llIsReadyDrive, lnDriveType, lcDriveType, lnWait loFSO = CREATEOBJECT('Scripting.FileSystemObject') loDrivesCol = loFSO.Drives ? "El numero de drives en el sistema son: " + ALLTRIM(STR(loDrivesCol.Count)) FOR EACH loDrive IN loDrivesCol
? "Drive : " + loDrive.DriveLetter lnDriveType = loDrive.DriveType DO CASE CASE lnDriveType=1 lcDriveType = [removible] CASE lnDriveType=2 lcDriveType = [fijo] CASE lnDriveType=3 lcDriveType = [network] CASE lnDriveType=4 lcDriveType = [CD-ROM] CASE lnDriveType=5 lcDriveType = [RAM-disk] ENDCASE ? "El tipo de drive es: " + lcDriveType llIsReadyDrive = loDrive.IsReady ? IIF( llIsReadyDrive=.T., [El Drive esta listo.],[El drive no esta listo.]) IF llIsReadyDrive ? "Espacio disponible: " + ALLTRIM(STR(loDrive.AvailableSpace)) + [ bytes.] ? "Espacio Libre: " + ALLTRIM(STR(loDrive.FreeSpace)) + [ bytes.] ? "Tamaño total: " + ALLTRIM(STR(loDrive.TotalSize)) + [ bytes.] ? "Ruta: " + loDrive.Path ? "Nombre del volumen: " + loDrive.VolumeName ENDIF IF INLIST(lnDriveType,1,2,4) AND llIsReadyDrive ? "Número de serie: " + ALLTRIM(STR(loDrive.SerialNumber)) ENDIF IF lnDriveType=3 ? "Nombre compartido: " + loDrive.ShareName ELSE IF lnDriveType=2 ? "Nombre compartido: " + RTRIM(LEFT(SYS(0),15)) ENDIF ENDIF WAIT CLEAR NEXT Endfunc CREAR ARCHIVO DE TEXTO CON FILESYSTEMS Function crearArchivo() Local fso, fldr fso = CreateObject("Scripting.FileSystemObject") fldr = fso.CreateTextFile("C:prueba.txt")
Endfunc BORRAR CARPETA CON FILESYSTEM Function Borrarcarpeta() Local fso as object fso = CreateObject("Scripting.FileSystemObject") fldr = fso.DeleteFolder("C:\borrame") Endfunc ABRIR CUADRO DE DIALOGO CONECTAR A RED O IMPRESORA Esta función permite abrir el cuadro de diálogo conectar a unidad de red o impresora #DEFINE RESOURCETYPE_DISK 1 #DEFINE RESOURCETYPE_PRINT 2 Declare Integer WNetConnectionDialog In Win32Api; Integer Handle, Integer ResourceType Declare Integer FindWindow In Win32Api; Integer Handle, String cTitle *-- Para conectar a una unidad de red WNetConnectionDialog(FindWindow(0,_Screen.Caption), RESOURCETYPE_DISK) *-- Para conectar a una impresora WNetConnectionDialog(FindWindow(0,_Screen.Caption), RESOURCETYPE_PRINT) HACER PARPADEAR UNA VENTANA TIPO MSN Este Ejemplo permite hacer Parpadear un Form de la misma manera que lo hace el Microsoft Messenger, cuando llega un nuevo mensaje, y no esta activa la ventana en ese momento, y que para cuando se Activa. *** Opciones De Parpadeo #Define FlashW_Stop 0 &&Para el Parpadeo de una ventana. #Define FlashW_Caption 0x1 &&Hace Parpadear El Titulo de Una Ventana #Define FlashW_Tray 0x2 &&Hace Parpadear la Ventana en la TaskBar #Define FlashW_All 3&&Parpadea El Titulo de la ventana y en la Taskbar #Define FlashW_Timer 0x4 &&Parpadea Infinitamente, o hasta Enviar Un FlashW_Stop #Define FlashW_TimerNoFg 0xC &&Parpadea hasta que Se Active la Ventana *** Declaracion de Las Apis Declare Long FlashWindowEx In "user32" String @CFlashWInfo Declare Long FindWindow In User32 String cClass, String cCaption *** Inicia El Codigo Local cFlashInfo cFlashInfo =Space(20) *** Creamos La Estructura cFlashInfo = Num2dWord(20)+; &&Longitud de la Estructura Num2dWord(FindWindow(.Null.,'Calculadora'))+; &&Handle de la Ventana a "Flashear" Num2dWord(FlashW_All+FlashW_TimerNoFg)+; &&Opciones Num2dWord(5)+; && Cantidad de Veces que Parpadeara (0 =Infinito) Num2dWord(0) && Tiempo entre Parpadeo (en Milisegundos, 0=Default) *** Hacemos Parpadear la Ventana.
FlashWindowEx(@cFlashInfo) Procedure Num2dWord Lparameter tnNum Local c0,c1,c2,c3 lcresult = Chr(0)+Chr(0)+Chr(0)+Chr(0) If tnNum < (2^31 - 1) then c3 = Chr(Int(tnNum/(256^3))) tnNum = Mod(tnNum,256^3) c2 = Chr(Int(tnNum/(256^2))) tnNum = Mod(tnNum,256^2) c1 = Chr(Int(tnNum/256)) c0 = Chr(Mod(tnNum,256)) lcresult = c0+c1+c2+c3 Endif Return lcresult Endproc CONOCER EL TAMAÑO DE UN ARCHIVO Esta funcion permite saber el tamaño de un archivo en especifico (en bytes), por medio de api. #Define OF_READ 0x0 ?GetInfoF("c:config.sys") ?? " Bytes" Function GetInfoF(cFile) Declare Long _lopen In "kernel32" As lOpen String lpPathName, Long iReadWrite Declare Long _lclose In "kernel32" As lclose Long hFile Declare Long GetFileSize In "kernel32" Long hFile, Long @lpFileSizeHigh Local nArchivo As Long, nLongitud As Long Local lpMax As Long lpMax =1 nArchivo= lOpen(cFile, OF_READ) nLongitud = GetFileSize(nArchivo, @lpMax ) lclose(nArchivo) Return nLongitud Endfunc HACER CONEXIÓN ODBC DESDE VFP Aqui esta el código para hacerlo mediante API. DECLARE Integer SQLConfigDataSource IN odbccp32.dll ; Integer, Short, String @, String @
ODBC_ADD_SYS_DSN = 1
lc_driver = "Microsoft Visual FoxPro Driver" + CHR(0)
lc_dsn = "dsn=Bases Bodega1" + CHR(0) + ; "BackgroundFetch=Yes" + CHR(0) + ; "Description=descripcion de la conexion" + CHR(0) + "Exclusive=No" + CHR(0) +; "SourceDb= uta.dbc" + CHR(0) +; "Sourcetype=DBC" IF SQLConfigDataSource(0, ODBC_ADD_SYS_DSN, @lc_driver, @lc_dsn) = 1 RETURN .T. && OK ENDIF RETURN .F. && error *.- lc_driver = Drive de Visual FoxPro *.- lc_dsn = dsn = Nombre de la Conexion *.- BackgroudFetch = Busqueda de datos secundarios Valores Yes o No *.- Description = Descripcion de de la conexion *.- SourceDb = Mapeo o direccion de la tabla o base de datos a conectar *.- SourceType = tipo de conexion valores DBC o DBF si fuera tabla libre HACER PARPADEAR LA BARRA DE TITULO DE NUESTRA APLICACIÓN Este efecto es muy comun en las aplicaciones hoy en dia tal, como MSN. que cuando nos escriben un mensaje, parpadea el titulo de una ventana en la barra de tareas. Desde VFP podemos hacerlo. La función que nos permite hacerlo la declaramos asi: Declare FlashWindow IN user32.dll ; LONG hwnd,; Long bInvert Cuando querramos que nuestra aplicacion parpadee ejecutamos lo siguiente: Si queremos que el _screen Parpadee FlashWindow(application.hWnd,.t.) Si queremos que el form lo haga FlashWindow(thisform.HWnd,.t.) NOTA: FlashWindow solo hará que la ventana parpadee una sola vez, si queremos que el parpadeo persista, deberemos colocar el código en un Timer, y en el evento Activate del Form, desactivar el Timer, o que el Timer lo ejecute X veces. El segundo parámetro nos permite decirle si queremos que parpadee si esta activada o no. Al pasarle .T. la ventana parpadeara una sola vez, este o no activada, si le pasamos .F. parpadeara solo si la ventana esta inactiva y quedara de otro color el boton en la barra de tareas. Este código esta en VFP 7. Si quieren ejecutarla desde VFP 6 deberan obtener el handle de la ventana a la que le quieran aplicar el efecto. En PortalFox esta la función para hacerlo. Creo que son estas APIs: GetWindow FindWindow
OBTENER DIRECCION IP CON WINSOCK Una manera de conseguir la dirección IP local con Winsock. ************************************************************ * * Clase: GET_IPADDRESS * * Devuelve la dirección IP local * * Parametros: * * ninguno * * Ejemplos: * * ipdir=get_ipaddress() * * Retorno * * dirección IP o cadena vacia si no está instalado el WinSock * * Nota * * Adaptado de John Harvey * * Fecha de Creación : 29/01/2001 Pablo Roca * Ultima Modificacion: 29/01/2001 Pablo Roca * ************************************************************ LOCAL lcret IPSocket = CreateObject("MSWinsock.Winsock") IF TYPE('IPSocket')='O' lcret = IPSocket.LocalIP ELSE MESSAGEBOX("Winsock no está instalado!") lcret = "" ENDIF RETURN lcret CAMBIAR RESOLUCION 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 OCULTA BARRA DE TAREAS DE WINDOWS *!* Oculta la barra de tareas de windows *!* Sintaxis: HideTaskBar() *!* Valor devuelto: *!* Argumentos: FUNCTION HideTaskBar *!* Constantes para ocultar o mostrar la barra de tareas de windows * Sgte linea notificada por Hugo Ranea 20/06/2001 #DEFINE TOGGLE_HIDEWINDOW 128 LOCAL lnHwnd *!* Valores lnHwnd = 0 *!* Instrucciones DECLARE DLL para manipular la barra de tareas
DECLARE INTEGER FindWindowA IN Win32API STRING lpClassName,; STRING lpWindowName DECLARE INTEGER SetWindowPos IN Win32API INTEGER hwnd,; INTEGER hwndInsertAfter, INTEGER x, INTEGER y, INTEGER cx,; INTEGER cy, INTEGER wFlags *!* Valores lnHwnd = FindWindowA('Shell_traywnd', '') *!* Ocultar la barra de tareas IF lnHwnd <> 0 SetWindowPos(lnHwnd, 0, 0, 0, 0, 0, TOGGLE_HIDEWINDOW) ENDIF ENDFUNC MOSTRAR BARRA DE TAREAS DE WINDOWS *!* Muestra la barra de tareas de windows *!* Sintaxis: ShowTaskBar() *!* Valor devuelto: *!* Argumentos:FUNCTION ShowTaskBar *!* Constantes para ocultar o mostrar la barra de tareas de windows * Sgte linea notificada por Hugo Ranea 20/06/2001 #DEFINE TOGGLE_UNHIDEWINDOW 64 LOCAL lnHwnd *!* Valores lnHwnd = 0 *!* Instrucciones DECLARE DLL para manipular la barra de tareas DECLARE INTEGER FindWindowA IN Win32API STRING lpClassName,STRING lpWindowName DECLARE INTEGER SetWindowPos IN Win32API INTEGER hwnd,; INTEGER hwndInsertAfter, INTEGER x, INTEGER y, INTEGER cx,; INTEGER cy, INTEGER wFlags *!* Valores lnHwnd = FindWindowA('Shell_traywnd', '') *!* Mostrar la barra de tareas IF lnHwnd <> 0 SetWindowPos(lnHwnd, 0, 0, 0, 0, 0, TOGGLE_UNHIDEWINDOW) ENDIF ENDFUNC EVITAR QUE UNA APLICACION SE CARGUE DOS VECES La misma función que hemos visto en el caso anterior puede ser usada para evitar que un programa externo se cargue mós de una vez. Un ejemplo sencillo es el de la calculadora de Windows. Imaginemos que en nuestra aplicación demos la posibilidad de utilizar la calculadora. Pondríamos una línea come esta: RUN /N CALC.EXE Pero si esta línea la ejecutamos más de una vez, se cargarás la calcuadora una y otra vez. * Antes de activar la calculadora:
IF NOT F_ActivaWin("Calculadora") * La calculadora no está cargada: RUN /N CALC.EXE ENDIF * Y ESTA ES LA FUNCION QUE LO HACE TODO: *----------------------------FUNCTION F_ActivaWin(cCaption) *----------------------------LOCAL nHWD DECLARE INTEGER FindWindow IN WIN32API ; STRING cNULL, ; STRING cWinName DECLARE SetForegroundWindow IN WIN32API ; INTEGER nHandle DECLARE SetActiveWindow IN WIN32API ; INTEGER nHandle DECLARE ShowWindow IN WIN32API ; INTEGER nHandle, ; INTEGER nState nHWD = FindWindow(0, cCaption) IF nHWD > 0 * VENTANA YA ACTIVA * LA "LLAMAMOS": ShowWindow(nHWD,9) * LA PONEMOS ENCIMA SetForegroundWindow(nHWD) * LA ACTIVAMOS SetActiveWindow(nHWD) RETURN .T. ELSE * VENTANA NO ACTIVA RETURN .F. ENDIF Como saber el nombre del PC y el recurso compartido de una conexión de red. *----------------------------------------FUNCTION _GetConnec(lcDrive) *----------------------------------------* Retorna el nombre de la PC y recurso compartido * de una coneccion de red * PARAMETROS: lcDrive * USO: _GetConnec("K:") *----------------------------------------DECLARE INTEGER WNetGetConnection IN WIN32API ;
STRING lpLocalName, ; STRING @lpRemoteName, ; INTEGER @lpnLength LOCAL cRemoteName, nLength, lcRet, llRet cRemoteName=SPACE(100) nLength=100 llRet = WNetGetConnection(lcDrive,@cRemoteName,@nLength) lcRet = LEFT(cRemoteName,AT(CHR(0),cRemoteName)-1) RETURN lcRet ENDFUNC Ejemplo de como agregar un menú en un formulario SDI (Interfaz de un solo documento Single Document Interface). Agregar un menú en un formulario SDI Introducción Continuando con el tema de formularios SDI (Interfaz de un solo documento - Single Document Interface), esta vez mostraré como agregar un menú en un formulario de nivel superior. Crear el formulario de nivel superior Como ya vimos en un artículo anterior, para crear un formulario SDI en Visual FoxPro, debemos crear un Formulario de nivel superior, configurando la propiedad ShowWindow = 2 (Como formulario de nivel superior). Un formulario de nivel superior aparece como una ventana independiente sobre el escritorio de Windows y se muestra en la barra de tareas de Windows. Crear el menú La creación de un menú SDI para agregar en un formulario de nivel superior, es igual que la creación de cualquier otro menú, solo debemos marcar la casilla de verificación Formulario de nivel superior en el cuadro de dialogo Opciones generales que se muestra al seleccionar la opción Ver -> Opciones generales desde el diseñador de menú, como lo muestra la figura siguiente: Cuando generamos el menú con esta opción activada, se deberá llamar al menú desde el método Init del formulario de nivel superior con una sentencia como la siguiente DO MiMenu.mpr WITH THISFORM,.T. Editando el archivo MiMenu.mpr podemos ver en las primeras líneas comentadas, una ayuda con las distintas formas de llamar al menú generado. Código de ejemplo El siguiente código es un ejemplo para mostrar un formulario de nivel superior con un menú incorporado. Para ejecutarlo con un menú personalizado, se debe habilitar la línea DO MiMenu.mpr WITH Thisform, .T. en el método Init del formulario, y quitar la llamada al procedimiento MiMenuEjemplo. PUBLIC goMiForm goMiForm=CREATEOBJECT("MiForm") goMiForm.SHOW(1) RETURN *--*--- Definición de MiForm *--DEFINE CLASS MiForm AS FORM SHOWWINDOW = 2 DOCREATE = .T. AUTOCENTER = .T.
CAPTION = "Ejemplo de menú en un formulario SDI" NAME = "MiForm" PROCEDURE INIT *DO MiMenu.mpr WITH Thisform, .T. DO MiMenuEjemplo WITH THISFORM, .T. ENDPROC PROCEDURE DESTROY RELEASE MENU (THIS.NAME) EXTENDED ENDPROC ENDDEFINE *--*--- MiMenuEjemplo.spr *--PROCEDURE MiMenuEjemplo LPARAMETERS oFormRef, getMenuName, lUniquePopups LOCAL cMenuName, nTotPops, a_menupops, cTypeParm2, cSaveFormName IF TYPE("m.oFormRef") # "O" OR ; LOWER(m.oFormRef.BASECLASS) # 'form' OR ; m.oFormRef.SHOWWINDOW # 2 MESSAGEBOX([Este menú solo puede ser llamado en un formulario de nivel superior]) RETURN ENDIF m.cTypeParm2 = TYPE("m.getMenuName") m.cMenuName = SYS(2015) m.cSaveFormName = m.oFormRef.NAME IF m.cTypeParm2 = "C" OR (m.cTypeParm2 = "L" AND m.getMenuName) m.oFormRef.NAME = m.cMenuName ENDIF IF m.cTypeParm2 = "C" AND !EMPTY(m.getMenuName) m.cMenuName = m.getMenuName ENDIF DIMENSION a_menupops[3] IF TYPE("m.lUniquePopups")="L" AND m.lUniquePopups FOR nTotPops = 1 TO ALEN(a_menupops) a_menupops[m.nTotPops]= SYS(2015) ENDFOR ELSE a_menupops[1]="archivo" a_menupops[2]="edición" a_menupops[3]="ayuda" ENDIF *--*--- Definición del menú *--DEFINE MENU (m.cMenuName) IN (m.oFormRef.NAME) BAR DEFINE PAD _1mv0kg6re OF (m.cMenuName) PROMPT "\ DEFINE PAD _1mv0kg6rf OF (m.cMenuName) PROMPT "\ DEFINE PAD _1mv0kg6rg OF (m.cMenuName) PROMPT "A\ ON PAD _1mv0kg6re OF (m.cMenuName) ACTIVATE POPUP (a_menupops[1])
ON PAD _1mv0kg6rf OF (m.cMenuName) ACTIVATE POPUP (a_menupops[2]) ON PAD _1mv0kg6rg OF (m.cMenuName) ACTIVATE POPUP (a_menupops[3]) DEFINE POPUP (a_menupops[1]) MARGIN RELATIVE SHADOW COLOR SCHEME 4 DEFINE BAR 1 OF (a_menupops[1]) PROMPT "\ DEFINE BAR 2 OF (a_menupops[1]) PROMPT "\ DEFINE BAR 3 OF (a_menupops[1]) PROMPT "\-" DEFINE BAR 4 OF (a_menupops[1]) PROMPT "\ DEFINE BAR 5 OF (a_menupops[1]) PROMPT "\ DEFINE BAR 6 OF (a_menupops[1]) PROMPT "\ DEFINE BAR 7 OF (a_menupops[1]) PROMPT "\-" DEFINE BAR 8 OF (a_menupops[1]) PROMPT "\ ON SELECTION BAR 8 OF (a_menupops[1]) DO _Salir DEFINE POPUP (a_menupops[2]) MARGIN RELATIVE SHADOW COLOR SCHEME 4 DEFINE BAR 1 OF (a_menupops[2]) PROMPT "\ DEFINE BAR 2 OF (a_menupops[2]) PROMPT "\-" DEFINE BAR 3 OF (a_menupops[2]) PROMPT "Cor\ DEFINE BAR 4 OF (a_menupops[2]) PROMPT "\ DEFINE BAR 5 OF (a_menupops[2]) PROMPT "\ DEFINE POPUP (a_menupops[3]) MARGIN RELATIVE SHADOW COLOR SCHEME 4 DEFINE BAR 1 OF (a_menupops[3]) PROMPT "\ DEFINE BAR 2 OF (a_menupops[3]) PROMPT "\-" DEFINE BAR 3 OF (a_menupops[3]) PROMPT "Acerca \ ACTIVATE MENU (m.cMenuName) NOWAIT IF m.cTypeParm2 = "C" m.getMenuName = m.cMenuName m.oFormRef.NAME = m.cSaveFormName ENDIF ENDPROC PROCEDURE _Salir _SCREEN.ACTIVEFORM.RELEASE ENDPROC Al ejecutar el código anterior, veremos el formulario SDI con el menú como lo muestra la siguiente figura: Comentarios Recordar que Visual FoxPro trae en la aplicación "Solution" un ejemplo similar donde se muestra un formulario SDI, en el cual se agrega un menú, una barra de herramientas, y se crean ventanas secundarias. Para ver la aplicación "Solution" ejecute: DO (HOME(2) + "Solution\Solution") O directamente corra el ejemplo del formulario SDI ejecutando: DO FORM (HOME(2) + "\Solution\Forms\SDIForm.scx") Buscar texto en un Cuadro de Edicion Para ver el ejemplo ejecute el siguiente código: *-- Creo un archivo de texto SET SAFETY OFF
LOCAL lc TEXT TO lc NOSHOW Este es un texto tomado de un archivo de texto, para buscar una palabra y remarcarla si la encuentra. Escriba en el cuadro de texto una palabra que se encuentre aquí y haga click en el botón Buscar. Visual FoxPro. Nada corre como un zorro. ENDTEXT STRTOFILE(lc,"MiTxt.txt") *-- Creo el formulario PUBLIC goForm goForm = CREATEOBJECT("Form1") goForm.SHOW DEFINE CLASS Form1 AS FORM CAPTION = "Ejemplo de búsqueda en un EditBox" NAME = "Form1" ADD OBJECT Text1 AS TEXTBOX WITH ; HEIGHT = 24, ; LEFT = 24, ; TOP = 12, ; NAME = "Text1" ADD OBJECT Command1 AS COMMANDBUTTON WITH ; HEIGHT = 24, ; TOP = 12, ; LEFT = 144, ; CAPTION = "Buscar", ; NAME = "Command1" ADD OBJECT Edit1 AS EDITBOX WITH ; HEIGHT = 180, ; LEFT = 24, ; TOP = 48, ; WIDTH = 300, ; NAME = "Edit1" PROCEDURE INIT THISFORM.Edit1.VALUE = FILETOSTR("MiTxt.txt") ENDPROC PROCEDURE Command1.CLICK LOCAL lcBusca, lnPos, lnLen lcBusca = ALLTRIM(THISFORM.Text1.VALUE) lnLen = LEN(lcBusca) lnPos = AT(lcBusca,THISFORM.Edit1.VALUE) IF lnPos > 0 THISFORM.Edit1.SELSTART = lnPos - 1 THISFORM.Edit1.SELLENGTH = lnLen THISFORM.Edit1.SETFOCUS ELSE
MESSAGEBOX("No se encuentra",64,"Aviso") ENDIF ENDPROC ENDDEFINE EVITAR RETORNO DE CARRO EN UN EDITBOX public oForm oForm = CREATEOBJECT("MyForm") oForm.Show() DEFINE CLASS MyForm AS Form Caption = "No-Retorno de Carro" ADD OBJECT MyLabel AS Label ; WITH AutoSize=.T.,; Caption="Introduzca su texto, no se permite tecla ENTER" ADD OBJECT myEditBox AS EditBox ; WITH Top = 20, Width=300, Height=200 PROCEDURE MyEditBox.KeyPress LPARAMETERS nKeyCode, nShiftAltCtrl **** Si se introduce la tecla ENTER *** IF nKeyCode=13 NODEFAULT &&No hacer nada (Inhibir) ENDIF ENDPROC ENDDEFINE BUSQUEDA INCREMENTAL EN UN FORMULARIO Una forma de hacer una busqueda incremental en un formulario, ingresando un texto en un TextBox y visualizando el resultado en un Grid En este ejemplo de BUSQUEDA INCREMENTAL en un Formulario, debemos poner un TextBox (Text1) y una Grilla (Grid1). En el Entorno de datos insertaremos la tabla (MiTabla) En el método InteractiveChange del TextBox debemos escribir el siguiente código: *--- InteractiveChange --LOCAL lc, lnRecno SELECT MiTabla lc = ALLT(THIS.VALUE) lnRecno = RECNO() IF MiTabla.Nombre >= lc IF NOT BOF() SKIP -1 ENDIF IF MiTabla.Nombre < lc && debe quedar donde estaba IF lnRecno <= RECC() GO RECNO() ELSE GO BOTT ENDIF RETURN ENDIF IF NOT EMPTY(ORDER()) && busqueda con indice SEEK lc
ELSE GO TOP LOCATE REST FOR MiTabla.Nombre=lc WHILE MiTabla.Nombre <= lc NOOPTIMIZE ENDIF ELSE LOCATE REST FOR MiTabla.Nombre=lc WHILE MiTabla.Nombre <= lc NOOPTIMIZE ENDIF IF lnRecno # RECNO() THISFORM.Grid1.SETFOCUS && el nombre del TextBox THISFORM.Text1.SETFOCUS && el nombre del Grid ENDIF RETURN *--- END InteractiveChange --NOTA: SE DEBE TENER LAS SIGUIENTES CONSIDERACIONES: La tabla debe estar ordenada ASCENDENTEMENTE o existir un indice por Nombre y estar seleccionado (el método busca si hay un SET ORDER establecido) Fijarse bien el nombre del TextBox y del Grid para invocar el método SetFocus (en el ejemplo Grid1 y Text1) Fijarse el alias de la tabla del grid (en el ejemplo MiTabla) Conviene que los nombres estén en mayúsculas y añadir en la propiedad Format del TextBox = ! para que sean ingresados en mayúsculas Conviene que la propiedad del Grid RecordMark = .T. para que se vea el registro marcado, o manejar el color del registro seleccionado LIMITAR UN CAMPO MEMO Como limitar la entrada de un campo memo a X lineas. De Ken Weber. 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. El modelo de objetos de Outlook es muy rico y poderoso. Esta interfaz está disponible como un servidor de automatización, o sea, que todo lo podemos automatizar mediante programación desde Visual FoxPro. Enviar y leer correo con Outlook desde Visual FoxPro El modelo de objetos de Outlook es muy rico y poderoso. Esta interfaz está disponible como un servidor de automatización, o sea, que todo lo podemos automatizar mediante programación desde Visual FoxPro. Un breve ejemplo Una de las tareas más fácil de automatizar en Outlook es el envío de un correo. Veremos un ejemplo de solamente unas pocas líneas. Lo primero que debemos hacer para automatizar Outlook, es crear un objeto Outlook. Una vez creado el objeto, debemos acceder al origen de los datos, pero esto no lo logramos en forma directa, debemos crear un objeto "NameSpace" apropiado que actuará como entrada (en este ejemplo MAPI). El objeto NameSpace proporciona entre otros, los métodos Logon y Logoff. LOCAL lcPerfil AS CHARACTER, lcContrasenia AS CHARACTER , ;
lcDestinatario AS CHARACTER, lcTema AS CHARACTER , ; lcCuerpo AS CHARACTER LOCAL loOutlook AS "Outlook.Application", ; loNameSpace AS OBJECT, loMailItem AS OBJECT #DEFINE LF_CR CHR(10)+CHR(13) *-- Datos del Mail lcPerfil = "Prueba" lcContrasenia = "prueba" lcDestinatario = "
[email protected]" lcTema = "Prueba: " + TTOC(DATETIME()) lcCuerpo = "Prueba enviando un mail desde Visual FoxPro." + LF_CR lcCuerpo = lcCuerpo + "Saludos." + LF_CR *-- Creo objetos Outlook y NameSpace loOutlook = CREATEOBJECT("Outlook.Application") loNameSpace = loOutlook.GetNameSpace("MAPI") *-- Ejecuto los métodos loNameSpace.Logon(lcPerfil , lcContrasenia) loMailItem = loOutlook.CreateItem(0) loMailItem.Recipients.ADD(lcDestinatario) loMailItem.Subject = lcTema loMailItem.Body = lcCuerpo loMailItem.Send loNameSpace.Logoff loNameSpace = .NULL. loOutlook = .NULL. Problemas de seguridad Outlook XP y Outlook 2000 SP2, incluyen los parches de seguridad de Microsoft. Estos parches restringen, entre otras cosas, el acceso a la libreta de direcciones y el envío de correo mediante automatización, con el fin de evitar códigos maliciosos que toman los datos de nuestra libreta de direcciones y envían correo sin nuestro consentimiento. Cuando intentamos enviar un correo desde Visual FoxPro, se nos presenta el siguiente cuadro de dialogo, que luego de 5 segundos habilita el botón "Si". Cuando intentamos acceder a la libreta de direcciones aparece el cuadro de dialogo el cual nos permitirá un acceso inmediato, o de 1, 2, 5, ó 10 minutos que debemos seleccionar. ¿Cómo solucionamos este problema? Estas son algunas de las opciones que disponemos nosotros para trabajar con estos parches de seguridad: Mantener la versión de Office 2000 SR-1 y no actualizarla ni instalarle parches de seguridad, con los peligros que esto significa. Si se tienen Outlook y Exchange instalados, el administrador de Exchange, puede disminuir las alertas o registrar algunas aplicaciones como seguras. Outlook Redemption: Es un objeto COM que se adapta fácilmente a la automatización y utiliza la MAPI extendida. Esta DLL fue escrita por Dmitry Streblechenko (MS Outlook MVP) y esta disponible en http://www.dimastr.com/redemption. Este es un producto comercial con un valor de U$S 200 aproximadamente. Existe para descarga una versión libre con fines de desarrollo.
Express ClickYes: Es un pequeño programa residente que se maneja mediante l a API de Windows. Este "presionará" el botón "Si" antes de que el dialogo aparezca. Este programa es gratis y esta disponible en http://www.express-soft.com/mailmate/clickyes.html. En el mismo sitio existe un ejemplo para Visual FoxPro. El formulario de ejemplo En este ejemplo utilizaremos un formulario con un objeto PageFrame con dos Páginas, una para enviar correo y la otra para leer los correos desde la Bandeja de Entrada. La siguiente figura es la página para el envío de un correo. Esta otra figura nos muestra la página para la lectura de la bandeja de entrada. En el método Init() creamos una instancia de la clase cOutlook con la sentencia: THISFORM.oCorreo = NEWOBJECT('cOutlook','cOutlook.prg') Creamos el servidor de automatización con: THISFORM.oCorreo.CrearServidor() El método CrearServidor() establece una referencia a la instancia de Outlook en la propiedad oOutlook. En este método también creamos un objeto NameSpace que nos permitirá acceder a las carpetas especiales de Outlook. También en el Init() del formulario, llamamos a otro formulario para el inicio de sesión de Outlook: *-- Formulario de inicio de sesión DO FORM Inicio WITH THISFORM.oCorreo TO llAceptar IF NOT (llAceptar AND THISFORM.oCorreo.IniciarSesion()) MESSAGEBOX('Falló el inicio sesión', 48, 'Inicio de sesión') RETURN .F. ENDIF Enviar un correo Antes de invocar el método EnviarCorreo(), configuramos todas las propiedades necesarias para el envío de correo. Esto lo hacemos en el método Click() del botón "Enviar". *-- Armo el mensaje WITH THISFORM.oCorreo .CargarVector(THIS.PARENT.txtTo.VALUE, 'aTO') .CargarVector(THIS.PARENT.txtCC.VALUE, 'aCC') .CargarVector(THIS.PARENT.txtAdjunto.VALUE, 'aAdjuntos') .cTema = ALLTRIM(THIS.PARENT.txtTema.VALUE) .cCuerpo = ALLTRIM(THIS.PARENT.edtCuerpo.VALUE) IF .EnviarCorreo() MESSAGEBOX('Mensaje enviado con éxito.', 64, 'Aviso') THISFORM.LimpiarPagina() ELSE MESSAGEBOX('No se pudo enviar el mensaje.', 48, 'Problemas') ENDIF ENDWITH RETURN En el llamado del método EnviarCorreo() de la clase cOutlook es donde se crea un nuevo mensaje y se arma según las propiedades anteriormente configuradas. Leer los correos Para leer los correos de la bandeja de entrada invocamos el método LeerMensajes() de la clase cOutlook desde el método Click() del botón "Leer". ZAP IN curMsg IF THISFORM.oCorreo.LeerMensajes(THIS.PARENT.opgTipo.VALUE = 1, 'curMsg')
GO TOP IN curMsg THIS.PARENT.grdMensajes.SETFOCUS ELSE MESSAGEBOX('No existen mensajes para traer', 64, 'Aviso') ENDIF THIS.PARENT.edtCuerpo.REFRESH En la llamada al método LeerMensajes() creamos un objeto loInbox y traemos todos los mensajes, o solo los mensajes "No leídos" y recorremos uno a uno para cargarlos en un cursor que luego mostraremos en una Cuadrícula y un Cuadro de Edición. Definición de la clase cOutlook En este ejemplo disponemos de una clase definida por el usuario, llamada cOutlook con los distintos métodos para realizar el envío y la lectura de los correos. La definición de esta clase es la siguiente: DEFINE CLASS cOutlook AS CUSTOM *-- Propiedades oOutlook = .NULL. oNameSpace = .NULL. cPerfil = '' cContrasenia = '' cTema = '' cCuerpo = '' DIMENSION aTo(1) AS CHARACTER DIMENSION aCC(1) AS CHARACTER DIMENSION aBCC(1) AS CHARACTER DIMENSION aAdjuntos(1) AS CHARACTER *-------------------------------------------------* Creo el servidor de automatización *-------------------------------------------------PROCEDURE CrearServidor() LOCAL loErr1 AS EXCEPTION, loErr2 AS EXCEPTION, llRet AS Logical WITH THIS *-- Manejo el error con TRY ... CATH ... FINALLY TRY *-- Instancio el objeto .oOutlook = GETOBJECT( , 'Outlook.Application') WAIT WINDOW 'Ya existe una instancia de Outlook...' TIMEOUT 2 CATCH TO loErr1 TRY *-- Creo el objeto .oOutlook = CREATEOBJECT('Outlook.Application') WAIT WINDOW 'Nueva instancia de Outlook...' TIMEOUT 2 CATCH TO loErr2 MESSAGEBOX('Microsoft Outlook no está instalado.', 16, 'Problemas!!!') FINALLY ENDTRY FINALLY ENDTRY IF VARTYPE(.oOutlook) = 'O' .oNameSpace = .oOutlook.GetNameSpace('MAPI') IF VARTYPE(.oNameSpace) = 'O' llRet = .T.
ENDIF ENDIF ENDWITH RETURN llRet ENDPROC *-------------------------------------------------* Cierro el servidor de automatización *-------------------------------------------------PROCEDURE CerrarServidor() THIS.oOutlook.QUIT() RETURN ENDPROC *-------------------------------------------------* Iniciar sesion *-------------------------------------------------PROCEDURE IniciarSesion() LOCAL llRet AS Logical TRY THIS.oNameSpace.Logon(THIS.cPerfil, THIS.cContrasenia) llRet = .T. CATCH *-- No pudo iniciar sesión llRet = .F. FINALLY ENDTRY RETURN llRet ENDPROC *-------------------------------------------------* Cerrar sesion *-------------------------------------------------PROCEDURE CerrarSesion() THIS.oNameSpace.Logoff() RETURN ENDPROC *-------------------------------------------------* Envio el correo *-------------------------------------------------PROCEDURE EnviarCorreo() LOCAL loMensaje AS OBJECT, llRet AS Logical LOCAL lnI AS INTEGER, lnIndex AS INTEGER *-- Creo un nuevo mensaje WITH THIS loMensaje = .oOutlook.CreateItem(0) IF VARTYPE(loMensaje) = 'O' loMensaje.Subject = .cTema loMensaje.Body = .cCuerpo *-- Recipientes lnIndex = 0 *-- TO lnLen = ALEN(.aTO) FOR lnI = 1 TO lnLen
IF NOT EMPTY(.aTO(lnI)) lnIndex = lnIndex + 1 loMensaje.Recipients.ADD(.aTO(lnI)) loMensaje.Recipients(lnIndex).TYPE = 1 ENDIF ENDFOR *-- CC lnLen = ALEN(.aCC) FOR lnI = 1 TO lnLen IF NOT EMPTY(.aCC(lnI)) lnIndex = lnIndex + 1 loMensaje.Recipients.ADD(.aCC(lnI)) loMensaje.Recipients(lnIndex).TYPE = 2 ENDIF ENDFOR *-- BCC lnLen = ALEN(.aBCC) FOR lnI = 1 TO lnLen IF NOT EMPTY(.aBCC(lnI)) lnIndex = lnIndex + 1 loMensaje.Recipients.ADD(.aBCC(lnI)) loMensaje.Recipients(lnIndex).TYPE = 3 ENDIF ENDFOR *-- Adjuntos lnLen = ALEN(.aAdjuntos) FOR lnI = 1 TO lnLen IF NOT EMPTY(.aAdjuntos(lnI)) AND FILE(.aAdjuntos(lnI)) loMensaje.Attachments.ADD(.aAdjuntos(lnI)) ENDIF ENDFOR llRet = loMensaje.SEND ELSE llRet = .F. ENDIF ENDWITH RETURN llRet ENDPROC *-------------------------------------------------* Lee los mensajes según parámetro *-------------------------------------------------PROCEDURE LeerMensajes(tlNoLeidos, tcAlias) LOCAL loInbox AS 'Outlook.MAPIFolder', loMensajes AS 'Outlook.Items' LOCAL loMsg AS OBJECT, lnI AS INTEGER, llRet AS Logical IF EMPTY(tcAlias) tcAlias = 'curMsg' ENDIF *-- Inbox loInbox = THIS.oNameSpace.GetDefaultFolder(6) *-- Mensajes del Inbox
IF tlNoLeidos loMensajes = loInbox.Items.RESTRICT("[Unread] = True") ELSE loMensajes = loInbox.Items ENDIF IF VARTYPE(loMensajes) = 'O' WITH loMensajes IF .COUNT > 0 *-- Recorro los mensajes FOR lnI = 1 TO .COUNT loMsg = .ITEM(lnI) WITH loMsg INSERT INTO (tcAlias) (EnviadoPor, Tema, Recibido, Cuerpo, NoLeido) ; VALUES (.SenderName, .Subject, .ReceivedTime, .Body, .UnRead) ENDWITH ENDFOR llRet = .T. ELSE llRet = .F. ENDIF ENDWITH ELSE llRet = .F. ENDIF RETURN llRet ENDPROC *-------------------------------------------------* Destroy *-------------------------------------------------PROCEDURE DESTROY() WITH THIS .oNameSpace = .NULL. .oOutlook = .NULL. ENDWITH ENDPROC *-------------------------------------------------* Cargo una Matriz con los destinatarios *-------------------------------------------------PROCEDURE CargarVector(tcTexto, tcVector) LOCAL ln AS INTEGER, lnI AS INTEGER, la(1) AS CHARACTER IF EMPTY(tcTexto) RETURN 0 ENDIF tcTexto = CHRTRAN(tcTexto,',',';') ln = ALINES(la, tcTexto, .T., ';') lcV = "This." + tcVector DIMENSION &lcV.(ln) FOR lnI = 1 TO ln &lcV.(lnI) = la(lnI) ENDFOR RETURN ln
ENDPROC ENDDEFINE && Clase cOutlook A la definición de la clase, como así también los formularios, y el ejemplo los podemos descargar del siguiente vínculo: outlook.zip para su evaluación. Los ejemplos están realizados con Visual FoxPro 8 y Outlook 2002 (Outlook XP). Una forma fácil de crear un formulario por código como un explorador de internet. PUBLIC oForm oForm = NEWOBJECT("MiExplorador") oForm.SHOW DEFINE CLASS MiExplorador AS FORM TOP = 0 LEFT = 0 DOCREATE = .T. CAPTION = "PortalFox :: Nada corre como un zorro" WINDOWSTATE = 0 NAME = "Form1" WIDTH = 800 HEIGHT = 600 ADD OBJECT olecontrol1 AS OLECONTROL WITH ; TOP = 10, ; LEFT = 10, ; WIDTH = 780, ; HEIGHT = 580, ; NAME = "Olecontrol1", ; OLECLASS = "Shell.Explorer.2" PROCEDURE RESIZE THIS.olecontrol1.HEIGHT = THIS.HEIGHT - 20 THIS.olecontrol1.WIDTH = THIS.WIDTH - 20 ENDPROC PROCEDURE olecontrol1.REFRESH NODEFAULT ENDPROC PROCEDURE olecontrol1.INIT THIS.NAVIGATE("http://www.portalfox.com") ENDPROC ENDDEFINE MOSTRAR UNA PAGINA WEB DESDE TU PROGRAMA DE VFP Una mas sobre las Fox Foundation Classes, en esta ocasión, cómo mostrar una pagina Web en un formulario de Visual FoxPro. Pueden revisar las Fox Foundation Classes (FFCs) para saber cómo funciona: Utilities -> Component Gallery -> Internet -> Web Broser Control Un ejemplo sencillo sobre esto: loBrowser=NEWOBJECT("_webform",HOME()+"gallery\_webview") loBrowser.olewebBROWSER.Navigate2("http://www.portalfox.com") loBrowser.Show(1) NUMERACION DE PAGINAS EN INFORMES CON CAMPOS MEMO En la función de Rafael Angel Ponce Yllanes se tiene el detalle de los campos Memo, lo único que modifique es el NOCONSOLE por el NOWAIT, ... ...con este cambio aun cuando haya campos memos y estos excedan su longitud (la pagina actual), me sale la numeración correctamente. El único detalle es el parpadeo cuando se lanza
el report por primera vez, pero prefiero esto a una numeración incorrecta. ************************************************************ * Función: report_contarpaginas * Devuelve el número de paginas de un report * Parametros: * Nombre del report * Ejemplos: * lntotpaginas = report_contapaginas("minforme") * Retorno: * El numero de paginas del informe. * Notas: * Creación : 08/09/1999 PRR * Ultima Modificación: 14/04/2000 RAPY Rafael Angel Ponce Yllanes * Ultima Modificación: 28/07/2004 LINCEITZ Pablo Alvarez G. ************************************************************ FUNCTION report_contarpaginas(lc_report) LOCAL nPaginas nPaginas = 0 DEFINE WINDOW x FROM 1,1 TO 2,2 ACTIVATE WINDOW x NOSHOW REPORT FORM (lc_report) NOWAIT nPaginas = _PAGENO RELEASE WINDOW x RETURN npaginas ENDFUNC ************************************************************ IMPLEMENTAR UN VISOR DE TEXTO Si deseas mostrar un buen visor de textos que puedes implementar en tus aplicaciones, te damos la manera mas sencilla y con apariencia bastante profesional... Una vez más utilizaremos una clase de las que vienen en las Fox Foundation Classes (FFCs) de Visual FoxPro, en esta ocasión haremos una SubClase basada en _ShowText de la librería de clases _Reports.vcx, para de ésta manera hacerlo mas beneficioso a nuestro propósito. oForm=CREATEOBJECT("MyTextEditor",GETFILE(),"Editando Archivo",2) oForm.SHow(1) DEFINE CLASS myTextEditor as _showtext OF (HOME(1)+"ffc\_reports.vcx") PROCEDURE INIT LPARAMETERS tcSourceFile,; && Path del archivo a Mostrar tcCaption,; Título de la Venta tnWindowState && Estado de la ventana, Normal = 0, Minimizado = 1 , Maximizado =2 DODEFAULT(tcSourceFile) WITH This .Caption = IIF(VARTYPE(tcCaption)='C' AND !EMPTY(tcCaption),tcCaption,"Visor de Texto") .WindowState=IIF(VARTYPE(tnWindowState)='N' AND INLIST(tnWindowState,0,1,2),tnWindowState,0) .cmdClose.Caption="Cerrar" .cmdSave.Caption="Guardar como" .cmdFonts.Caption="Fuentes" .chkReadOnly.Caption="Sólo lectura" ENDWITH ENDPROC
PROCEDURE Activate This.Resize() DODEFAULT() ENDPROC ENDDEFINE Como idea adicional, podrías utilizar tu propio método para generar un reporte o mandar tu reporte a ASCII (REPORT FORM < TuReporte > TO FILE ASCII ) , pasarlo a archivo y mostrarlo.... lcFile = SYS(2015)+".txt" OPEN DATABASE HOME(2)+"data\testdata.dbc" SET TEXTMERGE ON SET TEXTMERGE TO (lcFile) NOSHOW lcTitle="Reporte de Clientes" IF !USED("Customer") USE Customer IN 0 ENDIF SELECT Customer \< < PADC(lcTitle,80," ") > > \Clave < < PADC("Compañia",40," ") > > Contacto SCAN \< < Cust_id > > < < Company > > < < Contact > > ENDSCAN SET TEXTMERGE TO SET TEXTMERGE OFF oForm=CREATEOBJECT("MyTextEditor",lcFile,lcTitle,2) oForm.Show(1) DELETE FILE (lcFile) CLOSE TABLES all CLOSE DATABASES all Nota: Por cuestiones de codificacion HTML tuve que poner espacios entre los mayor-que, menor-que < < > > de la sección TEXTMERGE, quitelos para que funcione correctamente. Nota2: Revise el archivo _reports.h que se localiza en el mismo directorio de la librería de clases, con él se pueden configurar mas opciones de la clase. PREVIEW EN FORMA MAXIMIZADA Y CON DIALOGO DE IMPRESIÓN Preview en forma maximizada y con diálogo de impresión, mucho más fácil y en una sola línea... Esta línea de código me pareció muy buena, lo único que solo funciona de la versión 6.0 en adelante... KEYBOARD '{CTRL+F10}' PLAIN CLEAR REPORT FORM tureporte NOCO TO PRINTER PROMPT PREV INFORME CON VISTA PREVIA MAXIMIZADA Solo hay que hacer ... Esto antes de lanzar el REPORT PREVIEW KEYBOARD "{CTRL+F10}" Conocer el número de paginas totales de un informe ************************************************************ *
* Clase: report_contarpaginas * * Devuelve el número de paginas de un report * * Parametros: * * Nombre del report * * Ejemplos: * * lntotpaginas = report_contapaginas("minforme") * * Retorno * * El numero de paginas del informe. * * Nota * * * Creación : 08/09/1999 PRR * Ultima Modificación: 14/04/2000 RAPY Rafael Angel Ponce Yllanes * ************************************************************ PARAMETERS lc_report LOCAL nPaginas nPaginas = 0 DEFINE WINDOW x FROM 1,1 TO 2,2 ACTIVATE WINDOW x NOSHOW REPORT FORM (lc_report) NOCONSOLE nPaginas = _PAGENO RELEASE WINDOW x RETURN npaginas NOTA: gracias a Jose Luis Santana Blasco y a Rafael Angel Ponce Yllanes por la aclaración del NOCONSOLE, con esto se mejora mucho la velocidad. Nota: Se ha reportado que con Campos MEMO, si se utiliza la propiedad STRETCH WITH OVERFLOW suelen ocurrir resultados inesperados Obtener la dirección IP local de la maquina. loSock = CREATEOBJECT('MSWinsock.Winsock.1') ? loSock.LocalIP loSock = .NULL. COMPRIMIR ARCHIVOS CON WINRAR Has deseado tener un programa en donde este archivado todas las rutas de carpetas a comprimir y con especificaciones de tipos de archivos y una ruta de almacenamiento, y solo dar un click para iniciar el proceso de respaldo. *** crea un tabla que contenga la ruta de almacenamiento, en donde se almacenaran tus respaldos *** ejemplo: resplado.dbf, con el campo "Almacena" y guardar "e:\backup" *** crea
