Just paste this source code into a class module called cTDBGridUtils and include it in your project.
'----------------------------------------------------------------------
'
' Class Name: cTDBGridUtils
' Written By: C&D Programming Corp.
' Create Date: 5/98
' Copyright: Copyright 1998 by C&D Programming Corp. Source
' code may not be reproduced except for use in a
' compiled executable. All rights reserved. If
' you would like to reprint any or all of this
' code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit
Public Grid As TrueDBGrid50.TDBGrid ' This should work with other versions
' of TrueDBGrid. Adjust this
' declaration as necessary.
Public DataControl As VB.Data ' define it as VB.Data to ensure we use
' the correct Data control class
'
' This routine will allow you to implement a simple single column sort
' function provided the following conditions are met:
'
' - Assumes the RecordSource property of data control contains a
' SQL SELECT statement and not a query or just a table name.
'
Public Sub SortColumn(ByVal lColIndex As Long)
Dim lOrderByPos As Long ' position of the ORDER BY clause
Dim sSourceLowerCase As String ' record source converted to lower case
Dim sSource As String ' original record source property
Dim sSortOrder As String ' sort order for new sort
Static lLastCol As Variant ' remember the last column that was sorted
' we made this variant so that we can tell
' if it has been initialized yet. If we
' define it as long it's current value will
' be zero. Since zero is a valid column
' index this can cause a problem if the
' user tries to sort the first column in
' the grid.
On Error GoTo Handler ' Add our default error handling just
' in case...
'
'
' Gather the record source information for processing to determine
' the current sort order.
'
sSource = Trim$(DataControl.RecordSource)
sSourceLowerCase = LCase$(sSource)
'
' Do a sanity check to see if the required conditions are met for
' doing this type of sort function.
'
If Left(sSourceLowerCase, 6) <> "select" Then
' does not seem to be a valid select clause so let's just bail
' out of this routine so we do not cause any "damage" to the
' existing record source.
Exit Sub
End If
'
' Find the order by clause and strip it away if it exists.
'
lOrderByPos = InStr(sSourceLowerCase, "order by")
If lOrderByPos > 0 Then
' get everything but the order by clause
sSource = Left$(sSource, lOrderByPos - 1)
End If
'
' Determine previous sort order if the same column is being sorted.
' If it is a different column, lets assume ascending sort.
'
If Not IsEmpty(lLastCol) And lLastCol = lColIndex Then
If Right(Trim$(sSourceLowerCase), 4) = "desc" Then
sSortOrder = "asc"
Else
sSortOrder = "desc"
End If
Else
sSortOrder = "asc"
End If
'
' Assign the new recordsource string and refresh the data control
'
DataControl.RecordSource = sSource & _
" order by [" & Grid.Columns(lColIndex).DataField & "] " & sSortOrder
DataControl.Refresh
Grid.Col = lColIndex
lLastCol = lColIndex
Exit Sub
Handler:
Err.Raise Err.Number, "cTDBGridUtils.SortColumn", Err.Description
End Sub