SSDBGrid-Sort By Col

最新推荐文章于 2021-10-30 18:31:02 发布

原创最新推荐文章于 2021-10-30 18:31:02 发布 · 1.8k 阅读

1 ·

CC 4.0 BY-SA版权

文章标签：

#integer #function #string #each

VB专题专栏收录该内容

5 篇文章

订阅专栏

本文介绍了一种使用SSDBGrid进行排序的方法，该方法通过创建一个记录集来存储网格数据，并根据选择的列进行升序或降序排列。此外，还详细介绍了如何处理不同数据类型（如文本、数值和金额）的排序逻辑。

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