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

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