31 de marzo de 2017

Evitar salir de los TextBox al borrar con BackSpace

Mucha gente desea saber si es un bug de los controles TextBox, y cómo evitarlo. Aquí veremos la explicación sobre el tema.

No es un error, es el comportamiento normal de VFP, y tanto no es un error que puedes cambiarlo, para esto, puedes codificar lo siguiente en el evento KeyPress de tu clase TextBox personalizada (que así lo deberíamos tener todos):

IF nKeyCode = 127 AND (LEN(ALLTRIM(this.Value))-1 < 0)
  NODEFAULT
ENDIF

Un pequeño código para probarlo:

oForm = CREATEOBJECT("MyForm")
oForm.Show(1)
DEFINE CLASS myForm AS Form
   ADD OBJECT TextBox1 AS MyTextBox WITH Top=20, Width=150, Height= 25
   ADD OBJECT TextBox2 AS MyTextBox WITH Top=50, Width=150, Height= 25
   PROCEDURE Init
      SET CONFIRM ON 
      lcMessage = "Escriba un texto en las cajas, borre el contenido con BackSpace"+;
                  CHR(13)+"Verá el comportamiento cambiado"
       MESSAGEBOX(lcMessage,64,"Aviso")
   ENDPROC
ENDDEFINE
DEFINE CLASS myTextBox AS TextBox
   PROCEDURE KeyPress
   LPARAMETERS nKeyCode, nShiftAltCtrl
     IF nKeyCode = 127 AND (LEN(ALLTRIM(this.Value))-1 < 0)
        NODEFAULT
      ENDIF
ENDDEFINE

El mismo ejemplo, pero usando BindEvents ( a partir de VFP8):

oForm = CREATEOBJECT("MyForm")
oForm.Show(1)
DEFINE CLASS myForm AS Form
   ADD OBJECT TextBox1 AS TextBox WITH Top=20, Width=150, Height= 25
   ADD OBJECT TextBox2 AS TextBox WITH Top=50, Width=150, Height= 25
   PROCEDURE Init
      SET CONFIRM ON 
      lcMessage = "Escriba un texto en las cajas, borre el contenido con BackSpace"+;
                  CHR(13)+"Verá el comportamiento cambiado"
       MESSAGEBOX(lcMessage,64,"Aviso")
       FOR EACH oControl IN This.Controls 
         IF oControl.BaseClass = 'Textbox'
            BINDEVENT(oControl, 'KeyPress',This,'MyKeyPress')
         ENDIF
       ENDFOR
   ENDPROC
   PROCEDURE myKeyPress
   LPARAMETERS nKeyCode, nShiftAltCtrl
     IF AEVENTS(laControl,0) > 0
       IF nKeyCode = 127 AND (LEN(ALLTRIM(laControl[1].Value))-1 < 0)
          NODEFAULT
       ENDIF
     ENDIF
   ENDPROC
ENDDEFINE

Nota: Para ejecutar los códigos anteriores basta con copiar y pegarlos en tu command window, seleccionar lo y presionar ENTER. Verás como el comportamiento ha cambiado.

Espero les sea de utilidad.

Esparta Palma

26 de marzo de 2017

Simular CkeckBoxes en un control ListBox

Para mostrar los CheckBoxes en un ListBox y enganchar todo el asunto hasta una tabla, se debe utilizar la propiedades Picture (entre otras cosas) del ListBox. En realidad no son CheckBoxes, son iconos. De hecho, los que estoy usando son más como luces (yo quería dar un ejemplo que se pueda ejecutar desde un PRG). Se puede usar cualquier imagen que desee ... encontrar un par de imágenes realmente buenas de casillas de verificación que están marcadas y desmarcadas y simplemente reemplazar las correspondientes propiedades del Formulario.

El ListBox tiene un Cursor como RowSource y uno de los campos "Checked" se utiliza para realizar un seguimiento de qué registros están marcados o desmarcados. Incluso podría dar un paso más y cambiar el campo marcado a numérico y tener una casilla de verificación MultiEstado con los valores 0, 1 y 2 y utilizar tres imágenes. (Copie y peque el siguiente código en un archivo PRG y ejecútelo desde VFP)

PUBLIC oForm
oForm = CREATEOBJECT("clsListCheckBox")
oForm.VISIBLE = .T.
READ EVENTS

