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
