Source code for Issue Number 41

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. 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

Code of the Week Home


Source Code

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