Como ordenar un Grid haciendo clic en cada columna

Aquí está un sencillo ejemplo funcional de como agregar la característica de ordenamiento en un Grid, haciendo clic en la columna por la cual deseamos ordenar la tabla.

En el ejemplo utilizamos la clase MyGridOrd derivada de Grid. Esta clase la podemos almacenar en una librería de clases visuales VCX.

Las clases que no podemos almacenar en una librería de clases visuales, y la debemos definir programáticamente son las clases MyColumnOrd y MyHeaderOrd, y es allí donde definimos los métodos de ordenamiento con el clic en el Header de cada columna, y la imagen correspondiente para cada Header.

LOCAL loForm AS FORM
USE (HOME(2) + "Northwind\Customers")
loForm = CREATEOBJECT("Form")
loForm.CAPTION = "Ejemplo de grid con orden por columna"
loForm.ADDOBJECT("MyGrid","MyGridOrd")
loForm.MyGrid.Order_Enabled = .T.
loForm.MyGrid.Order_All()
loForm.MyGrid.RECORDSOURCE = "Customers"
loForm.MyGrid.READONLY = .T.
loForm.MyGrid.WIDTH = loForm.WIDTH
loForm.MyGrid.HEIGHT = loForm.HEIGHT
loForm.MyGrid.ANCHOR = 15
loForm.MyGrid.VISIBLE = .T.
loForm.WINDOWSTATE = 2
loForm.MyGrid.AUTOFIT()
loForm.SHOW(1)