DEFINE CLASS clsListCheckBox AS FORM

    TOP = 1
    LEFT = 0
    HEIGHT = 473
    WIDTH = 287
    DOCREATE = .T.
    CAPTION = "Listbox With Checkboxes"
    WINDOWSTATE = 0
    NAME = "clsListCheckBox"
    AlwaysOnTop = .T.
    CheckIcon = HOME() + "Graphics\Icons\Misc\MISC15.ICO"
    Uncheckicon = HOME() + "Graphics\Icons\Misc\MISC13.ICO"
    SHOWWINDOW = 2

    ADD OBJECT list1 AS LISTBOX WITH ;
        HEIGHT = 408, ;
        LEFT = 12, ;
        SORTED = .T., ;
        TOP = 48, ;
        WIDTH = 264, ;
        NAME = "List1", ;
        ROWSOURCETYPE = 2, ;
        ROWSOURCE = "ListCheck"
        
    PROCEDURE LOAD
        LOCAL nCount, nCount2, nWordLength, sItem, nUpper, nLower
        nUpper = 90 &&ASCII
        nLower = 65 &&ASCII
        CREATE CURSOR ListCheck (MyEntry c(35), Checked L)
        FOR nCount = 1 TO 250
            sItem = ""
            nWordLength = INT((35) * RAND( ) + 1)
            FOR nCount2 = 1 TO nWordLength
                sItem = sItem + CHR(INT((nUpper - nLower + 1) * RAND( ) + nLower))
            ENDFOR
            INSERT INTO ListCheck (MyEntry, Checked) VALUES(sItem, .F.)
        NEXT
    ENDPROC
        
    PROCEDURE Unload
        USE IN SELECT("ListCheck")
        CLEAR EVENTS
    ENDPROC

    PROCEDURE ListSetup
        THISFORM.LOCKSCREEN = .T.
        LOCAL nListCount
        nListCount = 1
        SELECT ListCheck
        SCAN ALL
            IF ListCheck.Checked
                THIS.list1.PICTURE(nListCount) = THISFORM.CheckIcon
            ELSE
                THIS.list1.PICTURE(nListCount) = THISFORM.Uncheckicon
            ENDIF
            nListCount = nListCount + 1
        ENDSCAN
        THISFORM.LOCKSCREEN = .F.
    ENDPROC

    PROCEDURE SetCheck
        LOCAL nListIndex
        nListIndex = THIS.list1.LISTINDEX
        IF nListIndex > 0
            GO nListIndex IN "ListCheck"
            IF ListCheck.Checked
                THIS.list1.PICTURE(nListIndex) = THISFORM.Uncheckicon
            ELSE
                THIS.list1.PICTURE(nListIndex) = THISFORM.CheckIcon
            ENDIF
            REPLACE ListCheck.Checked WITH !ListCheck.Checked
        ENDIF
    ENDPROC

    PROCEDURE list1.GOTFOCUS()
        IF DODEFAULT()
            THISFORM.ListSetup()
        ENDIF
    ENDPROC
    
    PROCEDURE list1.CLICK()
        IF LASTKEY() = 13
            THISFORM.SetCheck()
        ENDIF
    ENDPROC

    PROCEDURE list1.KEYPRESS(nKeyCode, nShiftAltCtrl)
        IF nKeyCode = 13 OR nKeyCode = 32
            THISFORM.SetCheck()
        ENDIF
    ENDPROC

ENDDEFINE

Craig Boyd

21 de marzo de 2017

Mostrar los archivos que contiene un proyecto

Este codigo nos muestra cada uno de los archivos que componen un proyecto. para saber que tipo es el archivo, basta con consultar la tabla que esta al final.

_SCREEN.ADDPROPERTY('NUMERO',1)
LOCAL NUMERO, CADENA, CICLO, SELECCION
CLEAR
CADENA = ''
NUMERO = APPLICATION.PROJECTS.COUNT
SELECCION = 0
IF NUMERO = 0
 WAIT WINDOW "NO HAY NINGUN PROJECTO ABIERTO"
 RETURN
