7 de noviembre de 2009

Combobox con busqueda incremental, abierto y desplegado

Me surgio la necesidad de realizar una busqueda incremental que, además me permitiera, en caso de no encontrar coincidencias, teclear un valor nuevo. Tras revisar las news y Portalfox, encontré diversas soluciones, la mayoría utilizando un textbox y un grid.

Yo queria algo más sencillo y encontré ejemplos con combobox, pero ninguno combinaba mis 3 exigencias: busqueda incremental, abierto a nuevos valores, y con la lista desplegada y activa.

Combinando varios artículos y añadiendo nuevo código conseguí lo que deseaba.

Aquí os dejo el código.
********************************
PUBLIC oform1
oform1 = NEWOBJECT("form1")
oform1.SHOW
RETURN

DEFINE CLASS form1 AS FORM
  TOP = 0
  LEFT = 0
  HEIGHT = 190
  WIDTH = 480
  DOCREATE = .T.
  CAPTION = "Form1"
  NAME = "Form1"

  ADD OBJECT combo1 AS COMBOBOX WITH ;
    COMMENT = "", ;
    ROWSOURCETYPE = 2, ;
    HEIGHT = 25, ;
    INCREMENTALSEARCH = .T., ;
    LEFT = 30, ;
    SELECTONENTRY = .T., ;
    TABINDEX = 2, ;
    TOP = 28, ;
    WIDTH = 350, ;
    INPUTMASK = "", ;
    NAME = "Combo1"

  ADD OBJECT label4 AS LABEL WITH ;
    AUTOSIZE = .T., ;
    FONTBOLD = .T., ;
    BACKSTYLE = 0, ;
    CAPTION = "Uno de la lista o nuevo, desplegado", ;
    HEIGHT = 17, ;
    LEFT = 30, ;
    TOP = 12, ;
    WIDTH = 207, ;
    TABINDEX = 4, ;
    FORECOLOR = RGB(88,99,124), ;
    NAME = "Label4"

  ADD OBJECT command1 AS COMMANDBUTTON WITH ;
    TOP = 12, ;
    LEFT = 408, ;
    HEIGHT = 36, ;
    WIDTH = 49, ;
    CAPTION = "Salir", ;
    TABINDEX = 3, ;
    NAME = "Command1"

  PROCEDURE LOAD
    CAPSLOCK(.F.) && simulo trabajar con minusculas
    PUBLIC mf
    mf = SYS(2015)
    OPEN DATABASE (HOME(2) + "Northwind\Northwind.dbc")
    SELECT 0
    USE Customers
  ENDPROC

  PROCEDURE combo1.INIT
    * Creo propiedad para almacenar configuracion CapsLock
    IF PEMSTATUS(THIS,'lCaps',5) = .F.
      WITH THIS
        .ADDPROPERTY('lCaps',.F.)
      ENDWITH
    ENDIF
    THIS.COMMENT = ''
  ENDPROC

  PROCEDURE combo1.KEYPRESS
    LPARAMETERS nKeyCode, nShiftAltCtrl
    IF BETWEEN(nKeyCode, 32, 122)
      * Primero comprueba la lista
      FOR X=1 TO THIS.LISTCOUNT
        IF UPPER(SUBSTR(THIS.LIST(X), 1, THIS.SELSTART+1)) == ;
            UPPER(SUBSTR(THIS.TEXT, 1, THIS.SELSTART)+CHR(nKeyCode))
          NCURPOS = THIS.SELSTART + 1
          THIS.VALUE = THIS.LIST(X)
          THIS.SELSTART = NCURPOS
          THIS.SELLENGTH = LEN(LTRIM(THIS.LIST(X))) - NCURPOS
          THIS.COMMENT = SUBSTR(THIS.LIST(X),1,NCURPOS)
          NODEFAULT
          EXIT
        ENDIF
      NEXT X
      * Si no está en la lista
      IF X > THIS.LISTCOUNT
        NCURPOS = LEN(THIS.COMMENT) + 1
        THIS.COMMENT = THIS.COMMENT + CHR(nKeyCode)
        THIS.DISPLAYVALUE = THIS.COMMENT
        THIS.SELSTART = NCURPOS
        NODEFAULT
      ENDIF
    ENDIF
    * Si pulsamos Retroceso o flecha izda.
    IF nKeyCode = 127 OR nKeyCode = 19
      NCURPOS = LEN(THIS.COMMENT) -1
      THIS.COMMENT = LEFT(THIS.COMMENT, NCURPOS)
      THIS.DISPLAYVALUE = THIS.COMMENT
      THIS.SELSTART = NCURPOS
      NODEFAULT
    ENDIF
    IF nKeyCode = 13
      THIS.LOSTFOCUS
    ENDIF
  ENDPROC

  PROCEDURE combo1.LOSTFOCUS
    THIS.ROWSOURCE = ''
    USE IN SELECT('curcombo')
    * Devolvemos config. inicial CapsLock
    CAPSLOCK(THIS.lcaps)
    * Tiempo busqueda incremental predeterminado
    _INCSEEK = 0.5
    *
    *  El dato introducido / seleccionado, se encuentra
    *  en la propiedad 'DisplayValue'.
    *
  ENDPROC

  PROCEDURE combo1.GOTFOCUS
    THIS.lcaps = CAPSLOCK()
    IF CAPSLOCK() = .F.
      CAPSLOCK(.T.) && Fuerzo a mayúsculas
    ENDIF
    _INCSEEK = 5.5 && Tiempo busqueda incremental al maximo
    LOCAL cFile, cCampo
    cFile='customers' && Tabla de la que tomar los datos
    cCampo='upper(ltrim(companyname))' && campo a mostrar
    SELECT &cCampo AS cDato FROM &cFile DISTINCT WHERE !EMPTY(&cCampo) ;
      ORDER BY cDato INTO CURSOR curcombo nofilter
    THIS.ROWSOURCE = 'curcombo' && Establecemos origen de datos
    KEYBOARD '{ALT+DNARROW}' && Desplegamos lista
    *
    *  Si le pasamos un valor previo (en la propiedad 'DisplayValue'),
    *  simulamos haberlo tecleado para que se situe en la lista.
    *
    IF !EMPTY(THIS.DISPLAYVALUE)
      cTexto = THIS.DISPLAYVALUE
      FOR yy = 1 TO LEN(cTexto)
        cLetra = SUBSTR(cTexto, yy, 1)
        KEYBOARD cLetra
      ENDFOR
    ENDIF
  ENDPROC

  PROCEDURE command1.CLICK
    * El dato lo obtenemos de la propiedad 'DisplayValue'
    IF !EMPTY(ALLTRIM(THISFORM.combo1.DISPLAYVALUE))
      =MESSAGEBOX(THISFORM.combo1.DISPLAYVALUE)
    ENDIF
    USE IN SELECT('customers')
    CLOSE ALL
    RELEASE mf
    THISFORM.RELEASE
  ENDPROC

ENDDEFINE
*-- EndDefine: form1
**************************************************
Jose Antonio Blasco

6 de septiembre de 2009

VFP y la Automatización de Outlook

Introducción

Me motivó a escribir este artículo el haber visto desde hace algún tiempo (ay, desde hace BASTANTE tiempo), centenas (o millares) de mensajes en el Grupo FoxBrasil sobre el tema "¿Cómo envío un email desde VFP?".

Quienes me conocen del Grupo saben que adoro estudiar, investigar, y principalmente usar, OLE Automation. Pero veamos, ¿qué significa esta sigla? OLE son las iniciales de Object Linking and Embedding. Formidable, ¿y esto qué es?, dirá usted. OLE Automation es la posibilidad que determinadas aplicaciones tienen de exponer su funcionamiento (PEMs: propiedades, eventos y métodos) a otra aplicación cualquiera. Es como si pudiésemos, por ejemplo, empaquetar Microsoft Word como un objeto e incluirlo dentro de nuestra aplicación VFP (o VB, o VBA, o JavaScript, etc).

Digamos que en un sistema para controlar la suscripción a una revista, es necesario recordar al responsable del sector de cobranzas que un día determinado debe verificar que las cuotas de los suscriptores han sido pagadas. Ese día no es fijo para todos los suscriptores, sino que es determinado por la fecha de suscripción. Así que deberíamos montar una agenda dentro de nuestro sistema para que esta persona sea avisada, ¿verdad? No necesariamente, ya que esta persona utiliza Outlook 2000, y Outlook 2000 es un servidor OLE; o sea que podemos, dentro de VFP, manipular el Outlook 2000 y ejecutar una determinada tarea, tal como abrir una entrada en el calendario, introducir los datos necesarios y guardarlos. P> ¿Es fácil? No, no lo es hasta que tenga en sus manos la documentación del servidor OLE (el Modelo de Objetos) y (en muchas oportunidades) ésta es la tarea más ardua.

Pretendo, de acuerdo a mi tiempo libre y a la paciencia de mi familia, escribir una serie de artículos sobre el Modelo de Objetos de Microsoft Outlook, Internet Explorer y Lotus Notes, aunque como comencé a estudiar éste último hace poco, no se si será posible. Por motivos didácticos, comenzaremos esta serie de artículos por Outlook, y me gustaría aclarar que esta serie está basada en otra, escrita por Andrew Ross MacNeill para la revista FoxPro Advisor.

