by Uday S. Kamble (1 Submission)
Category: Custom Controls/Forms/Menus
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sun 9th June 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Sorting by 2 Coloumns on TrueDBGrid 6.0
API Declarations
Dim sortflag As Integer
Dim sortfieldNext As String
Dim sortflagNext1 As Integer
'Form Has a TrueDB Grid :TDBPur'
' a SSCommand Button : SSCmdSort : used for Display Purpose'
' a Command Button : Hidden Button : used for caption
Dim sortflagNext2 As Integer
Dim FirstorSecond As Integer
Dim Col1, Col2 As Integer
VBcoders
Dim sql1 As String
Dim sql2 As String
Dim sqlAD As String
Dim strAppendAscDesc As String
If (cmdSort.Caption = "1") Then ''SINGLE ROW SORT
If InStr(1, LCase(sortfield), LCase(TDBGrid1.Columns(M_ColIndex).DataField)) Then
If sortflag = 1 Then
sortflag = 2
Else
sortflag = 1
End If
Else
sortflag = 1
End If
Else ''TWO ROW SORT
''field is already selected
If InStr(1, LCase(sortfieldNext), LCase(TDBGrid1.Columns(M_ColIndex).DataField)) Then
If (InStr(1, LCase(sortfieldNext), ",") = 0) Then ''1 FIELDS PRESENT
If (InStr(1, LCase(sortfieldNext), "desc") <> 0) Then
Col1 = M_ColIndex
sortflagNext1 = 1
Else
Col1 = M_ColIndex
sortflagNext1 = 2
End If
Else ''2 fields are present and matching
strAppendAscDesc = CheckBeforeComma(sortfieldNext, TDBGrid1.Columns(M_ColIndex).DataField)
If (InStr(1, LCase(strAppendAscDesc), "desc") <> 0) Then
If (FirstorSecond = 1) Then
Col1 = M_ColIndex
sortflagNext1 = 1
Else
Col2 = M_ColIndex
sortflagNext2 = 1
End If
Else
If (FirstorSecond = 1) Then
Col1 = M_ColIndex
sortflagNext1 = 2
Else
Col2 = M_ColIndex
sortflagNext2 = 2
End If
End If
End If
Else
sortflagNext1 = 1
'sortflagNext2 = 1
'Col2 = ColIndex
End If
End If
If (cmdSort.Caption = "1") Then ''SINGLE ROW SORT
sortfield = "order by " + TDBGrid1.Columns(M_ColIndex).DataField + " " + IIf(sortflag = 1, "", "desc")
Else ''TWO ROW SORT
If (sortfieldNext = "") Then ''TWO FIELDS ARE NOT SELECTED
sortfieldNext = "order by " + TDBGrid1.Columns(M_ColIndex).DataField + " " + IIf(sortflagNext1 = 1, "", "desc")
Col1 = M_ColIndex
Else ''EITHER 1 OR 2 FIELDS ARE THERE
If (InStr(1, LCase(sortfieldNext), ",") <> 0) Then ''2 FIELDS PRESENT
If (InStr(1, LCase(sortfieldNext), LCase(TDBGrid1.Columns(M_ColIndex).DataField)) <> 0) Then
If (FirstorSecond = 1) Then
sortfieldNext = Replace(LCase(sortfieldNext), LCase(TDBGrid1.Columns(M_ColIndex).DataField) & " desc", LCase(TDBGrid1.Columns(M_ColIndex).DataField))
sortfieldNext = Replace(LCase(sortfieldNext), LCase(TDBGrid1.Columns(M_ColIndex).DataField), IIf(sortflagNext1 = 1, LCase(TDBGrid1.Columns(M_ColIndex).DataField), LCase(TDBGrid1.Columns(M_ColIndex).DataField) + " desc"))
Col1 = M_ColIndex
ElseIf (FirstorSecond = 2) Then
sortfieldNext = Replace(LCase(sortfieldNext), LCase(TDBGrid1.Columns(M_ColIndex).DataField) & " desc", LCase(TDBGrid1.Columns(M_ColIndex).DataField))
sortfieldNext = Replace(LCase(sortfieldNext), LCase(TDBGrid1.Columns(M_ColIndex).DataField), IIf(sortflagNext2 = 1, LCase(TDBGrid1.Columns(M_ColIndex).DataField), LCase(TDBGrid1.Columns(M_ColIndex).DataField) + " desc"))
Col2 = M_ColIndex
End If
Else
sql1 = Mid(LCase(sortfieldNext), InStr(LCase(sortfieldNext), ",") + 1)
sortfieldNext = "Order by " & sql1 & "," + TDBGrid1.Columns(M_ColIndex).DataField + " " + IIf(sortflagNext2 = 1, "", "desc")
Col1 = Col2
Col2 = M_ColIndex
End If
Else ''1 FIELD IS PRESENT
If (InStr(1, LCase(sortfieldNext), LCase(TDBGrid1.Columns(M_ColIndex).DataField)) <> 0) Then
'"order by " + adomast.Recordset(ColIndex).Name + " " + IIf(sortflag = 1, "", "desc")
'sortfieldNext = sortfieldNext & IIf(sortflagNext1 = 1, "", "desc")
sortfieldNext = "order by " + LCase(TDBGrid1.Columns(M_ColIndex).DataField) + " " + IIf(sortflagNext1 = 1, "", "desc")
Col1 = M_ColIndex
Else
sortflagNext2 = 1
sortfieldNext = sortfieldNext & "," + TDBGrid1.Columns(M_ColIndex).DataField + " " + IIf(sortflagNext2 = 1, "", "desc")
Col2 = M_ColIndex
End If
End If
End If
End If
sql = M_Adodc.RecordSource
If (InStr(1, LCase(M_Adodc.RecordSource), "order by") <> 0) Then
sql1 = Mid(sql, InStr(LCase(sql), "order by"))
sql = Replace(M_Adodc.RecordSource, sql1, "")
End If
If (cmdSort.Caption = "1") Then
sql = sql & sortfield
Else
sql = sql & sortfieldNext
End If
M_Adodc.RecordSource = sql
M_Adodc.Refresh
'For i = 0 To TDBPur.Columns.Count - 1
' TDBPur.Columns(i).HeadingStyle.ForegroundPicture = 0
'Next i
If (cmdSort.Caption = "1") Then ''SINGLE ROW SORT
For i = 0 To TDBGrid1.Columns.Count - 1
TDBGrid1.Columns(i).HeadingStyle.ForegroundPicture = 0
Next i
TDBGrid1.Refresh
TDBGrid1.Columns(M_ColIndex).HeadingStyle.TransparentForegroundPicture = True
TDBGrid1.Columns(M_ColIndex).HeadingStyle.ForegroundPicture = IIf(sortflag = 1, LoadPicture(App.Path + "\icons\uparrow2.gif"), LoadPicture(App.Path + "\icons\downarrow.gif"))
TDBGrid1.Columns(M_ColIndex).HeadingStyle.ForegroundPicturePosition = 1
TDBGrid1.Col = M_ColIndex
TDBGrid1.SetFocus
TDBGrid1.ClearSelCols
TDBGrid1.Refresh
TDBGrid1.FetchRowStyle = True
Call SSrefresh_Click
Else
For i = 0 To TDBGrid1.Columns.Count - 1
TDBGrid1.Columns(i).HeadingStyle.ForegroundPicture = 0
Next i
TDBGrid1.Refresh
TDBGrid1.Columns(M_ColIndex).HeadingStyle.TransparentForegroundPicture = True
If (sortflagNext1 = 1) Then
TDBGrid1.Columns(Col1).HeadingStyle.ForegroundPicture = LoadPicture(App.Path + "\icons\uparrow2.gif")
ElseIf (sortflagNext1 = 2) Then
TDBGrid1.Columns(Col1).HeadingStyle.ForegroundPicture = LoadPicture(App.Path + "\icons\downarrow.gif")
End If
If (sortflagNext2 = 1) Then
TDBGrid1.Columns(Col2).HeadingStyle.ForegroundPicture = LoadPicture(App.Path + "\icons\uparrow2.gif")
ElseIf (sortflagNext2 = 2) Then
TDBGrid1.Columns(Col2).HeadingStyle.ForegroundPicture = LoadPicture(App.Path + "\icons\downarrow.gif")
End If
TDBGrid1.Columns(M_ColIndex).HeadingStyle.ForegroundPicturePosition = 1
TDBGrid1.Col = M_ColIndex
TDBGrid1.SetFocus
TDBGrid1.ClearSelCols
TDBGrid1.Refresh
TDBGrid1.FetchRowStyle = True
Call SSrefresh_Click
End If
End Sub
'*********************************************************************
Private Function CheckBeforeComma(msBase As String, msCheck As String) As String
Dim CommaPos As Integer
Dim CheckPos As Integer
Dim msSQL As String
CommaPos = InStr(1, LCase(msBase), ",")
CheckPos = InStr(1, LCase(msBase), LCase(msCheck))
If (CheckPos > CommaPos) Then
msSQL = Mid(LCase(msBase), CheckPos)
FirstorSecond = 2
Else
msSQL = Mid(LCase(msBase), CheckPos, CommaPos - CheckPos)
FirstorSecond = 1
End If
CheckBeforeComma = msSQL
End Function
'*********************************************************************
Private Sub SSCmdSort_Click()
Dim i As Integer
For i = 0 To TDBPur.Columns.Count - 1
TDBPur.Columns(i).HeadingStyle.ForegroundPicture = 0
Next i
If (cmdSort.Caption = "1") Then
cmdSort.Caption = "2"
SSCmdSort.Picture = LoadPicture(App.Path + "\icons\SortBy2.bmp")
sortfieldNext = ""
sortflagNext1 = 0
sortflagNext2 = 0
Else
cmdSort.Caption = "1"
SSCmdSort.Picture = LoadPicture(App.Path + "\icons\SortBy1.bmp")
sortfield = "order by Orderno"
sortflag = 1
End If
End Sub
Private Sub Form_Load()
sortflag = 1
sortfield = "order by Orderno"
sortfieldNext = "order by orderno,clientname"
cmdSort.Caption = "1"
End sub
Private Sub TDBPur_HeadClick(ByVal ColIndex As Integer)
Call SortByTwoGridColoumns(ColIndex, TDBPur, adopur)
End Sub