ENDIF
IF NUMERO > 1
 OBJETO = CREATEOBJECT('FORM')
 OBJETO.WINDOWTYPE = 1
 OBJETO.AUTOCENTER = .T.
 OBJETO.HEIGHT  = 135
 OBJETO.WIDTH = 380
 OBJETO.CAPTION = 'Proyectos Activos'
 OBJETO.ADDOBJECT('ETIQUETA','LABEL')
 OBJETO.ADDOBJECT('COMBO1','COMBOBOX')
 OBJETO.ADDOBJECT('aceptar','aceptar')
 OBJETO.ETIQUETA.CAPTION = 'Por Favor Seleccione el Proyecto que desea mostrar'
 OBJETO.ETIQUETA.AUTOSIZE = .T.
 OBJETO.COMBO1.WIDTH = OBJETO.WIDTH-15
 OBJETO.COMBO1.TOP = 50
 FOR CICLO = 1 TO NUMERO
  OBJETO.COMBO1.ADDITEM(ALLTRIM(APPLICATION.PROJECTS(CICLO).NAME),CICLO)
 ENDFOR
 OBJETO.SETALL('visible',.T.)
 OBJETO.COMBO1.VALUE = 1
 OBJETO.SHOW
 SELECCION = _SCREEN.NUMERO 
ENDIF

WITH APPLICATION.PROJECTS(SELECCION)
 ? "NOMBRE DEL PROYECTO: " + .NAME
 CANTIDAD = .FILES.COUNT
 FOR CICLO = 1 TO CANTIDAD
  ? 'Tipo: ' + ALLTRIM(.FILES(CICLO).TYPE) + ' Nombre: ' + ALLTRIM(.FILES(CICLO).NAME)
  IF INT(ciclo/30) =(ciclo/30)
   WAIT WINDOW 'PRESIONE UNA TECLA PARA CONTINUAR'
  ENDIF
 ENDFOR
ENDWITH

DEFINE CLASS ACEPTAR AS COMMANDBUTTON
 CAPTION = 'ACEPTAR'
 TOP    = 80
 LEFT   = 30
 HEIGHT = 35

 PROCEDURE CLICK
  _SCREEN.NUMERO =THIS.PARENT.COMBO1.VALUE
  THISFORM.RELEASE
 ENDPROC
ENDDEFINE
ValorConstante FoxPro.HTipo de Archivo Y Extension
dFILETYPE_DATABASEBase de datos, .dbc
DFILETYPE_FREETABLETabla libre, .dbf
QFILETYPE_QUERYConsulta, .qpr
KFILETYPE_FORMFormulario, .scx
RFILETYPE_REPORTInforme, .frx
BFILETYPE_LABELEtiqueta, .lbx
VFILETYPE_CLASSLIBBiblioteca de clases visuales, .vcx
PFILETYPE_PROGRAMPrograma, .prg
LFILETYPE_APILIBBiblioteca de vínculos dinámicos de Visual FoxPro, .fll
ZFILETYPE_APPLICATIONAplicación, .app
MFILETYPE_MENUMenú, .mnx
TFILETYPE_TEXTArchivo de texto, varias extensiones
xFILETYPE_OTHEROtros, varias extensiones

Jorge Mota

16 de marzo de 2017

