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

2 comentarios :

  1. Excetente Funciona de Pelicula, ya lo implementé para los combo box

    ResponderEliminar
  2. Hola y buenas tardes. Primero espero este foro siga en funcionamiento, pues estoy retomando la programación en VFP6, después de más de 18 años de no programar en este lenguaje.
    Estas lineas las he puesto en el load de mi FORM1 y me dice que no puede llevar procedimientos. Debo entender que esta declaración es desde un programa aparte y debe hacerse la llamada antes de activar la FORM. De antemano Gracias por sus comentarios al foro, que de ya me han ayudado mucho.
    Mi nombre es Noé y mi correo es noejdvl@gmail.com.

    ResponderEliminar