Microsoft Outlook

Outlook es una herramienta de productividad que incluye Calendario, Correo electrónico (e-mail), Contactos y Tareas (como ítems principales). Utilizo la versión más reciente, Outlook 2000, así que todas las referencias serán en relación a esta versión. El Modelo de Objetos de Outlook 2000 puede ser consultado en el archivo VBAOUTL9.CHM. Si no lo tiene instalado, envíeme un mensaje y se lo haré llegar. Como se puede ver en la Figura 1, el objeto Application es el primero de la jerarquía. Ese objeto no sirve para mucho, pero es la puerta de entrada. Aunque Outlook sea usado para una serie de cosas, es primordialmente un paquete de e-mail. Por esta razón, utiliza MAPI, Messaging Application Programming Interface.


Figura 1 - Modelo de Objetos de Microsoft Outlook 2000.

Al abrir Outlook, éste crea una referencia a un objeto MAPI NameSpace. Ese objeto almacena referencias a la ubicación de las Carpetas, ítems y configuraciones usadas por Outlook. ¿Saltamos al interior? Vamos, echemos una mirada a este código:

LOCAL loApplication, loNameSpace, loContacts, loInbox, lcMessage

loApplication = CREATEOBJECT("Outlook.Application")
loNameSpace   = loApplication.GetNameSpace("MAPI")

loContacts    = loNameSpace.GetDefaultFolder(10)
loInbox       = loNameSpace.GetDefaultFolder(6)

lcMessage     = "Nombre del Folder 'Contacts': " + CHR(9) + loContacts.Name + CHR(13) + CHR(10)+;
                "Nombre del Folder 'Inbox': "    + CHR(9) + loInbox.Name

MSGSVC(lcMessage)

RELEASE ALL

RETURN

Primero llamamos a Outlook y creamos el objeto NameSpace (siempre comenzamos así), después, usamos el método GetDefaultFolder para obtener una referencia (otro objeto) a algunos de los Folders (carpetas) más usados y, finalmente, mostramos sus nombres. La Tabla 1 muestra la lista de parámetros posibles para el método GetDefaultFolder.

Parámetro Folder
3 Deleted Items (Elementos eliminados)
4 OutBox (Bandeja de salida)
5 Sent Items (Elementos enviados)
6 Inbox (Bandeja de entrada)
9 Calendar (Calendario)
10 Contacts (Contactos)
11 Journal (Diario)
12 Notes (Notas)
13 Tasks (Tareas)
16 Drafts (Borrador)

Esta estrategia funciona bien con los Folders "padre", pero ¿si deseamos saber el contenido de la Bandeja de entrada? Para eso vamos a usar la propiedad Folders que todo objeto Folder posee. Vea el siguiente ejemplo:

LOCAL loApplication, loNameSpace, loInbox, lnContador, loFolder

loApplication = CREATEOBJECT("Outlook.Application")
loNameSpace   = loApplication.GetNameSpace("MAPI")

loInbox       = loNameSpace.GetDefaultFolder(6)

FOR lnContador = 1 TO loInbox.Folders.Count

    loFolder = loInbox.Folders(lnContador)
 
    MSGSVC("Folder: " + loFolder.Name)

ENDFOR

RELEASE ALL

RETURN

Primero seleccionamos la Bandeja de entrada, verificamos el número de Folders contenidos y mostramos sus nombres. Es bueno recordar que podemos hacer referencia a un Folder por su número (Folders(4)) o por su nombre (Folders("Bandeja de entrada")).

Cada Folder tiene una colección de ítems. Use la propiedad Count para saber el número de ítems. Así podemos modificar ligeramente nuestro programa para que también muestre el número de ítems contenidos en cada Folder:

LOCAL loApplication, loNameSpace, loInbox, lnContador, loFolder, lcMensagem

loApplication = CREATEOBJECT("Outlook.Application")
loNameSpace   = loApplication.GetNameSpace("MAPI")

loInbox       = loNameSpace.GetDefaultFolder(6)

FOR lnContador = 1 TO loInbox.Folders.Count

    loFolder   = loInbox.Folders(lnContador)
 
    lcMensagem = "Folder: " + CHR(9) + loFolder.Name + CHR(13) + CHR(10) +;
                 "Items: "  + CHR(9) + STR(loFolder.Items.Count)
 
    MSGSVC(lcMensagem)
 
ENDFOR

RELEASE ALL

RETURN

Trabajando con Contactos

El ítem Contactos (ContactItem en nuestro Modelo de Objetos) almacena diversas informaciones sobre un determinado Contacto. Para cada ítem, es posible almacenar 3 direcciones, 3 direcciones de mail, 19 números de Fax, teléfono, etc, y muchos otros datos. Aún así, si estos campos no fuesen suficientes, podemos crear otros definidos por el usuario (propiedad UserProperties). Los campos definidos por el usuarios son almacenados en cada ítem individualmente, o sea que un determinado registro puede tener un campo que los otros no posean. De esta manera, para recuperar algunos datos sobre nuestros Contactos tendríamos:

LOCAL loApplication, loNameSpace, loContacts, lnContador, loContact, lcMensagem

loApplication = CREATEOBJECT("Outlook.Application")
loNameSpace   = loApplication.GetNameSpace("MAPI")

loContacts    = loNameSpace.GetDefaultFolder(10)

FOR lnContador = 1 TO loContacts.Items.Count

    loContact  = loContacts.Items(lnContador)
 
    lcMensagem = "Contacto: "  + CHR(9) + STR(lnContador)     + CHR(13) + CHR(10) +;
                 "Nombre: "    + CHR(9) + loContact.FirstName + CHR(13) + CHR(10) +;
                 "Apellido: "  + CHR(9) + loContact.LastName  + CHR(13) + CHR(10) +;
                 "Empresa: "   + CHR(9) + loContact.CompanyName

    MSGSVC(lcMensagem)

ENDFOR

RELEASE ALL

RETURN

Agregando y modificando Contactos

Para agregar un nuevo Contacto usamos el método Add y guardamos los cambios con el método Save. Haríamos:

LOCAL loApplication, loNameSpace, loContacts, loNewContact

loApplication = CREATEOBJECT("Outlook.Application")
loNameSpace   = loApplication.GetNameSpace("MAPI")

loContacts    = loNameSpace.GetDefaultFolder(10)

loNewContact  = loContacts.Items.Add()

loNewContact.FirstName   = "Filippo"
loNewContact.LastName    = "Cavalcanti"
loNewContact.FullName    = "Filippo Cavalcanti"
loNewContact.CompanyName = "Global Connection"

loNewContact.Save()   
 
RELEASE ALL

RETURN

Como podrá observar, mi hijo forma parte ahora de su archivo de Contactos. Para eliminarlo, use el método Delete.

Navegando, Ordenando y Buscando Datos

El Modelo de Objetos de Outlook provee métodos para facilitar la navegación dentro de un folder. Con el primer método, contamos el número de ítems dentro de un determinado folder y después, vamos pasando de a uno hasta el último:

LOCAL loApplication, loNameSpace, loContacts, loNewContact

loApplication = CREATEOBJECT("Outlook.Application")
loNameSpace   = loApplication.GetNameSpace("MAPI")

loContacts    = loNameSpace.GetDefaultFolder(10)

loItens       = loContacts.Items

FOR lnContador = 1 TO loItens.Count

    lcMensagem = "Nombre:   " + CHR(9) + loItens.Item(lnContador).FirstName + CHR(13) + CHR(10) +;
                 "Apellido: " + CHR(9) + loItens.Item(lnContador).LastName  + CHR(13) + CHR(10) +;
                 "Empresa:  " + CHR(9) + loItens.Item(lnContador).CompanyName
                 
    MSGSVC(lcMensagem)

ENDFOR

RELEASE ALL

RETURN

Podemos incluir el método Sort para ordenar los ítems por el campo especificado en el primer parámetro. El segundo parámetro indica si deseamos ordenar en orden creciente (.F.) o decreciente (.T.). Así que tendríamos:

LOCAL loApplication, loNameSpace, loContacts, loNewContact

loApplication = CREATEOBJECT("Outlook.Application")
loNameSpace   = loApplication.GetNameSpace("MAPI")

loContacts    = loNameSpace.GetDefaultFolder(10)

loItens       = loContacts.Items

loItens.Sort("[CompanyName]", .T.)

FOR lnContador = 1 TO loItens.Count

    lcMensagem = "Nombre:   " + CHR(9) + loItens.Item(lnContador).FirstName + CHR(13) + CHR(10) +;
                 "Apellido: " + CHR(9) + loItens.Item(lnContador).LastName  + CHR(13) + CHR(10) +;
                 "Empresa:  " + CHR(9) + loItens.Item(lnContador).CompanyName
                 
    MSGSVC(lcMensagem)

ENDFOR

RELEASE ALL

RETURN

Como segundo ejemplo, usamos los métodos GetFirst y GetLast, que devuelven el primer y último ítem de un Folder, respectivamente. Después de posicionados, usamos los métodos GetPrevious y GetNext para movernos arriba y abajo por la lista de un Folder.