DEFINE CLASS MyGridOrd AS GRID
  *-- Puntero actual al objeto Header
  HEADER = .F.
  HEADERHEIGHT = 25
  *-- Habilita el orden de las columnas
  Order_Enabled = .F.
  NAME = "MyGridOrd"
  PROCEDURE Order_Column
    LPARAMETERS toColumn, tcField
    LOCAL tcCaption, tlWordWrap
    DO CASE
      CASE PEMSTATUS(toColumn,"Header1",5)
        tcCaption = toColumn.Header1.CAPTION
        tlWordWrap = toColumn.Header1.WORDWRAP
        toColumn.REMOVEOBJECT('Header1')
      CASE PEMSTATUS(toColumn,"MyHeader",5)
        tcCaption = toColumn.MyHeader.CAPTION
        tlWordWrap = toColumn.MyHeader.WORDWRAP
        toColumn.REMOVEOBJECT('MyHeader')
    ENDCASE
    toColumn.ADDOBJECT('MyHeader', 'MyHeaderOrd', tcField)
    toColumn.MyHeader.CAPTION = tcCaption
    toColumn.MyHeader.WORDWRAP = tlWordWrap
  ENDPROC
  PROCEDURE Order_All
    LOCAL lo, lc
    FOR EACH lo IN THIS.COLUMNS
      *-- No ordena las columnas que tengan algun valor en la propiedad TAG
      IF EMPTY(lo.TAG)
        lc =  SUBSTR(lo.CONTROLSOURCE,AT(".", lo.CONTROLSOURCE) + 1)
        *-- Quita los caracteres especiales del ControlSource
        lc = CHRTRAN(lc, ["'+-/*().,;], [])
        THIS.Order_Column(lo, lc)
      ENDIF
    ENDFOR
  ENDPROC
  PROCEDURE INIT
    DODEFAULT()
    IF THIS.Order_Enabled
      THIS.Order_All()
    ENDIF
  ENDPROC
ENDDEFINE

*------------------------------------------------------
* Clase Column y Header para ordenar las columnas
* de una Grilla con un Click en el Header
*------------------------------------------------------
DEFINE CLASS MyColumnOrd AS COLUMN
  *-- Nada
ENDDEFINE

DEFINE CLASS MyHeaderOrd AS HEADER
  FONTSIZE = 8
  FONTBOLD = .T.
  ALIGNMENT = 2
  nNoReg = 0
  cField = ""
  nOrder = 0
  cFieldType = "U"
  lCyclic = .F. && El orden pasa de ASC > DESC > NO ORDEN > ASC > Etc...
  PROCEDURE INIT(tcField)
    LOCAL  ln1, ln2
    THIS.cField = UPPER(tcField)
    ln1 = AFIELDS(laFields, THIS.PARENT.PARENT.RECORDSOURCE)
    IF ln1 > 0
      ln2 = ASCAN(laFields, THIS.cField, -1, -1, 1, 11)
      IF ln2 > 0
        THIS.cFieldType = laFields(ln2, 2)
      ENDIF
    ENDIF
    IF NOT INLIST(THIS.cFieldType, "U", "G", "M", "W")
      THIS.PICTURE = LOCFILE(HOME(4) + "Bitmaps\Tlbr_w95\DELETE.BMP", "BMP")
      THIS.MOUSEPOINTER = 15 && Mano
    ENDIF
  ENDPROC
  PROCEDURE CLICK
    IF INLIST(THIS.cFieldType, "U", "G", "M", "W")
      *- No se puede ordenar estos tipos de campos
      RETURN
    ENDIF
    THIS.nNoReg = MIN(RECCOUNT(THIS.PARENT.PARENT.RECORDSOURCE), ;
      RECNO(THIS.PARENT.PARENT.RECORDSOURCE))
    IF VARTYPE(THIS.PARENT.PARENT.HEADER) == "O" AND !ISNULL(THIS.PARENT.PARENT.HEADER)
      THIS.PARENT.PARENT.HEADER.PICTURE = LOCFILE(HOME(4) + "Bitmaps\Tlbr_w95\DELETE.BMP", "BMP")
      IF THIS.PARENT.PARENT.HEADER.cField <> THIS.cField
        THIS.PARENT.PARENT.HEADER.nOrder = 0
      ENDIF
    ENDIF
    DO CASE
      CASE THIS.nOrder = 0
        *-- Sin Orden, pasa a ASCending
        IF ATAGINFO(laTag,"",THIS.PARENT.PARENT.RECORDSOURCE) > 0 AND ASCAN(laTag,THIS.cField,-1,-1,1,1) > 0
          *-- Existe el TAG
        ELSE
          LOCAL lcSetSafety
          lcSetSafety = SET("Safety")
          SET SAFETY OFF
          SELECT (THIS.PARENT.PARENT.RECORDSOURCE)
          EXECSCRIPT( "INDEX ON " + THIS.cField + " TO " + THIS.cField + " ADDITIVE")
          SET SAFETY &lcSetSafety
        ENDIF
        EXECSCRIPT("SET ORDER TO " + THIS.cField + " IN " + THIS.PARENT.PARENT.RECORDSOURCE + " ASCENDING")
        THIS.PARENT.PARENT.HEADER = THIS
        THIS.PICTURE = LOCFILE(HOME(4) + "Bitmaps\Tlbr_w95\SORTASC.BMP", "BMP")
      CASE THIS.nOrder = 1
        *-- Orden ASC, pasa a DESCending
        IF ATAGINFO(laTag,"",THIS.PARENT.PARENT.RECORDSOURCE) > 0 AND ASCAN(laTag,THIS.cField,-1,-1,1,1) > 0
          *-- Existe el TAG
        ELSE
          LOCAL lcSetSafety
          lcSetSafety = SET("Safety")
          SET SAFETY OFF
          SELECT (THIS.PARENT.PARENT.RECORDSOURCE)
          EXECSCRIPT( "INDEX ON " + tcField + " TO " + THIS.cField + " ADDITIVE")
          SET SAFETY &lcSetSafety
        ENDIF
        EXECSCRIPT("SET ORDER TO " + THIS.cField + " IN " + THIS.PARENT.PARENT.RECORDSOURCE + " DESCENDING")
        THIS.PARENT.PARENT.HEADER = THIS
        THIS.PICTURE = LOCFILE(HOME(4) + "Bitmaps\Tlbr_w95\SORTDES.BMP", "BMP")
      CASE THIS.nOrder = 2 AND THIS.lCyclic
        *-- Orden DESC, pasa a Sin Orden
        EXECSCRIPT("SET ORDER TO 0 IN " + THIS.PARENT.PARENT.RECORDSOURCE)
        THIS.PARENT.PARENT.HEADER = THIS
        THIS.PICTURE = LOCFILE(HOME(4) + "Bitmaps\Tlbr_w95\DELETE.BMP", "BMP")
    ENDCASE
    THIS.nOrder = MOD(THIS.nOrder + 1, IIF(THIS.lCyclic,3,2))
    THIS.PARENT.PARENT.REFRESH()
    IF THIS.nNoReg > 0
      GO (THIS.nNoReg) IN (THIS.PARENT.PARENT.RECORDSOURCE)
    ENDIF
  ENDPROC
  PROCEDURE RIGHTCLICK
    IF VARTYPE(THIS.PARENT.PARENT.HEADER) <> "O"
      *-- Sin orden
      RETURN
    ENDIF
    *-- Con RightClick (Clic Derecho) quito cualquier orden
    THIS.nNoReg = MIN(RECCOUNT(THIS.PARENT.PARENT.RECORDSOURCE), ;
      RECNO(THIS.PARENT.PARENT.RECORDSOURCE))
    EXECSCRIPT("SET ORDER TO 0 IN " + THIS.PARENT.PARENT.RECORDSOURCE)
    THIS.PARENT.PARENT.HEADER.nOrder = 0
    THIS.PARENT.PARENT.HEADER.PICTURE = LOCFILE(HOME(4) + "Bitmaps\Tlbr_w95\DELETE.BMP", "BMP")
    THIS.PARENT.PARENT.HEADER = THIS
    THIS.PARENT.PARENT.REFRESH()
    IF THIS.nNoReg > 0
      GO (THIS.nNoReg) IN (THIS.PARENT.PARENT.RECORDSOURCE)
    ENDIF
  ENDPROC
ENDDEFINE
*------------------------------------------------------

La clase MyGridOrd tiene la propiedad Order_Enabled que configurándola en .T. se ordenan todos los campos de la tabla, menos los tipos de campos que no se pueden ordenar (Memo, Blog y General) y tampoco las Columnas que tengan algún valor configurado en la propiedad Tag (Ej: .Column.Tag = "*")

La clase MyHeaderOrd tiene la propiedad lCyclic que configurándola con el valor .T. el orden recicla de ASCendente a DESCendente a SinOrden. En cualquier momento se puede seleccionar "SinOrden" con solo hacer clic derecho en el Heder de la columna.

Luis María Guayán