Here is some code I use. Save it as _GrdSort.Prg. In the click event of the header eneter _GrdSort(This). You can programmatically add this to every header using the function AddSort below
* PROGRAM _grdsort.prg
* This Program will Sort a Grid, Using the specified Header ( Control Source )
* Date 1998/09/02
* Call this procedure from the Click event of a Grid Header
* Example 1 = _GrdSort(THIS)
* Example 2 = _GrdSort(THIS, .T., 30)
PARAMETER toHeader, tlAsk, tnMaxLen
IF TYPE("toHeader") <> "O"
WAIT WINDOW "Sorting of Data, Not Possible "
RETURN
ENDIF
IF tlAsk = .T.
lnCheck = MessageBox(toHeader.Caption, 17, "Sort by Column")
IF lnCheck <> 1
RETURN
ENDIF
ENDIF
tnMaxLen = IIF(EMPTY(tnMaxLen), 20, tnMaxLen)
lnRecNo = RecNo()
lcControlSource = toHeader.Parent.ControlSource
lnAT = AT(".", lcControlSource) && Extract Field Name from the Control Source
lcFieldName = IIF(lnAT >0, UPPER(SUBSTR(lcControlSource,lnAT+1)), lcFieldName = UPPER(lcControlSource))
** Checking for a suitable existing index in the CDX file
lnIndexNo = 0
FOR n =1 TO 254
lcIndex = UPPER(SYS(14,n)) && Index Expression
IF EMPTY(lcIndex)
EXIT
ENDIF
IF lcFieldName $ lcIndex
lnAT = AT(lcFieldName, lcIndex)
lnNextChar = lnAT+ LEN(lcFieldName) && Position of Next Character after lcFieldName
lcNextChar = IIF(lnNextChar < LEN(lcIndex), SUBSTR(lcIndex, lnNextChar), " ") && Next Character after lcFieldName
*lnNextAsc = ASC(lcNextChar)
IF NOT(ISDIGIT(lcNextChar) OR ISALPHA(lcNextChar) OR lcNextChar = "-") && Not a valid Field Character
lnIndexNo = n
EXIT
ENDIF
ENDIF
NEXT
IF lnIndexNo > 0
lcLast = RIGHT(ALLTRIM(toHeader.Caption),4)
lcPlainCaption = IIF(lcLast = " - v" OR lcLast = " - ^", LEFT(ALLTRIM(toHeader.Caption), LEN(ALLTRIM(toHeader.Caption))-4), ALLTRIM(toHeader.Caption))
lnColCount=toHeader.Parent.Parent.ColumnCount
FOR lnCount=1 TO lnColCount
lcText =toHeader.Parent.Parent.Columns(lnCount).Header1.Caption
IF RIGHT(ALLTRIM(lcText),4)=" - v" .OR. RIGHT(ALLTRIM(lcText),4)=" - ^"
toHeader.Parent.Parent.Columns(lnCount).Header1.Caption=LEFT(ALLTRIM(lcText),(LEN(ALLTRIM(lcText))-LEN(" - ^")))
ENDIF
NEXT
IF lnIndexNo = TagNo() && If Current TagNo is Same as the Field NAme Passed in the Order is set Automaticaly
IF "DESCENDING" $ SET("ORDER")
toHeader.Caption = lcPlainCaption + " - ^"
SET ORDER TO lnIndexNo ASCENDING
ELSE
toHeader.Caption = lcPlainCaption + " - v"
SET ORDER TO lnIndexNo DESCENDING
ENDIF
ELSE
toHeader.Caption = lcPlainCaption + " - ^"
SET ORDER TO lnIndexNo ASCENDING
ENDIF
DO GrdRefresh
RETURN
ENDIF
IF NOT(TYPE(lcControlSource) $ "CMDNIL")
WAIT WINDOW "Cannot Sort by a field of type " + TYPE(lcFieldName) TIMEOUT 5
RETURN
ENDIF
** Creating a new TAG in a Temporary File
fTmpCdx = IIF(EMPTY(CDX(2)), SYS(3) + ".Tmp" , CDX(2)) && CDX(2) returns any existing secondary CDX files open
IF TYPE(lcFieldName) = "C"
IF LEN(EVAL(lcFieldName)) > tnMaxLen
lcExpr = UPPER(LEFT(lcFieldName,tnMaxLen))
ELSE
lcExpr = UPPER(lcFieldName)
ENDIF
ELSE
lcExpr = lcFieldName
ENDIF
IF TYPE(lcFieldName) = "M"
lcExpr = UPPER(LEFT(lcFieldName,tnMaxLen))
ENDIF
lcTmpTag = "T" +SYS(3)
WAIT WINDOW "Sorting by " + lcFieldName NOWAIT
lcFilter = IIF(TagNo() > 0, SYS(2021, TagNo()), "") && Previous Indexed Filter expression
IF EMPTY(lcFilter)
INDEX ON &lcExpr TAG (lcTmpTag) OF (fTmpCdx) && Do not change to EVAL(lcExpr)
ELSE
INDEX ON &lcExpr TAG (lcTmpTag) OF (fTmpCdx) FOR &lcFilter
ENDIF
*SET STEP ON
DO GrdRefresh
WAIT CLEAR
RETURN
************************************************
PROCEDURE GrdRefresh
* To Refresh the Grid after Setting new Order
*GO TOP
toHeader.Parent.SetFocus
toHeader.Parent.Parent.Refresh
IF lnRecNo > 0 AND lnRecNo =< RecCount()
GO lnRecNo && To Force a Screen Refresh
ENDIF
toHeader.Parent.Parent.Refresh
RETURN
***************************************************************************
PROCEDURE AddSort
lnGrid = ASELOBJ(loGrid) && gives a handle to the Currently selected Object
IF lnGrid = 0 OR UPPER(loGrid(1).BaseClass) <> "GRID"
WAIT WINDOW "Please select a grid object " TIMEOUT 10
RETURN
ENDIF
WITH loGrid
lnColumnCount = .ColumnCount
FOR n = 1 TO lnColumnCount
.Columns(n).Header1.WriteMethod("Click", "_GrdSort(THIS)")
NEXT
ENDWITH
RETURN
Previous
Next
Reply
View the map of this thread
View the map of this thread starting from this message only
View all messages of this thread
View all messages of this thread starting from this message only