Para localizarnos en un ítem determinado, usamos el método Find. El criterio de selección es pasado como único parámetro. Así para listar los contactos cuyo nombre empiecen con la letra "J", tendríamos:

LOCAL loApplication, loNameSpace, loContacts, loItens, loItem, lcMensagem

loApplication = CREATEOBJECT("Outlook.Application")
loNameSpace   = loApplication.GetNameSpace("MAPI")

loContacts    = loNameSpace.GetDefaultFolder(10)

loItens       = loContacts.Items

loItens.Sort("[FirstName]", .F.)

loItem        = loItens.Find("[FirstName]>='J'")

DO WHILE .T.

    IF LEFT(loItem.FirstName, 1) <> "J"
 
        EXIT
  
    ENDIF

    lcMensagem = "Nombre:   " + CHR(9) + loItem.FirstName + CHR(13) + CHR(10) +;
                 "Apellido: " + CHR(9) + loItem.LastName  + CHR(13) + CHR(10) +;
                 "Empresa:  " + CHR(9) + loItem.CompanyName
                 
    MSGSVC(lcMensagem)
 
    loItem     = loItens.FindNext()

ENDDO

RELEASE ALL

RETURN

Conclusión

Este artículo es el primero de una serie sobre OLE Automation y más cosas interesantes están por venir. Usando Outlook para almacenar información de Contactos es posible economizar programas para entrada de datos y eliminar redundancias. En el próximo artículo echaremos una mirada a otras dos áreas de Microsoft Outlook: Tareas y Calendario.


  • Descargue el código fuente AQUI (4 Kb).


José Augusto Cavalcanti

5 de septiembre de 2009

Abrir, Modificar, Guardar e Imprimir archivos .doc usando OpenOffice Writer

El programa utiliza un documento (.odt o .doc) que se usa como modelo en el que se insertan unas etiquetas, que luego son reemplazadas por los datos que provienen de una base de datos. Es la misma idea que usa Word en el Combinar correspondencia ...
local array laNoArgs[1]
local loSManager, loSDesktop, loStarDoc, loReflection, loPropertyValue, loOpenDoc, loCursor, loFandR

loSManager = createobject( "Com.Sun.Star.ServiceManager.1" )

loSDesktop = loSManager.createInstance( "com.sun.star.frame.Desktop" )
comarray( loSDesktop, 10 )

loReflection = loSManager.createInstance( "com.sun.star.reflection.CoreReflection" )
comarray( loReflection, 10 )

loPropertyValue = THISFORM.createStruct( @loReflection, "com.sun.star.beans.PropertyValue" )

laNoArgs[1] = loPropertyValue
laNoArgs[1].name = "ReadOnly"
laNoArgs[1].value = .F.

* crea un archivo nuevo ...
* url = "private:factory/swriter"

* Datos que vienen de la base de datos ...

lcTmp = "nombre del origen de datos"

lcNro_infor = PADL(&lcTmp..nro_infor, 8, '0')
lcDetalle   = &lcTmp..detalle
lcFecha     = DTOC(&lcTmp..fecha)

* Puede usar archivos en los 2 formatos: .odt y .doc
lcArchivoOrigen  = "C:/temp/modelo1.odt"
lcArchivoDestino = "C:/temp/eco" + lcNro_infor + " - " + ALLTRIM(lcDetalle) + ".odt"
*                   c:\temp\eco00112638 - 53565 diaz de rodriguez claudia.odt

lcArchivoOrigen  = "C:/temp/modelo1.doc"
lcArchivoDestino = "C:/temp/eco" + lcNro_infor + " - " + ALLTRIM(lcDetalle) + ".doc"
*                   c:\temp\eco00112638 - 53565 diaz de rodriguez claudia.doc

COPY FILE (lcArchivoOrigen) TO (lcArchivoDestino)

url = "file:///" + lcArchivoDestino

loOpenDoc = loSDesktop.LoadComponentFromUrl(url, "_blank", 0, @laNoargs)

* escribir texto en el documento ...
loCursor = loOpenDoc.text.CreateTextCursor()
loOpenDoc.text.InsertString(loCursor, "HELLO FROM VFP", .f. )

* Objeto para buscar las Marcas en el Documento
* si las marcas son encontradas, son remplazadas
* si alguna marca no existiera, no hay mayor problema, simplemente no se remplaza

loFandR = loOpenDoc.createReplaceDescriptor
loFandR.searchRegularExpression = .T.

loFandR.setSearchString("«nro_infor»")
loFandR.setReplaceString(lcNro_infor)
loOpenDoc.ReplaceAll(loFandR)

loFandR.setSearchString("«fecha»")
loFandR.setReplaceString(lcFecha)
loOpenDoc.ReplaceAll(loFandR)

loFandR.setSearchString("«detalle»")
loFandR.setReplaceString(lcDetalle)
loOpenDoc.ReplaceAll(loFandR)

* imprime el documento
* loOpenDoc.printer()

* graba el documento ...
* loOpenDoc.store()

* grabar con otro nombre ...
* Url = "file:///C:/temp/test3.odt"
* loStarDoc.storeAsURL(URL, @laNoargs)

RETURN

*--------- CreateStruct -----------*
PARAMETERS toReflection, tcTypeName

 local loPropertyValue, loTemp

 loPropertyValue = createobject( "relation" )

 toReflection.forName( tcTypeName ).createobject( @loPropertyValue )
     
return ( loPropertyValue )
El CreateStruct, yo lo uso como un metodo del formulario ...

Marcelo ARDUSSO
Rafaela, Santa Fe. Argentina

* http://wiki.services.openoffice.org/wiki/Documentation/BASIC_Guide/StarDesktop
* http://user.services.openoffice.org/es/forum/viewtopic.php?f=50&t=1306

* vb_oo2.zip <- ejemplo en Visual Basic descargado de La Web del Programador
* http://www.lawebdelprogramador.com

El siguiente es el archivo Modelo 1

Modelo 1
----------------------------------------------
Protocolo Nº «nro_infor»
Fecha «fecha»

Paciente: «detalle»

Estimado/a «detalle»

Esta es una prueba para generar informes en 
WRITER desde un programa de Visual Foxpro 9.0

Sin otro particular lo saludamos atte.

powered by: Visual Foxpro 9.0

23 de agosto de 2009

WAIT WINDOWS centrado en _Screen

A veces deseamos que el mensaje mostrado con el comando WAIT WINDOWS esté centrado en la pantalla de VFP. Aquí una función que lo hace con las consideraciones necesarias cuando la pantalla principal de VFP no esta maximizada y respetando todas las cláusulas adicionales del comando WAIT WINDOWS.

Ejemplos:
lcTexto = "Espere un momento ..." + CHR(13) + ;
  "generando el informe del día " + TRANSFORM(DATE()) + CHR(13) + ;
  "NADA CORRE COMO UN ZORRO"

? WaitWindowsCentrado()

? WaitWindowsCentrado(lcTexto,,5)

? WaitWindowsCentrado(lcTexto,"NOWAIT")

*------------------------------------------------------
* FUNCTION WaitWindowsCentrado(tcTexto, tcOpc, tnTimeout)
* - - - - - - - - - - - - - - - - - - - - - - - - - - -
* Muestra la ventana de WAIT WINDOWS centrada
* USO: WaitWindowsCentrado(tcTexto, tcOpc, tnTimeOut)
* EJEMPLO: WaitWindowsCentrado("Espere un momento...", "NOWAIT", 0)
* RETORNA: Caracter
* AUTOR: LMG
*------------------------------------------------------
FUNCTION WaitWindowsCentrado(tcTexto, tcOpc, tnTimeOut)

  LOCAL lnMaxLen, lnNroLin, lnRelFil, lnRelCol, ;
    lnRows_VFP, lnFil, lnCol, lcRet, lcCmd, ln, la(1)

  *-- Texto del mensaje
  IF EMPTY(tcTexto)
    tcTexto = "Presione una tecla para continuar..."
  ENDIF

  *-- Linea mas larga de tcTexto (si es multilinea)
  lnMaxLen = 0
  lnNroLin = ALINES(la, tcTexto)
  FOR ln = 1 TO lnNroLin
    lnMaxLen = MAX(lnMaxLen,LEN(la(ln)))
  ENDFOR

  *-- Filas de ventana completa _VFP, distinto a WROWS(_SCREEN.NAME)
  lnRows_VFP = _VFP.HEIGHT / FONTMETRIC(1,_SCREEN.FONTNAME,_SCREEN.FONTSIZE)

  *-- Relación entre el tamaño de las
  *-- fuentes de WAIT WINDOWS y _SCREEN
  lnRelFil = FONTMETRIC(1,'Arial',9) / FONTMETRIC(1,_SCREEN.FONTNAME,_SCREEN.FONTSIZE)
  lnRelCol = FONTMETRIC(6,'Arial',9) / FONTMETRIC(6,_SCREEN.FONTNAME,_SCREEN.FONTSIZE)
  lnFil = WLROW(_SCREEN.NAME) + (lnRows_VFP - lnNroLin * lnRelFil) / 2
  lnCol = WLCOL(_SCREEN.NAME) + (WCOLS(_SCREEN.NAME) - lnMaxLen * lnRelCol) / 2

  *-- Armo el Comando
  lcCmd = [WAIT WINDOWS tcTexto TO lcRet AT lnFil,lnCol]

  *-- Cláusulas NOWAIT y NOCLEAR
  IF NOT EMPTY(tcOpc) AND VARTYPE(tcOpc) = "C"
    IF "NOWA" $ UPPER(tcOpc)
      lcCmd = lcCmd + [ NOWAIT]
    ENDIF
    IF "NOCL" $ UPPER(tcOpc)
      lcCmd = lcCmd + [ NOCLEAR]
    ENDIF
  ENDIF

  *-- Cláusula TIMEOUT
  IF NOT EMPTY(tnTimeOut) AND VARTYPE(tnTimeOut) = "N"
    lcCmd = lcCmd + [ TIMEOUT tnTimeOut]
  ENDIF

  *-- Ejecuto el comando
  &lcCmd

  RETURN lcRet
