SSDBGrid-Sort By Col

来源：互联网发布：unity3d室内场景模型编辑：程序博客网时间：2024/05/01 23:55

Public Function SortSSDBGridByCol(ByRef pgrdSource As SSDBGrid, ByVal pgrdSelCol As Integer)

    Dim grdBak              As SSDBGrid
    Dim rsGrid              As ADODB.Recordset
    Dim intI                As Integer
    Dim intCol              As Integer

    Dim strColName          As String

    Dim strSelColCaption    As String
    Dim strSelColName       As String
    Dim strAddRow           As String

On Error GoTo Error_Handler

    '//////////////////////////////////////////////////////////
    'Use this function, please set grd.column().DateType
    'String : DateType=Text
    'Numeric: DateType=Double
    'Amount : DateType=Currency   (12,345.03)
    '//////////////////////////////////////////////////////////

    Set grdBak = pgrdSource
    If pgrdSource.Rows = 0 Then
        Exit Function
    End If

    strSelColCaption = pgrdSource.Columns(pgrdSelCol).Caption
    strSelColName = UCase(Trim(pgrdSource.Columns(pgrdSelCol).Name))

    'Create Record set By ssdbgrid,each record type deply on grid.col.DateType
    Set rsGrid = New ADODB.Recordset

    For intI = 0 To pgrdSource.Columns.Count - 1
        strColName = UCase(Trim(pgrdSource.Columns(intI).Name))
        If pgrdSource.Columns(intI).DataType = 8 Then '8:Text
            rsGrid.Fields.Append strColName, adVarChar, 1024
        Else
            rsGrid.Fields.Append strColName, adDouble
        End If
    Next intI

    rsGrid.Open

    pgrdSource.Redraw = False

    pgrdSource.MoveFirst

    For intI = 0 To pgrdSource.Rows - 1

        rsGrid.AddNew
        For intCol = 0 To pgrdSource.Cols - 1
            'Amount:123,234.00
            If pgrdSource.Columns(intCol).DataType = 6 Then '6:Currency
                rsGrid.Fields(intCol).Value = Replace(Trim(pgrdSource.Columns(intCol).Value), ",", "")
            Else
                rsGrid.Fields(intCol).Value = Trim(pgrdSource.Columns(intCol).Value)
            End If
        Next intCol

        rsGrid.Update
        pgrdSource.MoveNext
    Next

    If InStr(1, strSelColCaption, Chr(&HA88B)) Then      '原先Desc-->ASC
        rsGrid.Sort = "[" & strSelColName & "]" & " Asc"
    ElseIf InStr(1, strSelColCaption, Chr(&HA1F8)) Then '原先ASC -->Desc
        rsGrid.Sort = "[" & strSelColName & "]" & " Desc"
    Else
        rsGrid.Sort = "[" & strSelColName & "]" & " Asc"
    End If

    pgrdSource.RemoveAll

    Do While Not rsGrid.EOF

        For intCol = 0 To rsGrid.Fields.Count - 1

            If pgrdSource.Columns(intCol).DataType = 6 Then '6:Currency
                If intCol = 0 Then
                    strAddRow = Format(rsGrid.Fields(intCol).Value, "#,###.###")
                Else
                    strAddRow = strAddRow & vbTab & Format(rsGrid.Fields(intCol).Value, "#,###.###")
                End If
            Else
                If intCol = 0 Then
                    strAddRow = rsGrid.Fields(intCol).Value
                Else
                    strAddRow = strAddRow & vbTab & rsGrid.Fields(intCol).Value
                End If
            End If

        Next intCol

        pgrdSource.AddItem strAddRow

        rsGrid.MoveNext
    Loop

    For intCol = 0 To pgrdSource.Cols - 1

        If intCol = pgrdSelCol Then

            If InStr(1, strSelColCaption, Chr(&HA88B)) Then      '原先Desc-->ASC "▼"
                pgrdSource.Columns(pgrdSelCol).Caption = Replace(strSelColCaption, Chr(&HA88B), Chr(&HA1F8))
            ElseIf InStr(1, strSelColCaption, Chr(&HA1F8)) Then '原先ASC -->Desc "▲"
                pgrdSource.Columns(pgrdSelCol).Caption = Replace(strSelColCaption, Chr(&HA1F8), Chr(&HA88B))
            Else
                pgrdSource.Columns(pgrdSelCol).Caption = strSelColCaption & Chr(&HA1F8)
            End If
        Else

            '将未选中行恢复Caption
            pgrdSource.Columns(intCol).Caption = Replace(Replace(pgrdSource.Columns(intCol).Caption, Chr(&HA88B), ""), Chr(&HA1F8), "")
        End If
    Next

    rsGrid.Close
    Set rsGrid = Nothing

    pgrdSource.Redraw = True

    Exit Function

Error_Handler:
    DBCloseRS rsGrid
    Set rsGrid = Nothing
    Set pgrdSource = grdBak
    pgrdSource.Redraw = True
    Err.Raise vbObject + 1024, "Sort SSDBGrid", Err.Description
End Function