El registro está fuera de rango (#5)

Artículo original: Record is out of range (#5)
http://www.foxpert.com/KnowlBits_200609_3.htm
Autor: Christof Wollenhaupt
Traducido por: Ana María Bisbé York


A veces trata de acceder a un registro que no existe en la tabla seleccionada.

Causa: Corrupción de índice

Cuando se corrompe el índice de una tabla, pudiera contener números de registros que ya no existan en la tabla. Cuando usted intenta acceder a este registro, recibe el mensaje de error que típicamente se refiere a la función o comando como tal. Si el error aparece en un comando que no accede a registros, puede ser una condición de filtro que es evaluada por detrás, por ejemplo, en un grid. REINDEX normalmente se ocupa de este problema durante el desarrollo. En tiempo de ejecución se debe utilizar un código para reordenar índices.

Causa: Listbox y Requery

Un control listbox está enlazado a un cursor utilizando RecordSourceTypes #2 (Alias) o #6 (Campos) y su valor apunta a un registro. Ahora reduce la cantidad de registros en su RecordSource. Típicamente el error aparece cuando emplea ZAP; pero ocasionalmente aparece cuando se re ejecuta una instrucción SELECT o al emplear REQUERY().

Una vez que esto ocurra, el error puede aparecer en varias situaciones. Ocurre cuando accede a una propiedad en el listbox. Pero también ocurre cuando Visual FoxPro refresca internamente el listbox. LA razón es simple, Visual FoxPro almacena el número de registro actual y navega hasta ese registro cuando usted intenta acceder al listbox, o cuando necesita repintarlo. Cuando elimina registros y no hay registros con el viejo número, entonces usted recibe un error. Lo mismo se aplica también a controles Combobox.

Persiste la pregunta de porqué no ocurre siempre un error. Parece que Visual FoxPro contiene mucho código que notifica a los controles de un cambio en la tabla. Esto explica, por qué el grid se queda completamente en blanco, incluso cuando no es necesario repintarlo. Estas notificaciones de eventos son necesarias para evadir los errores de este tipo. Cuando cambia la cantidad de registrosdel Recordsource desde un método Requery(), no tendrá ningún problema. Esto es obvio, debido a que VFP conoce que el RecordSource tiene que cambiar. Pero, incluso cuando ejecute SELECT ...FROM en alguna parte del programa, parece que se le notifica al listbox y no dispara ningún error. Al parecer ZAP es el comando menos cooperativo, y causa la mayoría de los problemas.

Causa: GOTO o LOCATE RECORD

La razón más obvia para este error es la cantidad no válida de registros utilizada por el GOTO o el comando LOCATE RECORD. Los números de registros válidos van desde 1 a RECCOUNT() y los números negativos para los registros agregados. LOCATE RECORD puede también obtener RECORD()+1 como un parámetro y posicionar la tabla en este caso en EOF()

11 de marzo de 2017

Técnicas de macrosustitución en VFP

Artículo original: VFP Macro Substitution Techniques
http://rickschummer.com/blog/2006/06/vfp-macro-substitution-techniques.html
Autor: Rick Schummer
Traducido por: Ana María Bisbé York


Hace un par de semanas programé un generador que se encarga de manipular propiedades. Estuve tratando de volver a utilizar una técnica con macro-sustitución que utilizaba hace un par de años para hacerlo todo.

Abrí la herramienta Referencias de código (Code Reference) y comencé a buscar por "..&" (punto, punto, ampersand) porque pensé que era eso lo que necesitaba. No obtuve resultados. Me sorprendió. Podría jurar que necesitaba los dos puntos.

Obtuve resultados cuando busqué ".&" (punto, ampersand). Lo que yo intentaba hacer era concatenar el nombre de una propiedad macro sustituida al final de una referencia a un objeto en el diseñador. El código final es muy sencillo una vez que se conoce lo que se necesita. En este caso, tenía un combobox con una lista de objetos en el diseñador de clase o formulario. El combo tiene una matriz con un contenedor al objeto del contenedor superior. Para obtener una referencia de objeto he ejecutado el siguiente código.

lnComboRowSelected = this.cboObjectsToPickFrom.ListIndex
lcAddPath = this.cboObjectsToPickFrom.aItems[lnComboRowSelected, 2]
loPickedControl = this.oControlList.oObject.&lcAddPath

Las propiedades en que estaba trabajando eran en control listbox con selección múltiple. Para obtener el valor de la propiedad en el control yo utilicé el siguiente código:

lcProperty = ALLTRIM(this.lstCommonProperties.aItems[lnI, 1])
lcPropertyValue = loPickedControl
&lcProperty

En este generador en particular (que se mostrará en el próximo número de Advisor's Guide to Microsoft Visual FoxPro) básicamente permito seleccionar los controles, seleccionar las propiedades que desea que sean idénticas y el generador va a migrar las propiedades. Esto es utilizando el framework BuilderControls que también se describe en el artículo. He empleado la misma técnica dos veces en el mismo método que mueve el valor de la propiedad entre los controles.

Me preocupó que no podía saber por qué originalmente pensé que necesitaba los dos puntos. Entonces, la semana pasadaTracy Pearson escrbió en ProFox algo que me hizo recordar en lo que yo estaba pensando y me di cuenta que yo estaba empleando la segunda técnica de macrosustitución.

Trabajo frecuentemente con tablas o cursores para guardar datos y conozco frecuentemente la estructura utilizando AFIELDS() o algunas otras técnicas. Controlo el alias del cursor por programación y lo guardo en una variable de memoria. Si deseo un valor específico de una columna y necesito incluir el alias ( a veces deseo siempre eliminar el factor ambiguedad) en la referencia a la columna. Si el código es genérico al cursor puedo utilizar macro sustitución para manipular el dato:

lcAlias = ALIAS()
ldInvoice = &lcAlias..dInvoice
lcCustomerName = &lcAlias..cCustName 

Como escribió Tracy en su post: "un punto para el final de la macrosustitución y otro punto para señalar tabla.campo"

Esto me hizo sentir mejor ya que existe la técnica de macrosustitución con dos puntos, espero que usted no pierda media hora buscando los dos puntos de forma incorrecta, o que sirvan estas líneas como recuerdo de que existen y son completamente diferentes.