ENDFUNC
Saludos,

Luis María Guayán

12 de agosto de 2009

Corrección Ortográfica en VFP con el Diccionario de MSWord

El siguiente es un código que he adaptado, usando como base un mensaje de Luis María Guayán. Creo haber solucionado algunos problemas. Yo lo estoy usando con éxito. Espero que les sea de utilidad.
PUBLIC oForm
oForm = createobject("claseCorrector")
oForm.show()

DEFINE CLASS claseCorrector AS form
    Autocenter = .T.
    Top = 0
    Left = 0
    Height = 220
    Width = 377
    DoCreate = .T.
    Caption = "Corrector ortográfico de WORD"
    Name = "Form1"

ADD OBJECT edit1 AS editbox WITH ;
    Height = 170, ;
    Left = 10, ;
    TabIndex = 2, ;
    Top = 10, ;
    Width = 358, ;
    ControlSource = "", ;
    Name = "Edit1"

ADD OBJECT command1 AS commandbutton WITH ;
    Top = 185, ;
    Left = 285, ;
    Height = 27, ;
    Width = 84, ;
    Caption = "Ortografía", ;
    TabIndex = 1, ;
    Name = "Command1"

PROCEDURE Init
  LOCAL cString
   cString = "La gran mayoria de programadores Visual FoxPro se recisten a dejar " + ;
             "de programar en este lenguaje porque consideran que es una herramienta " + ;
             "muy poderosa, versátil y robusta que les permite crear aplicaciones " + ;
             "tan poderosas y hasta más estables que las creadas por otros lenguajes. " + ;
             "Incluso programadores que han tenido la oportunidad de desarrollar tanto " + ;
             "en Visual Basic.NET y Visual FoxPro 9.0 coinciden que FoxPro es largamente " + ;
             "superior en cuanto a practicidad y flexibilidad al momento de programar."
   thisform.edit1.Value = cString
ENDPROC

**********************************************************************************
* para incluír en los fuentes de cualquier programa, solo copiar el código       *
* del siguiente procedimiento en el evento "Click" del boton llame al corrector. *
* IMPORTANTE: cambiar el nombre del control que tiene el texto a corregir!       *
**********************************************************************************
PROCEDURE command1.Click
   LOCAL loWord, lnOldMousePointer, loControl
   loControl = Thisform.Edit1    && control que tiene el texto a corregir.
   lnOldMousePointer = loControl.Mousepointer
   loControl.Mousepointer = 11
      WAIT WINDOW NOWAIT "Iniciando la Corrección Ortográfica..."+CHR(13)+;
                         " Espere por favor" TIMEOUT 3
      IF VARTYPE( loWord ) <> 'O'
         loWord = CREATEOBJECT('word.application')
      ENDIF
      IF VARTYPE ( loWord ) = "O"
         loWord.documents.ADD()
         WITH loWord
            .documents(1).content = loControl.VALUE
            .windowstate = 2    && ventana minimizada
            .visible = .T.
            .documents(1).CheckSpelling()  &&Comenzando Corrección Ortográfica...
            .SELECTION.WholeStory
            IF .selection.text <> loControl.VALUE
               loControl.VALUE = .SELECTION.TEXT  
               WAIT WINDOW NOWAIT "Corrección Ortográfica Finalizada..."+CHR(13)+;
                                  " El texto fue reemplazado" TIMEOUT 3             
            ELSE
               WAIT WINDOW NOWAIT "Corrección Ortográfica Finalizada..."+CHR(13)+;
                                  " No se encontraron errores" TIMEOUT 3
            ENDIF
            .documents(1).CLOSE(.F.)
            .QUIT
         ENDWITH
         loWord = .NULL.
         RELEASE loWord
      ELSE
         MESSAGEBOX("Lo siento, no se puedo iniciar Word",48,_SCREEN.CAPTION)
         loControl.Mousepointer = lnOldMousePointer
         RETURN .F.
      ENDIF
   loControl.Mousepointer = lnOldMousePointer
ENDPROC

ENDDEFINE
Jorge Daniel Romero, Río Gallegos, Santa Cruz, Argentina

26 de julio de 2009

Usando formatos de archivos de Excel 2007 en VFP 9.0

Artículo original: Using Excel 2007 File Formats in VFP 9.0
http://www.sweetpotatosoftware.com/SPSBlog/PermaLink,guid,6b9d4c6f-76bb-4444-8d5b-9e321c605534.aspx
Autor: Craig Boyd
Traducido por: Luis María Guayán

Los Problemas

Los comandos APPEND FROM y COPY TO de Visual FoxPro 9.0 son incompatibles con los nuevos formatos de archivo de Excel 2007 (XLS, XLSX, xlsb, y XLSM). Habrá notado que incluí XLS y usted cree que es soportado, pero sólo intente guardar su libro XLS Excel 97-2003 en el modo de compatibilidad de Excel 2007 y, a continuación, utilice el comando APPEND FROM sobre éste. VFP se quejará de la validez del archivo, en resumen, no funciona. Y, el comando COPY TO esta simplemente atascado en los oscuros años del XLS y XL5 disponibles. Bien, entonces todo esto es el primer problema.

El segundo problema con los comandos APPEND FROM y COPY TO es que no permiten especificar las columnas o los campos; una cláusula WHERE o FOR; o especificar un rango o área de impresión. Estamos bastante atascados con especificar un libro, APPEND FROM permite un parámetro opcional para la Hoja, pero eso no es adecuado ni super atractivo.

El tercer problema es que la solución habitualmente sugerida para los problemas de arriba, es utilizar automatización, y la automatización es super lenta debido al consumo efectuado por COM. Esto también introduce una dependencia adicional de tener instalado Excel 2007 en la máquina en la que el código se ejecuta. Lo "lento" nunca es aceptable (las aplicaciones VFP puede tener sus cosas, pero la lentitud no es una de ellas) y la dependencia adicional, aceptable en algunos casos, es un freno si se están ejecutando estos tipos de operaciones sobre un servidor web que no tiene instalado Excel 2007.

La Solución

Yo estaba trabajando en una solución para un cliente mío, que requería que consuma y cree archivos XLS, XLSX, xLSB y XLSM, sin que el usuario necesite tener instalado Excel 2007. Después de lanzar unas pruebas conjuntamente, yo incluí la ayuda de mi amigo Bo Durban. El código proporcionado en un archivo .ZIP al final de este artículo, es lo que surgió después de un par de intensas sesiones de codificación. Un agradecimiento especial a mi cliente por permitir compartirlo.

El Código

El código incluye 2 funciones principales: AppendFromExcel() y CopyToExcel(). También hay 4 funciones de ayuda: AWorkSheets(), AWorkSheetColumns(), CreateExcelTemplate(), y EmptyFieldToNull() que le puede resultar útil o interesante. El código:
  • No requiere de Office 2007
  • Pueden añadir de formatos de archivo xls, xlsx, xlsm, y xlsb
  • Puede crear y copiar a los formatos de archivo xls, xlsx, xlsm, y xlsb
  • Soporta todas las tablas de Excel (hojas de trabajo, rangos, áreas de impresión)
  • Permite que las columnas de la hoja de cálculo y los campos de las tablas puedan ser especificados
  • Permite que la cabecera de la fila en la hoja de trabajo pueda contener espacios en los nombres de las columnas, encerrándolos entre corchetes, por ejemplo [Mi Columna # 1]
  • Proporciona soporte para expresiones con cláusulas WHERE de SQL o cláusula FOR de VFP
  • Es super rápido
  • Probablemente hace algunas otras cosas que no estoy pensando ahora :)
De todas formas, descargue y descomprima el PRG, descomente y/o modifique el código del ejemplo de uso de la parte superior del PRG a su gusto, y diviértase!

Originalmente incluí el código en la parte inferior de este artículo, pero el código hacía locuras con el ancho de este blog, porque contiene algunas líneas muy largas con binarios. Por lo tanto, aquí está el vínculo para la descarga del archivo PRG que contiene las cosas que necesita:

Nota: Adicionalmente una reestructuración del código (refactoring) es necesaria, y definitivamente esto clama por una clase que se deba construir, pero el código funciona completamente como está.
Si tienen algún problema ejecutando el código (especialmente si aparece el diálogo de Seleccionar un origen de datos) es posible que deba comprobar el proveedor OLEDB y observar las alternativas proporcionadas en el código.

11 de julio de 2009

¿Es una variable o propiedad un array?

Entrada original: Is variable or property an array?
http://www.berezniker.com/content/pages/visual-foxpro/-varable-or-property-array
Autor: Sergey Berezniker
Traductor: Luis María Guayán

Cuando validamos un parámetro en una función o procedimiento, a veces es necesario determinar si el parámetro pasado es una matriz (array). Hasta VFP 9.0 no había una manera evidente de hacerlo.

En VFP 9.0 la función TYPE() acepta un segundo parámetro adicional: 1, para determinar si se la expresión pasada es una matriz, una colección o ninguno de los dos. En versiones anteriores de VFP podemos usar la función TYPE() en combinación con la función ALEN().

Este es el código de ejemplo:

&& VFP 9.0
IF TYPE("AlgunaVariableOrPropiedad",1) = "A"
  && Es un array
ENDIF
 
&& VFP 8.0 y anteriores
IF TYPE("ALEN(AlgunaVariableOrPropiedad)")) = "N"
  && Es un array
ENDIF

Comprobar que TYPE("AlgunaVariableOrPropiedad[1]") = "N" no funciona para propiedades intrínsecas de VFP. Retornando "N" para estas.

loForm = CreateObject ( "Form") 
? TYPE("loForm.Top[1]") && Retorna N

9 de julio de 2009

Como generar el numero de nuestros comprobantes sin morir en el intento

Artículo de Maximiliano Accotto (Buenos Aires, Argentina) publicado en su Blog.

Como generar el numero de nuestros comprobantes sin morir en el intento

Maxi AccottoEn muchas de nuestras aplicaciones (por no decir en casi todas) nos vemos en la necesidad de generar números auto incrementales, por ejemplo para la numeración de facturas, remitos, órdenes de compra u otro tipo de documentos.

La solución a esta tarea se puede hacer de distintas maneras. La idea de este artículo es mostrar en SQL Server cómo podemos resolver este problema, y poder analizar sus pros y contras...

Para leer el artículo completo haz click Aquí

5 de julio de 2009

Conocer si tu aplicación ya está en ejecución

He visto algunos ejemplos usando la API de Windows para determinar si tu aplicación ya está en ejecución. Muchos de esos ejemplos utilizan el "caption" de una ventana y con ello puedes tomar acciones en cuanto a permitir la ejecución simultánea de varias instancias o no.

En lugar de permitir varias instancias, mejor permítele hacer varias tareas a la vez dentro de la aplicación.

El ejemplo que les expongo hace uso de WMI de Windows y es bastante sencillo.

En esencia es una consulta sql que nos devuelve los nombres de los procesos que están en ejecución. He dejado los comentarios para explicar que en mi caso muy particular, yo pregunto si la cantidad de procesos es mayor que o igual a 3 (y usando un like en el sql) porque hago uso de dos programas: uno que será el "launcher" el cual buscará el ejecutable compilado más reciente y éste será el que se ejecute (Así no tengo que interrumpir las labores de otros usuarios cuando tenga que hacer alguna correción en otras pantallas)

FUNCTION MyProcessName  
 *.* Determina si el programa de recibo bodega ya está en ejecución.
 *.* De ser así, devuelve un valor lógico que será usado para terminar o continuar con el programa.
 *-* Se debe tomar en cuenta que ReciboBodega es ejecutado usando dos programas: 
 *-* recibo_bodega.exe y recibo_bodegannn.exe
 LOCAL lcComputer as String

 lcComputer = '.'
 loWMIService = Getobject('winmgmts:'+'{impersonationLevel=impersonate}!\\' + lcComputer + '\root\cimv2')
 colProcessList = loWMIService.ExecQuery('Select * from Win32_Process where name like "recibo_bodega%"')
 IF colProcessList.count>=3
  RETURN .T.
 ELSE
  RETURN .F. 
 ENDIF 
ENDFUNC 

Pero en su caso puede preguntar directamente por el nombre de su ejecutable y cuando "count" sea igual a uno, su función regresará un valor Cierto.

Por último, en el su prg principal, en sus primeras líneas deberás poner:

IF MyProcessName()
   RETURN .F.
ENDIF  

Saludos,

Jorge Luis Vejerano, Panamá

17 de mayo de 2009

Ampliar la vista de un formulario

Después de activar la casilla correspondiente, la parte del formulario bajo el cursor del mouse, se re dibuja en la ventana principal de foxpro como visto con una lupa.


*-- Aquí el código:
LOCAL oForm
oForm = CREATEOBJECT("Tform")
oForm.SHOW(1)

DEFINE CLASS Tform AS FORM
  WIDTH = 350
  HEIGHT = 160
  BORDERSTYLE = 2
  MAXBUTTON = .F.
  MINBUTTON = .F.
  AUTOCENTER = .T.
  CAPTION = "Ampliar vista"
  hForm = 0
  hDC = 0

  ADD OBJECT chMagnify AS CHECKBOX WITH VALUE=.F.,;
    LEFT=20, TOP=20, AUTOSIZE=.T., CAPTION="Activar"

  ADD OBJECT chInvert AS CHECKBOX WITH VALUE=.F.,;
    LEFT=20, TOP=56, AUTOSIZE=.T., CAPTION="Invertir colores"

  ADD OBJECT lbl1 AS LABEL WITH;
    LEFT=190, TOP=20, AUTOSIZE=.T., CAPTION="Escala:"

  ADD OBJECT cmbScale AS COMBOBOX WITH STYLE=2,;
    LEFT=240, TOP=20, WIDTH=70, HEIGHT=21

  ADD OBJECT cmdClose AS COMMANDBUTTON WITH CANCEL=.T.,;
    LEFT=140, TOP=112, WIDTH=70, HEIGHT=27, CAPTION="Cerrar"

  PROCEDURE INIT
    THIS.DECLARE

  PROCEDURE ACTIVATE
    IF THIS.hForm = 0
      THIS.hForm = GetFocus()
      THIS.hDC = GetDC(THIS.hForm)
    ENDIF

  PROCEDURE DESTROY
    IF THIS.hDC <> 0
      = ReleaseDC(THIS.hForm, THIS.hDC)
    ENDIF

  PROCEDURE cmdClose.CLICK
    THISFORM.RELEASE

  PROCEDURE cmbScale.INIT
    WITH THIS
      .ADDITEM("Normal")
      .ADDITEM("x 2")
      .ADDITEM("x 3")
      .ADDITEM("x 4")
      .LISTINDEX=3
    ENDWITH

  PROCEDURE MOUSEMOVE
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
    THIS.Magnify

  PROCEDURE chMagnify.MOUSEMOVE
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
    THISFORM.Magnify

  PROCEDURE chInvert.MOUSEMOVE
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
    THISFORM.Magnify

  PROCEDURE lbl1.MOUSEMOVE
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
    THISFORM.Magnify

  PROCEDURE cmbScale.MOUSEMOVE
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
    THISFORM.Magnify

  PROCEDURE cmdClose.MOUSEMOVE
    LPARAMETERS nButton, nShift, nXCoord, nYCoord
    THISFORM.Magnify

  PROCEDURE Magnify
    #DEFINE SRCCOPY 0xCC0020
    #DEFINE NOTSRCCOPY 0x00330008
    #DEFINE cnDstWidth 600
    #DEFINE cnDstHeight 300

    IF THIS.chMagnify.VALUE
      LOCAL cBuffer, nX, nY, hDstWin, hDstDC,;
        nMode, nSrcWidth, nSrcHeight, nScale

      hDstWin = GetActiveWindow()
      hDstDC = GetWindowDC(hDstWin)

      cBuffer = REPLICATE(CHR(0), 8)
      = GetCursorPos(@cBuffer)
      = ScreenToClient(THIS.hForm, @cBuffer)

      nX = buf2dword(SUBSTR(cBuffer, 1,4))
      nY = buf2dword(SUBSTR(cBuffer, 5,4))

      nScale = THIS.cmbScale.LISTINDEX
      nSrcWidth = INT(cnDstWidth/nScale)
      nSrcHeight = INT(cnDstHeight/nScale)

      nMode = IIF(THIS.chInvert.VALUE,;
        NOTSRCCOPY, SRCCOPY)

      = StretchBlt(hDstDC, 10, 100,;
        cnDstWidth, cnDstHeight, THIS.hDC,;
        nX-nSrcWidth/2, nY-nSrcHeight/2,;
        nSrcWidth, nSrcHeight, nMode)

      = ReleaseDC(hDstWin, hDstDC)
    ENDIF

  PROCEDURE DECLARE
    DECLARE INTEGER GetActiveWindow IN user32
    DECLARE INTEGER GetCursorPos IN user32 STRING @lpPoint
    DECLARE INTEGER GetWindowDC IN user32 INTEGER HWND
    DECLARE INTEGER GetDC IN user32 INTEGER HWND
    DECLARE INTEGER GetFocus IN user32

    DECLARE INTEGER ReleaseDC IN user32;
      INTEGER hWindow, INTEGER hdc

    DECLARE INTEGER ScreenToClient IN user32;
      INTEGER hWindow, STRING @lpPoint

    DECLARE INTEGER StretchBlt IN gdi32;
      INTEGER hdcDest, INTEGER nXOriginDest,;
      INTEGER nYOriginDest, INTEGER nWidthDest,;
      INTEGER nHeightDest, INTEGER hdcSrc,;
      INTEGER nXOriginSrc, INTEGER nYOriginSrc,;
      INTEGER nWidthSrc, INTEGER nHeightSrc,;
      INTEGER dwRop

ENDDEFINE

FUNCTION buf2dword(lcBuffer)
  RETURN ASC(SUBSTR(lcBuffer, 1,1)) + ;
    BITLSHIFT(ASC(SUBSTR(lcBuffer, 2,1)), 8) +;
    BITLSHIFT(ASC(SUBSTR(lcBuffer, 3,1)), 16) +;
    BITLSHIFT(ASC(SUBSTR(lcBuffer, 4,1)), 24)

Saludos.

Jesus Caro V

2 de mayo de 2009

Como acelerar las consultas en MySQL

Aunque MySQL lleva su propio sistema de optimización cuando lanzamos un "Query SQL", nos es posible mediante programación elegir el índice que utilizará el MySQL en cada una de las tablas para optimizar nuestra consulta.

Como es mejor un ejemplo que mil palabras, vamos a ilustrar un pequeño ejemplo desde nuestro querido Fox.

Creamos en nuestra BBDD de MySQL una pequeña tabla de apuntes contables. Con varios índices (No.Apunte,SubCuenta,Fecha etc).
DROP TABLE IF EXISTS apuntes;

CREATE TABLE apuntes (
  apunte decimal(8,0) default '0.00',
  fecha date default '2009-01-01',
  texto varchar(40) collate utf8_spanish_ci default '',
  cuenta varchar(10) collate utf8_spanish_ci default '0000000000',
  debe decimal(12,2) default '0.00',
  haber decimal(12,2) default '0.00',
  PRIMARY key  (apunte),
  key K01 (fecha),
  key K02 (cscta))
ENGINE = InnoDB DEFAULT CHARSET=utf8 COLLATE=utf8_spanish_ci ROW_FORMAT=DYNAMIC ;

Una vez visto el ejemplo de tabla, vamos a crear nuestra consulta en nuestro querido Fox. Y dependiendo de los datos que queramos extraer de la tabla, elegiremos que la consulta sea optimizada por un índice determinado.
*******************************************************************
*  Ejemplo de Consulta Optimizada para MySQL
*******************************************************************

KNDX = 'K01'
DO FORM FCONSULTA    && (FORMULARIO DE CAPTURA DE VARIABLES)
IF T1APTS = T2APTS
  KNDX = 'PRIMARY'
ENDIF

IF T1FECHA = T2FECHA
  KNDX = 'K01'
ENDIF

IF T1CUENTA = T2CUENTA
  KNDX = 'K02'
ENDIF

TEXT TO XSQL TEXTMERGE NOSHOW
  SELECT  *
    FROM  apuntes FORCE INDEX(<<KNDX>>)
    WHERE apunte >= ?T1APTS AND apunte <= ?T2APTS AND
    fecha >= ?T1FECHA AND fecha <= ?T2FECHA AND
    cuenta >= ?T1CUENTA AND cuenta <= ?T2CUENTA
    ORDER BY apunte,fecha 
ENDTEXT

SQLPREPARE(NH, '' + XSQL, 'TCURSOR')

DO WHILE SQLEXEC(NH) = 0
ENDDO

BROWSE

*******************************************************************

Espero que el código anterior sea descriptivo de lo que os quiero transmitir.
En el ejemplo anterior utilizamos la variable KNDX que es la que almacena el índice que queremos utilizar para optimizar nuestra consulta. Por defecto en este ejemplo concreto ponemos el valor del indice fecha 'K01'. Y utilizamos la orden FORCE INDEX para forzar al MySQL que utilice el índice que le indicamos en cada consulta dependiendo de los valores que queramos extraer en cada momento.

En tablas relativamente pequeñas es posible que no se aprecie rendimiento alguno. Pero en consulta a tablas con mas de 2 Millones de registros, como es mi caso. Os aseguro que el rendimiento es exponencial.

Un cordial saludo a la comunidad Fox.

Antonio L. Montagut
www.ontarioxb.es

26 de abril de 2009

Utilizando _MemberData con el objeto _Screen

Por lo general no acostumbro utilizar variables públicas en mis aplicaciones. Siempre uso el objeto _SCREEN, le adiciono propiedades con valores que estarán disponibles para toda la aplicación. No obstante, al programar y usar Intellisense la presentación de las propiedades del objeto _SCREEN en el código se muestran siempre en minúsculas, lo cual me dejaba un tanto insatisfecho, dado que esto no ocurría con mis otras clases porque les añadía la propiedad _MemberData y lograba una mejor presentación en mi código.

Así que un día pensé, ¿qué pasaría si al objeto _SCREEN le agrego la propiedad _MemberData y le asigno el valor requerido?

Pues me di con la sorpresa que también funciona, y ahora con el Intellisense puedo tener en mi código una mejor presentación.




Les adjunto un pequeño código que se puede perfeccionar. Si por ejemplo, guardamos nuestras variables en una tabla junto con sus valores, usando SCAN podemos recorrerla e ir formando la cadena requerida para la propiedad _MemberData y a la vez ir agregando nuestras propiedades al objeto _SCREEN con el método AddProperty().
* Ejemplo de _MemberData en _Screen en VFP9 SP2

* Formando la propiedad _MemberData en formato XML
LOCAL cMemberData as String 
TEXT TO cMemberData NOSHOW PRETEXT 15
  <VFPData>
  <memberdata name="cconectbdsistema" type="property" display="cConectBDSistema"/>
  <memberdata name="cconnectioncatastro" type="property" display="cConnectionCatastro"/>
  <memberdata name="cconnectionrentas" type="property" display="cConnectionRentas"/>
  <memberdata name="cconnectionstring" type="property" display="cConnectionString"/>
  <memberdata name="cconnectiontramite" type="property" display="cConnectionTramite"/>
  <memberdata name="cconnectioncuentacte" type="property" display="cConnectionCuentaCte"/>
  </VFPData>
ENDTEXT 
_Screen.AddProperty("_MemberData", cMemberData)

* Agregando mis propiedades
_Screen.AddProperty("cconectbdsistema","")
_Screen.AddProperty("cconnectioncatastro","")
_Screen.AddProperty("cconnectionrentas","")
_Screen.AddProperty("cconnectionstring","")
_Screen.AddProperty("cconnectiontramite","")
_Screen.AddProperty("cconnectioncuentacte","")
Espero que les sirva.

Miguel Herbias, Lima, Perú

15 de abril de 2009

Reemplazo para SYS(2014)

Artículo original: Replacement for SYS(2014) 
http://doughennig.blogspot.com/2009/03/replacement-for-sys2014.html
Autor: Doug Hennig
Traducido por: Luis María Guayán

SYS(2014) es una pequeña gran función que ayuda a hacer sus aplicaciones portátiles. Como retorna la ruta relativa de un archivo, a una carpeta específica, se puede utilizar en un nombre de archivo absoluto (como el que retorna GETFILE()) y almacenar la ruta relativa, en lugar de la ruta absoluta.

Sin embargo, una cosa que siempre digo sobre SYS(2014), es que retorna la ruta en mayúsculas. Si se desea mostrar la ruta de acceso para el usuario, ellos preguntarán por qué la ruta está toda en en mayusculas en el programa, y diferente en el disco.

Afortunadamente, hay una simple función API de Windows que usted ae puede llamar, que hace lo mismo que SYS(2014), pero respeta las mayúsculas y minusculas. El siguiente es un ejemplo de cómo utilizar esta función:

(ACTUALIZACION: Walt Krzystek señaló que GetRelativePath retornó una cadena en blanco si las dos rutas se encuentran en unidades diferentes. Además, yo olvidé quitar los espacios al valor devuelto.)

*- Ejemplo de ambas funciones
lcFile = "C:\VFP\Desarrollo\Programa.prg" 
lcPath = "C:\VFP\Aplicaciones\"

? SYS(2014, lcFile, lcPath)
? GetRelativePath(lcFile, lcPath)

FUNCTION GetRelativePath(tcTo, tcFrom)
  #DEFINE FILE_ATTRIBUTE_DIRECTORY 0x10
  #DEFINE FILE_ATTRIBUTE_NORMAL 0x80
  #DEFINE MAX_PATH 260
  
  DECLARE INTEGER PathRelativePathTo IN shlwapi.DLL ;
    STRING @out, STRING @from, INTEGER fromattrib, ;
    STRING @to, INTEGER toattrib

  lcPath = SPACE(MAX_PATH)
  lcFrom = IIF(VARTYPE(tcFrom) = 'C', tcFrom, ;
    SYS(5) + CURDIR()) + CHR(0)
  lnFromAttrib = IIF(DIRECTORY(lcFrom), FILE_ATTRIBUTE_DIRECTORY, ;
    FILE_ATTRIBUTE_NORMAL)
  lcTo = IIF(VARTYPE(tcTo) = 'C', tcTo, ;
    SYS(5) + CURDIR()) + CHR(0)
  lnToAttrib = IIF(DIRECTORY(lcTo), FILE_ATTRIBUTE_DIRECTORY, ;
    FILE_ATTRIBUTE_NORMAL)
    
  PathRelativePathTo(@lcPath, @lcFrom, lnFromAttrib, @lcTo, lnToAttrib)

  lcPath = ALLTRIM(STRTRAN(lcPath, CHR(0), ' '))

  IF EMPTY(lcPath)
    lcPath = tcTo
  ENDIF EMPTY(lcPath)

  RETURN lcPath
ENDFUNC

22 de marzo de 2009

Unifica dos archivos en formato MSWORD que estan separados en uno solo

Hace unos días un amigo me pidió que le ayudara con un rutina que ligara dos documentos separados en uno solo realizados en MSWORD. Aquí esta el código.

Todos los comandos utilizados en esta rutina están en la documentación que PortalFox tiene disponible para todos nosotros.

*--Verifica que existan los archivos antes de instanciar WORD
*--------------------------------------------------------------------------
*--Instancia y copia la primera hoja que contiene el texto del .RTF
*--------------------------------------------------------------------------
wFile=FULLPATH("HojaTexto.Rtf")
IF !FILE(wFile)
  =MESSAGEBOX("¡¡Archivo &wFile, no se pudo encontrar!!",16,Titulo)
  RETURN
ENDIF

*----------------------------------------------------------------------
*--Contiene la fotografia y pequeña reseña.
*----------------------------------------------------------------------
gFile=FULLPATH("hoja.Doc")
IF !FILE(gFile)
  =MESSAGEBOX("¡¡Archivo &gFile, no se pudo encontrar!!",16,Titulo)
  RETURN
ENDIF

*------------------------------------------------------------------------
*---ABRE WORD OCULTO PARA COPIAR LOS DATOS Y SE SALE
*------------------------------------------------------------------------
oWord=CREATEOBJECT("Word.Application")
WAIT WIND "Abriendo sesión de MS Word" NOWAIT
WITH oWord
  .Documents.ADD(wFile)  &&Abre el documento .RTF
  .ActiveDocument.SELECT &&Activa la hoja
  cText=.SELECTION.TEXT  &&Selecciona todo el texto
  .SELECTION.COPY        &&Copia todo el texto del documento seleccionado
  .VISIBLE=.F.           &&Abre la primera INSTANCIA de WORD OCULTO del documento .RTF
  .ActiveDocument.CLOSE  &&Cierra el documento .RTF ACTIVO

  .Documents.ADD(gFile)  &&Abre el documento .DOC que contiene las fotos
  .CAPTION="ProtalFox.com......" &&Coloca un titulo al documento

  *--Bajar las filas que desea en el documento abierto
  FOR i=1 TO 100         &&Baja 100 lineas hasta el final del archivo
    oWord.SELECTION.MoveDown
  ENDFOR
  .SELECTION.Paste       &&Pega los datos al final del documento .DOC
  *.Selection.HomeKey     &&Se supone que coloca el cursor en la primera linea
  .VISIBLE=.T.
ENDWITH
WAIT CLEAR
RETURN
*------------------------------------------------------------------------
Tonny Molina

14 de marzo de 2009

Envío de correo electrónico por el servidor SMTP de Windows Live Hotmail

Actualmente Windows Live Hotmail habilitó el acceso POP3 y SMTP en todas las cuentas de correos de Hotmail.

Está publicado el artículo Envío de correo electrónico por el servidor SMTP de Gmail del cual partiremos y solo cambiaremos las configuraciones necesarias que son:
  • Nombre de usuario: El nombre de tu Windows Live ID, (Ejemplo: usuario@hotmail.com)
  • Contraseña: La contraseña de tu cuenta Windows Live
  • Servidor SMTP: smtp.live.com
  • Puerto SMTP: 25
  • Autenticación requerida: Si
  • Cifrado TLS/SSL requerido: Si
Para los que quieren saber los datos del servidor POP3 de Windows Live Mail, no necesarios para este artículo:
  • Servidor POP3: pop3.live.com
  • Puerto POP3: 995
  • POP3 SSL requerido: Si
El siguiente es el código modificado que nos permite el envió de correo electrónico a través del servidor SMTP de Windows Live Hotmail.
TRY
  LOCAL lcSchema, loConfig, loMsg, loError, lcErr
  lcErr = ""
  lcSchema = "http://schemas.microsoft.com/cdo/configuration/"
  loConfig = CREATEOBJECT("CDO.Configuration")
  WITH loConfig.FIELDS
    .ITEM(lcSchema + "smtpserver") = "smtp.live.com"
    .ITEM(lcSchema + "smtpserverport") = 25
    .ITEM(lcSchema + "sendusing") = 2
    .ITEM(lcSchema + "smtpauthenticate") = .T. 
    .ITEM(lcSchema + "smtpusessl") = .T.
    .ITEM(lcSchema + "sendusername") = "miusuario@hotmail.com"
    .ITEM(lcSchema + "sendpassword") = "micontrasenia"
    .UPDATE
  ENDWITH
  loMsg = CREATEOBJECT ("CDO.Message")
  WITH loMsg
    .Configuration = loConfig
    .FROM = "Usuario Hotmail <miusuario@hotmail.com>"
    .TO = "usuario@gmail.com"
    .Subject = "Prueba desde Windows Live Hotmail"
    .TextBody = "Este es un mensaje de prueba con CDO con " + ;
      "autenticación y cifrado SSL desde Windows Live Hotmail."
    .Send()
  ENDWITH
CATCH TO loError
  lcErr = [Error: ] + STR(loError.ERRORNO) + CHR(13) + ;
    [Linea: ] + STR(loError.LINENO) + CHR(13) + ;
    [Mensaje: ] + loError.MESSAGE
FINALLY
  RELEASE loConfig, loMsg
  STORE .NULL. TO loConfig, loMsg
  IF EMPTY(lcErr)
    MESSAGEBOX("El mensaje se envió con éxito", 64, "Aviso")
  ELSE
    MESSAGEBOX(lcErr, 16 , "Error")
  ENDIF
ENDTRY
Para conocer muchas mas opciones que nos brinda CDO para el envío de correos electrónicos desde VFP, podemos ver el siguiente artículo: Mas sobre el envio de mensajes de correo electrónico desde Visual FoxPro

Hasta la próxima,

Luis María

31 de enero de 2009

Obtener el estado de la tecla SCROLL LOCK

Siempre quise saber para que servía esta tecla. El único programa conocido que le daba algún uso era Excel, después ninguno.

Entonces se me ocurrió que para activar el depurador de VFP solamente cuando quería, sin ninguna condición podría usar esta tecla. El programa que usé siempre para llamar al depurador era:

IF _VFP.STARTMODE = 0
  DEBUG
  SUPEND
ENDIF

Si me olvidaba de quitarlo durante la generación del EXE , no habría problema, porque nunca se ejecutaría (STARTMODE = 0 es inicio de la ventana de comandos).

Entonces quedaría:

IF _VFP.STARTMODE = 0 AND ScrollLock()
  DEBUG
  SUPEND
ENDIF

Así detengo mi programa cuando quiero, solamente presionando una tecla. Si quiero que continue presiono la tecla SCROLL LOCK y le doy continuar al depurador.

FUNCTION ScrollLock
  LOCAL lnEstado
  * La función de API GetKeyState también sirve para otras como NUMLOCK : 0x90
  DECLARE INTEGER GetKeyState IN user32 LONG lnTecla
  lnEstado = GetKeyState(0x91)
  * Limpia la declaración si es VFP 8 o superior
  IF VAL(_VFP.VERSION) >= 8.00
    CLEAR DLLS GetKeyState
  ENDIF
  RETURN (lnEstado = 1)
ENDFUNC

Ricardo Geremia

25 de enero de 2009

Configurar un grid automáticamente en una sola línea

Código de ejemplo de como configurar un grid automáticamente en una sola línea.
** Ejemplo de uso
PUBLIC jForm
jForm = CREATEOBJECT("Form1")
jForm.SHOW()

DEFINE CLASS Form1 AS FORM
  WIDTH = 450
  HEIGHT = 600
  SHOWTIPS = .T.
  AUTOCENTER = .T.

  ADD OBJECT Grid1 AS GRID WITH VISIBLE = .T., WIDTH = 400, HEIGHT = 200
  ADD OBJECT Grid2 AS GRID WITH VISIBLE = .T., WIDTH = 400, HEIGHT = 200, TOP = 220

  PROCEDURE INIT
    CREATE CURSOR Ejemplo (Codigo c (10), nombre c(20))
    INSERT INTO Ejemplo (Codigo, Nombre) VALUES ("001", "JUAN")
    INSERT INTO Ejemplo (Codigo, Nombre) VALUES ("002", "FERNANDO")
    CONFIGRID(THISFORM.Grid1, "EJEMPLO", "CODIGO,NOMBRE", "Codigo,Nombre", .T.)
    **
    CREATE CURSOR Ejemplo2 (Codigo c (10), Nombre c(20), Ciudad c(50))
    INSERT INTO Ejemplo2 (Codigo, Nombre, Ciudad) VALUES ("001", "JUAN", "BARRANQUILLA")
    INSERT INTO Ejemplo2 (Codigo, Nombre, Ciudad) VALUES ("002", "FERNANDO", "BOGOTA")
    INSERT INTO Ejemplo2 (Codigo, Nombre, Ciudad) VALUES ("003", "CLARO", "SANTA MARTA")
    CONFIGRID(THISFORM.Grid2, "EJEMPLO2", "CODIGO,NOMBRE,CIUDAD", "Codigo,Nombre,Ciudad", .T.)
  ENDPROC
ENDDEFINE

FUNCTION CONFIGRID(QUEOBJ,_ALIS,LISTACAM,LISTATITULOS,_AUTOF,SININDICES)
  *QUEOBJ= objeto tipo grid
  *_ALIS= alias a utilizar
  *LISTACAM= lista de campos que se asignaran al grid en blanco 
  *          toma todos los campos de la columna
  *LISTATITULOS= lista de titulos personalizados
  *_AUTOF= determina si se ejecutara el auofit o autoajuste de columnas
  *SININDICES = si se desea omitir la indexacion del cursor pasar .t.
  LOCAL NCOLUMNAS
  IF EMPTY(LISTACAM)
    SELECT (_ALIS)
    NCOLUMNAS=FCOUNT()
  ELSE
    NCOLUMNAS=OCCURS(",",LISTACAM)+1
  ENDIF
  LISTACAM=IIF(EMPTY(LISTACAM),"",LISTACAM)
  LISTATITULOS=IIF(EMPTY(LISTATITULOS),"",LISTATITULOS)
  WITH QUEOBJ
    IF UPPER(ALLTRIM(.PARENT.CLASS))="FORM"
      *.PARENT.LOCKSCREEN=.T.
    ENDIF
    .VISIBLE=.F.
    .RECORDSOURCETYPE=1
    .RECORDSOURCE=_ALIS
    .COLUMNCOUNT=NCOLUMNAS
    .FONTSIZE=8
    .FONTNAME="TAHOMA"
    IF !SININDICES
      CARGAHEADER(QUEOBJ)
      CARGAINDICES(_ALIS)
    ENDIF
    LOCAL _comass
    _comass=0
    FOR ms=1 TO NCOLUMNAS
      _comass=_comass+1
      _ka=(GETEXP(ALLTRIM(LISTACAM),",",_comass))
      _titu=(GETEXP(ALLTRIM(LISTATITULOS),",",_comass))
      IF EMPTY(_ka)
        _ka=FIELDS(_comass)
      ENDIF
      .COLUMNS(ms).text1.BACKSTYLE=0
      .COLUMNS(ms).text1.BORDERSTYLE=0
      .COLUMNS(ms).SPARSE=.F.
      .COLUMNS(ms).CONTROLSOURCE=(_ALIS+"."+ALLTRIM(_ka))
      _mtipca=VARTYPE(EVALUATE((_ALIS+"."+ALLTRIM(_ka))))
      DO CASE
        CASE _mtipca="N"
          .COLUMNS(ms).ALIGNMENT=1
        CASE _mtipca="C"
          .COLUMNS(ms).ALIGNMENT=0
      ENDCASE

      IF !SININDICES
        .COLUMNS(ms).header2.CAPTION=PROPER(IIF(EMPTY(_titu),_ka,_titu))
        .COLUMNS(ms).header2.ALIGNMENT=2
      ELSE

        .COLUMNS(ms).header1.CAPTION=PROPER(IIF(EMPTY(_titu),_ka,_titu))
        .COLUMNS(ms).header1.ALIGNMENT=2
      ENDIF
      .COLUMNS(ms).FONTNAME=.FONTNAME
      .COLUMNS(ms).FONTSIZE=.FONTSIZE

    ENDFOR

    IF !_AUTOF
      .AUTOFIT()
    ENDIF
    IF UPPER(ALLTRIM(.PARENT.CLASS))="FORM"
      *.PARENT.LOCKSCREEN=.F.
    ENDIF
    .VISIBLE=.T.
  ENDWITH

** asigna encabezado ordenador a columnas del grid
FUNCTION CARGAHEADER(ojec)
  WITH ojec
    FOR _a=1 TO ojec.COLUMNCOUNT
      IF VARTYPE(ojec.COLUMNS(_a).header2)#'O'
        ojec.COLUMNS(_a).ADDOBJECT("header2","cabezas")
      ENDIF
      SELECT (ojec.RECORDSOURCE)
      ojec.COLUMNS(_a).header2.tabla=ojec.RECORDSOURCE
      ojec.COLUMNS(_a).header2.CAPTION=PROPER(FIELD(_a))
      ojec.COLUMNS(_a).header2.TOOLTIPTEXT="clic para ordenar "
    ENDFOR
  ENDWITH

** indexa el cursor
FUNCTION CARGAINDICES
  LPARAMETERS _dt
  SELECT (_dt)
  lnF = AFIELDS(aa,_dt)
  FOR A_ = 1 TO lnF
    lcField = LOWER(aa[A_, 1])
    lcType = aa[A_, 2]
    IF !ALLTRIM(UPPER(lcType ))$"M B G W U"
      INDEX ON &lcField TAG &lcField
    ENDIF
  ENDFOR
  SELECT (_dt)
  IF buscatag(FIELD(1),(_dt))
    SET ORDER TO (FIELD(1))
  ENDIF
  GO TOP

** nuevo header ordenador para las columnas del grid
DEFINE CLASS cabezas AS HEADER
  orden=1
  UBICACION = ""
  FONTSIZE = 8
  ALIGNMENT = 2
  FONTBOLD = .F.
  codigo = ""
  tabla=""
  indice=""
  **
  PROCEDURE INIT
    *If _Screen.VARIA.RESOLUCION>15
      THIS.BACKCOLOR = RGB(244, 244, 244)
    *Endif
  ENDPROC
  **
  PROCEDURE CLICK
    DO CASE
      CASE THIS.orden=1
        THIS.orden=2
        IF EMPTY(THIS.indice)
          _nin=STREXTRACT(ALLTRIM(THIS.PARENT.CONTROLSOURCE ),".","")
        ELSE
          _nin=ALLTR(THIS.indice)
        ENDIF
        SELECT (THIS.tabla)
        IF buscatag(_nin,(THIS.tabla))
          SET ORDER TO (_nin) ASCENDING
          SELECT (THIS.tabla)
          GO TOP
        ENDIF
      CASE THIS.orden=2
        THIS.orden=1
        IF EMPTY(THIS.indice)
          _nin=STREXTRACT(ALLTRIM(THIS.PARENT.CONTROLSOURCE ),".","")
        ELSE
          _nin=ALLTR(THIS.indice)
        ENDIF
        IF buscatag(_nin,(THIS.tabla))
          SELECT (THIS.tabla)
          SET ORDER TO (_nin) DESCENDING
        ENDIF
    ENDCASE
    SELECT (THIS.tabla)
    GO TOP
    THIS.PARENT.PARENT.REFRESH()
  ENDPROC
  **
ENDDEFINE
**
*** funcion para saber si un indice existe
FUNCTION buscatag
  LPARAMETERS TAG_BUSCADO, TABLAX_
  LOCAL NCOUNT
  SELECT (TABLAX_)
  SET ANSI ON
  SET EXACT ON
  FOR NCOUNT = 1 TO 254
    IF TAG(NCOUNT)=UPPER(TAG_BUSCADO)
      RETURN .T.
    ENDIF
  ENDFOR
  RETURN .F.
ENDFUNC

FUNCTION GETEXP
  LPARAMETERS EXP_S, CARAT, PARA_VECES
  LOCAL RETIR, I
  RETIR = ""
  PROPIEDADES_ = EXP_S
  CUCOM = OCCURS(CARAT, (PROPIEDADES_))
  IF .NOT. EMPTY(PROPIEDADES_)
    CUCOM1 = IIF(CUCOM=0, 1, CUCOM+1)
    FOR I = 1 TO CUCOM1
      X_CMP = IIF(CUCOM=0, SUBSTR(PROPIEDADES_, 1, LEN(PROPIEDADES_)), SUBSTR(PROPIEDADES_, ;
        IIF(I=1, 1, AT(CARAT, PROPIEDADES_, (I-1))+1), IIF(AT(CARAT, PROPIEDADES_, I)=0, ;
        LEN(PROPIEDADES_), IIF(I=1, AT(CARAT, PROPIEDADES_, I)-1, ;
        AT(CARAT, PROPIEDADES_, I)-AT(CARAT, PROPIEDADES_, I-1)-1))))
      IF I=PARA_VECES
        RETIR = X_CMP
        EXIT
      ENDIF
    ENDFOR
  ENDIF
  RETURN RETIR
ENDFUNC
JUAN FERNANDO CLARO